View of /trunk/webwork2/lib/WeBWorK/DB.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::DB - interface with the WeBWorK databases.
   11 
   12 =head1 SYNOPSIS
   13 
   14  my $db = WeBWorK::DB->new($courseEnvironment);
   15 
   16  my @userIDs = $db->listUsers();
   17  my $Sam = $db->{user}->{record}->new();
   18 
   19  $Sam->user_id("sammy");
   20  $Sam->first_name("Sam");
   21  $Sam->last_name("Hathaway");
   22  # etc.
   23 
   24  $db->addUser($User);
   25  my $Dennis = $db->getUser("dennis");
   26  $Dennis->status("C");
   27  $db->putUser->($Dennis);
   28 
   29  $db->deleteUser("sammy");
   30 
   31 =head1 DESCRIPTION
   32 
   33 WeBWorK::DB provides a consistent interface to a number of database backends.
   34 Access and modification functions are provided for each logical table used by
   35 the webwork system. The particular backend ("schema" and "driver"), record
   36 class, data source, and additional parameters are specified by the C<%dbLayout>
   37 hash in the course environment.
   38 
   39 =head1 ARCHITECTURE
   40 
   41 The new database system uses a three-tier architecture to insulate each layer
   42 from the adjacent layers.
   43 
   44 =head2 Top Layer: DB
   45 
   46 The top layer of the architecture is the DB module. It provides the methods
   47 listed below, and uses schema modules (via tables) to implement those methods.
   48 
   49             / new* list* exists* add* get* put* delete* \             <- api
   50  +------------------------------------------------------------------+
   51  |                                DB                                |
   52  +------------------------------------------------------------------+
   53   \ password permission key user set set_user problem problem_user /  <- tables
   54 
   55 =head2 Middle Layer: Schemas
   56 
   57 The middle layer of the architecture is provided by one or more schema modules.
   58 They are called "schema" modules because they control the structure of the data
   59 for a table. This includes odd things like the way multiple tables are encoded
   60 in a single hash in the WW1Hash schema, and the encoding scheme used.
   61 
   62 The schema modules provide an API that matches the requirements of the DB
   63 layer, on a per-table basis. Each schema module has a style that determines
   64 which drivers it can interface with. For example, WW1Hash is a "hash" style
   65 schema. SQL is a "dbi" style schema.
   66 
   67 =head3 Examples
   68 
   69 Both WeBWorK 1.x and 2.x courses use:
   70 
   71   / password  permission  key \        / user \      <- tables provided
   72  +-----------------------------+  +----------------+
   73  |          Auth1Hash          |  | Classlist1Hash |
   74  +-----------------------------+  +----------------+
   75              \ hash /                  \ hash /      <- driver style required
   76 
   77 WeBWorK 1.x courses also use:
   78 
   79   / set_user problem_user \       / set problem \
   80  +-------------------------+  +---------------------+
   81  |         WW1Hash         |  | GlobalTableEmulator |
   82  +-------------------------+  +---------------------+
   83            \ hash /                   \ null /
   84 
   85 The GlobalTableEmulator schema emulates the global set and problem tables using
   86 data from the set_user and problem_user tables.
   87 
   88 WeBWorK 2.x courses also use:
   89 
   90   / set set_user problem problem_user \
   91  +-------------------------------------+
   92  |               WW2Hash               |
   93  +-------------------------------------+
   94                  \ hash /
   95 
   96 =head2 Bottom Layer: Drivers
   97 
   98 Driver modules implement a style for a schema. They provide physical access to
   99 a data source containing the data for a table. The style of a driver determines
  100 what methods it provides. All drivers provide C<connect(MODE)> and
  101 C<disconnect()> methods. A hash style driver provides a C<hash()> method which
  102 returns the tied hash. A dbi style driver provides a C<handle()> method which
  103 returns the DBI handle.
  104 
  105 =head3 Examples
  106 
  107   / hash \    / hash \    / hash \  <- style
  108  +--------+  +--------+  +--------+
  109  |   DB   |  |  GDBM  |  |   DB3  |
  110  +--------+  +--------+  +--------+
  111 
  112   / dbi \    / ldap \
  113  +-------+  +--------+
  114  |  SQL  |  |  LDAP  |
  115  +-------+  +--------+
  116 
  117 =head2 Record Types
  118 
  119 In C<%dblayout>, each table is assigned a record class, used for passing
  120 complete records to and from the database. The default record classes are
  121 subclasses of the WeBWorK::DB::Record class, and are named as follows: User,
  122 Password, PermissionLevel, Key, Set, UserSet, Problem, UserProblem. In the
  123 following documentation, a reference the the record class for a table means the
  124 record class currently defined for that table in C<%dbLayout>.
  125 
  126 =cut
  127 
  128 use strict;
  129 use warnings;
  130 use Carp;
  131 use Data::Dumper;
  132 use WeBWorK::Timing;
  133 use WeBWorK::Utils qw(runtime_use);
  134 
  135 ################################################################################
  136 # constructor
  137 ################################################################################
  138 
  139 =head1 CONSTRUCTOR
  140 
  141 =over
  142 
  143 =item new($ce)
  144 
  145 The C<new> method creates a DB object and brings up the underlying
  146 schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a
  147 WeBWorK::CourseEnvironment object.
  148 
  149 =back
  150 
  151 =head2 C<%dbLayout> Format
  152 
  153 The C<%dbLayout> hash consists of items keyed by table names. The value of each
  154 item is a reference to a hash containing the following items:
  155 
  156 =over
  157 
  158 =item record
  159 
  160 The name of a perl module to use for representing the data in a record.
  161 
  162 =item schema
  163 
  164 The name of a perl module to use for access to the table.
  165 
  166 =item driver
  167 
  168 The name of a perl module to use for access to the data source.
  169 
  170 =item source
  171 
  172 The location of the data source that should be used by the driver module.
  173 Depending on the driver, this may be a path, a url, or a DBI spec.
  174 
  175 =item params
  176 
  177 A reference to a hash containing extra information needed by the schema. Some
  178 schemas require parameters, some do not. Consult the documentation for the
  179 schema in question.
  180 
  181 =back
  182 
  183 For each table defined in C<%dbLayout>, C<new> loads the record, schema, and
  184 driver modules. It the schema module's C<tables> method lists the current table
  185 (or contains the string "*") and the output of the schema and driver modules'
  186 C<style> methods match, the table is installed. Otherwise, an exception is
  187 thrown.
  188 
  189 =cut
  190 
  191 sub new($$) {
  192   my ($invocant, $ce) = @_;
  193   my $class = ref($invocant) || $invocant;
  194   my $self = {};
  195   bless $self, $class; # bless this here so we can pass it to the schema
  196 
  197   # load the modules required to handle each table, and create driver
  198   my %dbLayout = %{$ce->{dbLayout}};
  199   foreach my $table (keys %dbLayout) {
  200     my $layout = $dbLayout{$table};
  201     my $record = $layout->{record};
  202     my $schema = $layout->{schema};
  203     my $driver = $layout->{driver};
  204     my $source = $layout->{source};
  205     my $params = $layout->{params};
  206 
  207     runtime_use($record);
  208 
  209     runtime_use($driver);
  210     my $driverObject = eval { $driver->new($source, $params) };
  211     croak "error instantiating DB driver $driver for table $table: $@"
  212       if $@;
  213 
  214     runtime_use($schema);
  215     my $schemaObject = eval { $schema->new(
  216       $self, $driver->new($source, $params),
  217       $table, $record, $params) };
  218     croak "error instantiating DB schema $schema for table $table: $@"
  219       if $@;
  220 
  221     $self->{$table} = $schemaObject;
  222   }
  223 
  224   return $self;
  225 }
  226 
  227 =head1 METHODS
  228 
  229 =cut
  230 
  231 ################################################################################
  232 # password functions
  233 ################################################################################
  234 
  235 =head2 Password Methods
  236 
  237 =over
  238 
  239 =item newPassword()
  240 
  241 Returns a new, empty password object.
  242 
  243 =cut
  244 
  245 sub newPassword {
  246   my ($self, $prototype) = @_;
  247   return $self->{password}->{record}->new($prototype);
  248 }
  249 
  250 =item listPasswords()
  251 
  252 Returns a list of user IDs representing the records in the password table.
  253 
  254 =cut
  255 
  256 sub listPasswords {
  257   my ($self) = @_;
  258 
  259   croak "listPasswords: requires 0 arguments"
  260     unless @_ == 1;
  261 
  262   return map { $_->[0] }
  263     $self->{password}->list(undef);
  264 }
  265 
  266 =item addPassword($Password)
  267 
  268 $Password is a record object. The password will be added to the password table
  269 if a password with the same user ID does not already exist. If one does exist,
  270 an exception is thrown. To add a password, a user with a matching user ID must
  271 exist in the user table.
  272 
  273 =cut
  274 
  275 sub addPassword {
  276   my ($self, $Password) = @_;
  277 
  278   croak "addPassword: requires 1 argument"
  279     unless @_ == 2;
  280   croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
  281     unless ref $Password eq $self->{password}->{record};
  282   croak "addPassword: password exists (perhaps you meant to use putPassword?)"
  283     if $self->{password}->exists($Password->user_id);
  284   croak "addPassword: user ", $Password->user_id, " not found"
  285     unless $self->{user}->exists($Password->user_id);
  286 
  287   checkKeyfields($Password);
  288 
  289   return $self->{password}->add($Password);
  290 }
  291 
  292 =item getPassword($userID)
  293 
  294 If a record with a matching user ID exists, a record object containting that
  295 record's data will be returned. If no such record exists, an undefined value
  296 will be returned.
  297 
  298 =cut
  299 
  300 sub getPassword {
  301   my ($self, $userID) = @_;
  302 
  303   croak "getPassword: requires 1 argument"
  304     unless @_ == 2;
  305   croak "getPassword: argument 1 must contain a user_id"
  306     unless defined $userID;
  307 
  308   return $self->{password}->get($userID);
  309 }
  310 
  311 =item getPasswords(@uesrIDs)
  312 
  313 Return a list of password records associated with the user IDs given. If there
  314 is no record associated with a given user ID, that element of the list will be
  315 undefined.
  316 
  317 =cut
  318 
  319 sub getPasswords {
  320   my ($self, @userIDs) = @_;
  321 
  322   croak "getPasswords: requires 1 or more argument"
  323     unless @_ >= 2;
  324   foreach my $i (0 .. $#userIDs) {
  325     croak "getPasswords: element $i of argument list must contain a user_id"
  326       unless defined $userIDs[$i];
  327   }
  328 
  329   return map { $self->getPassword($_) } @userIDs;
  330 }
  331 
  332 =item putPassword($Password)
  333 
  334 $Password is a record object. If a password record with the same user ID exists
  335 in the password table, the data in the record is replaced with the data in
  336 $Password. If a matching password record does not exist, an exception is
  337 thrown.
  338 
  339 =cut
  340 
  341 sub putPassword($$) {
  342   my ($self, $Password) = @_;
  343 
  344   croak "putPassword: requires 1 argument"
  345     unless @_ == 2;
  346   croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
  347     unless ref $Password eq $self->{password}->{record};
  348   croak "putPassword: password not found (perhaps you meant to use addPassword?)"
  349     unless $self->{password}->exists($Password->user_id);
  350 
  351   checkKeyfields($Password);
  352 
  353   return $self->{password}->put($Password);
  354 }
  355 
  356 =item deletePassword($userID)
  357 
  358 If a password record with a user ID matching $userID exists in the password
  359 table, it is removed and the method returns a true value. If one does exist,
  360 a false value is returned.
  361 
  362 =cut
  363 
  364 sub deletePassword($$) {
  365   my ($self, $userID) = @_;
  366 
  367   croak "putPassword: requires 1 argument"
  368     unless @_ == 2;
  369   croak "deletePassword: argument 1 must contain a user_id"
  370     unless defined $userID;
  371 
  372   return $self->{password}->delete($userID);
  373 }
  374 
  375 =back
  376 
  377 =cut
  378 
  379 ################################################################################
  380 # permission functions
  381 ################################################################################
  382 
  383 =head2 Permission Level Methods
  384 
  385 =over
  386 
  387 =item newPermissionLevel()
  388 
  389 Returns a new, empty permission level object.
  390 
  391 =cut
  392 
  393 sub newPermissionLevel {
  394   my ($self, $prototype) = @_;
  395   return $self->{permission}->{record}->new($prototype);
  396 }
  397 
  398 =item listPermissionLevels()
  399 
  400 Returns a list of user IDs representing the records in the permission table.
  401 
  402 =cut
  403 
  404 sub listPermissionLevels($) {
  405   my ($self) = @_;
  406 
  407   croak "listPermissionLevels: requires 0 arguments"
  408     unless @_ == 1;
  409 
  410   return map { $_->[0] }
  411     $self->{permission}->list(undef);
  412 }
  413 
  414 =item addPermissionLevel($PermissionLevel)
  415 
  416 $PermissionLevel is a record object. The permission level will be added to the
  417 permission table if a permission level with the same user ID does not already
  418 exist. If one does exist, an exception is thrown. To add a permission level, a
  419 user with a matching user ID must exist in the user table.
  420 
  421 =cut
  422 
  423 sub addPermissionLevel($$) {
  424   my ($self, $PermissionLevel) = @_;
  425 
  426   croak "addPermissionLevel: requires 1 argument"
  427     unless @_ == 2;
  428   croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
  429     unless ref $PermissionLevel eq $self->{permission}->{record};
  430   croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
  431     if $self->{permission}->exists($PermissionLevel->user_id);
  432   croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
  433     unless $self->{user}->exists($PermissionLevel->user_id);
  434 
  435   checkKeyfields($PermissionLevel);
  436 
  437   return $self->{permission}->add($PermissionLevel);
  438 }
  439 
  440 =item getPermissionLevel($userID)
  441 
  442 If a record with a matching user ID exists, a record object containting that
  443 record's data will be returned. If no such record exists, an undefined value
  444 will be returned.
  445 
  446 =cut
  447 
  448 sub getPermissionLevel($$) {
  449   my ($self, $userID) = @_;
  450 
  451   croak "getPermissionLevel: requires 1 argument"
  452     unless @_ == 2;
  453   croak "getPermissionLevel: argument 1 must contain a user_id"
  454     unless defined $userID;
  455 
  456   return $self->{permission}->get($userID);
  457 }
  458 
  459 =item getPermissionLevels(@uesrIDs)
  460 
  461 Return a list of permission level records associated with the user IDs given. If
  462 there is no record associated with a given user ID, that element of the list
  463 will be undefined.
  464 
  465 =cut
  466 
  467 sub getPermissionLevels {
  468   my ($self, @userIDs) = @_;
  469 
  470   croak "getPermissionLevels: requires 1 or more argument"
  471     unless @_ >= 2;
  472   foreach my $i (0 .. $#userIDs) {
  473     croak "getPermissionLevels: element $i of argument list must contain a user_id"
  474       unless defined $userIDs[$i];
  475   }
  476 
  477   return map { $self->getPermissionLevel($_) } @userIDs;
  478 }
  479 
  480 =item putPermissionLevel($PermissionLevel)
  481 
  482 $PermissionLevel is a record object. If a permission level record with the same
  483 user ID exists in the permission table, the data in the record is replaced with
  484 the data in $PermissionLevel. If a matching permission level record does not
  485 exist, an exception is thrown.
  486 
  487 =cut
  488 
  489 sub putPermissionLevel($$) {
  490   my ($self, $PermissionLevel) = @_;
  491 
  492   croak "putPermissionLevel: requires 1 argument"
  493     unless @_ == 2;
  494   croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
  495     unless ref $PermissionLevel eq $self->{permission}->{record};
  496   croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
  497     unless $self->{permission}->exists($PermissionLevel->user_id);
  498 
  499   checkKeyfields($PermissionLevel);
  500 
  501   return $self->{permission}->put($PermissionLevel);
  502 }
  503 
  504 =item deletePermissionLevel($userID)
  505 
  506 If a permission level record with a user ID matching $userID exists in the
  507 permission table, it is removed and the method returns a true value. If one
  508 does exist, a false value is returned.
  509 
  510 =cut
  511 
  512 sub deletePermissionLevel($$) {
  513   my ($self, $userID) = @_;
  514 
  515   croak "deletePermissionLevel: requires 1 argument"
  516     unless @_ == 2;
  517   croak "deletePermissionLevel: argument 1 must contain a user_id"
  518     unless defined $userID;
  519 
  520   return $self->{permission}->delete($userID);
  521 }
  522 
  523 ################################################################################
  524 # key functions
  525 ################################################################################
  526 
  527 =head2 Key Methods
  528 
  529 =over
  530 
  531 =item newKey()
  532 
  533 Returns a new, empty key object.
  534 
  535 =cut
  536 
  537 sub newKey {
  538   my ($self, $prototype) = @_;
  539   return $self->{key}->{record}->new($prototype);
  540 }
  541 
  542 =item listKeys()
  543 
  544 Returns a list of user IDs representing the records in the key table.
  545 
  546 =cut
  547 
  548 sub listKeys($) {
  549   my ($self) = @_;
  550 
  551   croak "listKeys: requires 0 arguments"
  552     unless @_ == 1;
  553 
  554   return map { $_->[0] }
  555     $self->{key}->list(undef);
  556 }
  557 
  558 =item addKey($Key)
  559 
  560 $Key is a record object. The key will be added to the key table if a key with
  561 the same user ID does not already exist. If one does exist, an exception is
  562 thrown. To add a key, a user with a matching user ID must exist in the user
  563 table.
  564 
  565 =cut
  566 
  567 sub addKey($$) {
  568   my ($self, $Key) = @_;
  569 
  570   croak "addKey: requires 1 argument"
  571     unless @_ == 2;
  572   croak "addKey: argument 1 must be of type ", $self->{key}->{record}
  573     unless ref $Key eq $self->{key}->{record};
  574   croak "addKey: key exists (perhaps you meant to use putKey?)"
  575     if $self->{key}->exists($Key->user_id);
  576   croak "addKey: user ", $Key->user_id, " not found"
  577     unless $self->{user}->exists($Key->user_id);
  578 
  579   checkKeyfields($Key);
  580 
  581   return $self->{key}->add($Key);
  582 }
  583 
  584 =item getKey($userID)
  585 
  586 If a record with a matching user ID exists, a record object containting that
  587 record's data will be returned. If no such record exists, an undefined value
  588 will be returned.
  589 
  590 =cut
  591 
  592 sub getKey($$) {
  593   my ($self, $userID) = @_;
  594 
  595   croak "getKey: requires 1 argument"
  596     unless @_ == 2;
  597   croak "getKey: argument 1 must contain a user_id"
  598     unless defined $userID;
  599 
  600   return $self->{key}->get($userID);
  601 }
  602 
  603 =item getKeys(@uesrIDs)
  604 
  605 Return a list of key records associated with the user IDs given. If there is no
  606 record associated with a given user ID, that element of the list will be
  607 undefined.
  608 
  609 =cut
  610 
  611 sub getKeys {
  612   my ($self, @userIDs) = @_;
  613 
  614   croak "getKeys: requires 1 or more argument"
  615     unless @_ >= 2;
  616   foreach my $i (0 .. $#userIDs) {
  617     croak "getKeys: element $i of argument list must contain a user_id"
  618       unless defined $userIDs[$i];
  619   }
  620 
  621   return map { $self->getKey($_) } @userIDs;
  622 }
  623 
  624 =item putKey($Key)
  625 
  626 $Key is a record object. If a key record with the same user ID exists in the
  627 key table, the data in the record is replaced with the data in $Key. If a
  628 matching key record does not exist, an exception is thrown.
  629 
  630 =cut
  631 
  632 sub putKey($$) {
  633   my ($self, $Key) = @_;
  634 
  635   croak "putKey: requires 1 argument"
  636     unless @_ == 2;
  637   croak "putKey: argument 1 must be of type ", $self->{key}->{record}
  638     unless ref $Key eq $self->{key}->{record};
  639   croak "putKey: key not found (perhaps you meant to use addKey?)"
  640     unless $self->{key}->exists($Key->user_id);
  641 
  642   checkKeyfields($Key);
  643 
  644   return $self->{key}->put($Key);
  645 }
  646 
  647 =item deleteKey($userID)
  648 
  649 If a key record with a user ID matching $userID exists in the key table, it is
  650 removed and the method returns a true value. If one does exist, a false value
  651 is returned.
  652 
  653 =cut
  654 
  655 sub deleteKey($$) {
  656   my ($self, $userID) = @_;
  657 
  658   croak "deleteKey: requires 1 argument"
  659     unless @_ == 2;
  660   croak "deleteKey: argument 1 must contain a user_id"
  661     unless defined $userID;
  662 
  663   return $self->{key}->delete($userID);
  664 }
  665 
  666 ################################################################################
  667 # user functions
  668 ################################################################################
  669 
  670 =head2 User Methods
  671 
  672 =over
  673 
  674 =item newUser()
  675 
  676 Returns a new, empty user object.
  677 
  678 =cut
  679 
  680 sub newUser {
  681   my ($self, $prototype) = @_;
  682   return $self->{user}->{record}->new($prototype);
  683 }
  684 
  685 =item listUsers()
  686 
  687 Returns a list of user IDs representing the records in the user table.
  688 
  689 =cut
  690 
  691 sub listUsers($) {
  692   my ($self) = @_;
  693 
  694   croak "listUsers: requires 0 arguments"
  695     unless @_ == 1;
  696 
  697   return map { $_->[0] }
  698     $self->{user}->list(undef);
  699 }
  700 
  701 =item addUser($User)
  702 
  703 $User is a record object. The user will be added to the user table if a user
  704 with the same user ID does not already exist. If one does exist, an exception
  705 is thrown.
  706 
  707 =cut
  708 
  709 sub addUser($$) {
  710   my ($self, $User) = @_;
  711 
  712   croak "addUser: requires 1 argument"
  713     unless @_ == 2;
  714   croak "addUser: argument 1 must be of type ", $self->{user}->{record}
  715     unless ref $User eq $self->{user}->{record};
  716   croak "addUser: user exists (perhaps you meant to use putUser?)"
  717     if $self->{user}->exists($User->user_id);
  718 
  719   checkKeyfields($User);
  720 
  721   return $self->{user}->add($User);
  722 }
  723 
  724 =item getUser($userID)
  725 
  726 If a record with a matching user ID exists, a record object containting that
  727 record's data will be returned. If no such record exists, an undefined value
  728 will be returned.
  729 
  730 =cut
  731 
  732 sub getUser($$) {
  733   my ($self, $userID) = @_;
  734 
  735   croak "getUser: requires 1 argument"
  736     unless @_ == 2;
  737   croak "getUser: argument 1 must contain a user_id"
  738     unless defined $userID;
  739 
  740   return $self->{user}->get($userID);
  741 }
  742 
  743 =item getUsers(@uesrIDs)
  744 
  745 Return a list of user records associated with the user IDs given. If there is no
  746 record associated with a given user ID, that element of the list will be
  747 undefined.
  748 
  749 =cut
  750 
  751 sub getUsers {
  752   my ($self, @userIDs) = @_;
  753 
  754   croak "getUsers: requires 1 or more argument"
  755     unless @_ >= 2;
  756   foreach my $i (0 .. $#userIDs) {
  757     croak "getUsers: element $i of argument list must contain a user_id"
  758       unless defined $userIDs[$i];
  759   }
  760 
  761   return map { $self->getUser($_) } @userIDs;
  762 }
  763 
  764 =item putUser($User)
  765 
  766 $User is a record object. If a user record with the same user ID exists in the
  767 user table, the data in the record is replaced with the data in $User. If a
  768 matching user record does not exist, an exception is thrown.
  769 
  770 =cut
  771 
  772 sub putUser($$) {
  773   my ($self, $User) = @_;
  774 
  775   croak "putUser: requires 1 argument"
  776     unless @_ == 2;
  777   croak "putUser: argument 1 must be of type ", $self->{user}->{record}
  778     unless ref $User eq $self->{user}->{record};
  779   croak "putUser: user not found (perhaps you meant to use addUser?)"
  780     unless $self->{user}->exists($User->user_id);
  781 
  782   checkKeyfields($User);
  783 
  784   return $self->{user}->put($User);
  785 }
  786 
  787 =item deleteUser($userID)
  788 
  789 If a user record with a user ID matching $userID exists in the user table, it
  790 is removed and the method returns a true value. If one does exist, a false
  791 value is returned. When a user record is deleted, all records associated with
  792 that user are also deleted. This includes the password, permission, and key
  793 records, and all user set records for that user.
  794 
  795 =cut
  796 
  797 sub deleteUser($$) {
  798   my ($self, $userID) = @_;
  799 
  800   croak "deleteUser: requires 1 argument"
  801     unless @_ == 2;
  802   croak "deleteUser: argument 1 must contain a user_id"
  803     unless defined $userID;
  804 
  805   #$self->deleteUserSet($userID, $_)
  806   # foreach $self->listUserSets($userID);
  807   $self->deleteUserSet($userID, undef);
  808   $self->deletePassword($userID);
  809   $self->deletePermissionLevel($userID);
  810   $self->deleteKey($userID);
  811   return $self->{user}->delete($userID);
  812 }
  813 
  814 ################################################################################
  815 # set functions
  816 ################################################################################
  817 
  818 sub newGlobalSet {
  819   my ($self, $prototype) = @_;
  820   return $self->{set}->{record}->new($prototype);
  821 }
  822 
  823 sub listGlobalSets($) {
  824   my ($self) = @_;
  825 
  826   croak "listGlobalSets: requires 0 arguments"
  827     unless @_ == 1;
  828 
  829   return map { $_->[0] }
  830     $self->{set}->list(undef);
  831 }
  832 
  833 sub addGlobalSet($$) {
  834   my ($self, $GlobalSet) = @_;
  835 
  836   croak "addGlobalSet: requires 1 argument"
  837     unless @_ == 2;
  838   croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  839     unless ref $GlobalSet eq $self->{set}->{record};
  840   croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
  841     if $self->{set}->exists($GlobalSet->set_id);
  842 
  843   checkKeyfields($GlobalSet);
  844 
  845   return $self->{set}->add($GlobalSet);
  846 }
  847 
  848 sub getGlobalSet($$) {
  849   my ($self, $setID) = @_;
  850 
  851   croak "getGlobalSet: requires 1 argument"
  852     unless @_ == 2;
  853   croak "getGlobalSet: argument 1 must contain a set_id"
  854     unless defined $setID;
  855 
  856   return $self->{set}->get($setID);
  857 }
  858 
  859 =item getGlobalSets(@setIDs)
  860 
  861 Return a list of global set records associated with the user IDs given. If there
  862 is no record associated with a given user ID, that element of the list will be
  863 undefined.
  864 
  865 =cut
  866 
  867 sub getGlobalSets {
  868   my ($self, @setIDs) = @_;
  869 
  870   croak "getGlobalSets: requires 1 or more argument"
  871     unless @_ >= 2;
  872   foreach my $i (0 .. $#setIDs) {
  873     croak "getGlobalSets: element $i of argument list must contain a set_id"
  874       unless defined $setIDs[$i];
  875   }
  876 
  877   return map { $self->getGlobalSet($_) } @setIDs;
  878 }
  879 
  880 sub putGlobalSet($$) {
  881   my ($self, $GlobalSet) = @_;
  882 
  883   croak "putGlobalSet: requires 1 argument"
  884     unless @_ == 2;
  885   croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  886     unless ref $GlobalSet eq $self->{set}->{record};
  887   croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
  888     unless $self->{set}->exists($GlobalSet->set_id);
  889 
  890   checkKeyfields($GlobalSet);
  891 
  892   return $self->{set}->put($GlobalSet);
  893 }
  894 
  895 sub deleteGlobalSet($$) {
  896   my ($self, $setID) = @_;
  897 
  898   croak "deleteGlobalSet: requires 1 argument"
  899     unless @_ == 2;
  900   croak "deleteGlobalSet: argument 1 must contain a set_id"
  901     unless defined $setID or caller eq __PACKAGE__;
  902 
  903   #$self->deleteUserSet($_, $setID)
  904   # foreach $self->listSetUsers($setID);
  905   #$self->deleteGlobalProblem($setID, $_)
  906   # foreach $self->listGlobalProblems($setID);
  907   $self->deleteUserSet(undef, $setID);
  908   $self->deleteGlobalProblem($setID, undef);
  909   return $self->{set}->delete($setID);
  910 }
  911 
  912 ################################################################################
  913 # set_user functions
  914 ################################################################################
  915 
  916 sub newUserSet {
  917   my ($self, $prototype) = @_;
  918   return $self->{set_user}->{record}->new($prototype);
  919 }
  920 
  921 sub listSetUsers($$) {
  922   my ($self, $setID) = @_;
  923 
  924   croak "listSetUsers: requires 1 argument"
  925     unless @_ == 2;
  926   croak "listSetUsers: argument 1 must contain a set_id"
  927     unless defined $setID;
  928 
  929   return map { $_->[0] } # extract user_id
  930     $self->{set_user}->list(undef, $setID);
  931 }
  932 
  933 sub listUserSets($$) {
  934   my ($self, $userID) = @_;
  935 
  936   croak "listUserSets: requires 1 argument"
  937     unless @_ == 2;
  938   croak "listUserSets: argument 1 must contain a user_id"
  939     unless defined $userID;
  940 
  941   return map { $_->[1] } # extract set_id
  942     $self->{set_user}->list($userID, undef);
  943 }
  944 
  945 sub addUserSet($$) {
  946   my ($self, $UserSet) = @_;
  947 
  948   croak "addUserSet: requires 1 argument"
  949     unless @_ == 2;
  950   croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
  951     unless ref $UserSet eq $self->{set_user}->{record};
  952   croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
  953     if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
  954   croak "addUserSet: user ", $UserSet->user_id, " not found"
  955     unless $self->{user}->exists($UserSet->user_id);
  956   croak "addUserSet: set ", $UserSet->set_id, " not found"
  957     unless $self->{set}->exists($UserSet->set_id);
  958 
  959   checkKeyfields($UserSet);
  960 
  961   return $self->{set_user}->add($UserSet);
  962 }
  963 
  964 sub getUserSet($$$) {
  965   my ($self, $userID, $setID) = @_;
  966 
  967   croak "getUserSet: requires 2 arguments"
  968     unless @_ == 3;
  969   croak "getUserSet: argument 1 must contain a user_id"
  970     unless defined $userID;
  971   croak "getUserSet: argument 2 must contain a set_id"
  972     unless defined $setID;
  973 
  974   return $self->{set_user}->get($userID, $setID);
  975 }
  976 
  977 =item getUserSets(@userSetIDs)
  978 
  979 Return a list of user set records associated with the user IDs given. If there
  980 is no record associated with a given user ID, that element of the list will be
  981 undefined. @userProblemIDs consists of references to arrays in which the first
  982 element is the user_id and the second element is the set_id.
  983 
  984 =cut
  985 
  986 sub getUserSets {
  987   my ($self, @userSetIDs) = @_;
  988 
  989   croak "getUserSets: requires 1 or more argument"
  990     unless @_ >= 2;
  991   foreach my $i (0 .. $#userSetIDs) {
  992     croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair"
  993       unless defined $userSetIDs[$i]
  994              and ref $userSetIDs[$i] eq "ARRAY"
  995              and @{$userSetIDs[$i]} == 2
  996              and defined $userSetIDs[$i]->[0]
  997              and defined $userSetIDs[$i]->[1];
  998   }
  999 
 1000   return map { $self->getUserSet(@{$_}) } @userSetIDs;
 1001 }
 1002 
 1003 sub putUserSet($$) {
 1004   my ($self, $UserSet) = @_;
 1005 
 1006   croak "putUserSet: requires 1 argument"
 1007     unless @_ == 2;
 1008   croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
 1009     unless ref $UserSet eq $self->{set_user}->{record};
 1010   croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
 1011     unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
 1012   croak "putUserSet: user ", $UserSet->user_id, " not found"
 1013     unless $self->{user}->exists($UserSet->user_id);
 1014   croak "putUserSet: set ", $UserSet->set_id, " not found"
 1015     unless $self->{set}->exists($UserSet->set_id);
 1016 
 1017   checkKeyfields($UserSet);
 1018 
 1019   return $self->{set_user}->put($UserSet);
 1020 }
 1021 
 1022 sub deleteUserSet($$$) {
 1023   my ($self, $userID, $setID) = @_;
 1024 
 1025   croak "getUserSet: requires 2 arguments"
 1026     unless @_ == 3;
 1027   croak "getUserSet: argument 1 must contain a user_id"
 1028     unless defined $userID or caller eq __PACKAGE__;
 1029   croak "getUserSet: argument 2 must contain a set_id"
 1030     unless defined $userID or caller eq __PACKAGE__;
 1031 
 1032   #$self->deleteUserProblem($userID, $setID, $_)
 1033   # foreach $self->listUserProblems($userID, $setID);
 1034   $self->deleteUserProblem($userID, $setID, undef);
 1035   return $self->{set_user}->delete($userID, $setID);
 1036 }
 1037 
 1038 ################################################################################
 1039 # problem functions
 1040 ################################################################################
 1041 
 1042 sub newGlobalProblem {
 1043   my ($self, $prototype) = @_;
 1044   return $self->{problem}->{record}->new($prototype);
 1045 }
 1046 
 1047 sub listGlobalProblems($$) {
 1048   my ($self, $setID) = @_;
 1049 
 1050   croak "listGlobalProblems: requires 1 arguments"
 1051     unless @_ == 2;
 1052   croak "listGlobalProblems: argument 1 must contain a set_id"
 1053     unless defined $setID;
 1054 
 1055   return map { $_->[1] }
 1056     $self->{problem}->list($setID, undef);
 1057 }
 1058 
 1059 sub addGlobalProblem($$) {
 1060   my ($self, $GlobalProblem) = @_;
 1061 
 1062   croak "addGlobalProblem: requires 1 argument"
 1063     unless @_ == 2;
 1064   croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
 1065     unless ref $GlobalProblem eq $self->{problem}->{record};
 1066   croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
 1067     if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
 1068   croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
 1069     unless $self->{set}->exists($GlobalProblem->set_id);
 1070 
 1071   checkKeyfields($GlobalProblem);
 1072 
 1073   return $self->{problem}->add($GlobalProblem);
 1074 }
 1075 
 1076 sub getGlobalProblem($$$) {
 1077   my ($self, $setID, $problemID) = @_;
 1078 
 1079   croak "getGlobalProblem: requires 2 arguments"
 1080     unless @_ == 3;
 1081   croak "getGlobalProblem: argument 1 must contain a set_id"
 1082     unless defined $setID;
 1083   croak "getGlobalProblem: argument 2 must contain a problem_id"
 1084     unless defined $problemID;
 1085 
 1086   return $self->{problem}->get($setID, $problemID);
 1087 }
 1088 
 1089 =item getGlobalProblems(@problemIDs)
 1090 
 1091 Return a list of global set records associated with the user IDs given. If there
 1092 is no record associated with a given user ID, that element of the list will be
 1093 undefined. @problemIDs consists of references to arrays in which the first
 1094 element is the set_id, and the second element is the problem_id.
 1095 
 1096 =cut
 1097 
 1098 sub getGlobalProblems {
 1099   my ($self, @problemIDs) = @_;
 1100 
 1101   croak "getGlobalProblems: requires 1 or more argument"
 1102     unless @_ >= 2;
 1103   foreach my $i (0 .. $#problemIDs) {
 1104     croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair"
 1105       unless defined $problemIDs[$i]
 1106              and ref $problemIDs[$i] eq "ARRAY"
 1107              and @{$problemIDs[$i]} == 2
 1108              and defined $problemIDs[$i]->[0]
 1109              and defined $problemIDs[$i]->[1];
 1110   }
 1111 
 1112   return map { $self->getGlobalProblem(@{$_}) } @problemIDs;
 1113 }
 1114 
 1115 sub putGlobalProblem($$) {
 1116   my ($self, $GlobalProblem) = @_;
 1117 
 1118   croak "putGlobalProblem: requires 1 argument"
 1119     unless @_ == 2;
 1120   croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
 1121     unless ref $GlobalProblem eq $self->{problem}->{record};
 1122   croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
 1123     unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
 1124   croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
 1125     unless $self->{set}->exists($GlobalProblem->set_id);
 1126 
 1127   checkKeyfields($GlobalProblem);
 1128 
 1129   return $self->{problem}->put($GlobalProblem);
 1130 }
 1131 
 1132 sub deleteGlobalProblem($$$) {
 1133   my ($self, $setID, $problemID) = @_;
 1134 
 1135   croak "deleteGlobalProblem: requires 2 arguments"
 1136     unless @_ == 3;
 1137   croak "deleteGlobalProblem: argument 1 must contain a set_id"
 1138     unless defined $setID or caller eq __PACKAGE__;
 1139   croak "deleteGlobalProblem: argument 2 must contain a problem_id"
 1140     unless defined $problemID or caller eq __PACKAGE__;
 1141 
 1142   #$self->deleteUserProblem($_, $setID, $problemID)
 1143   # foreach $self->listProblemUsers($setID, $problemID);
 1144   $self->deleteUserProblem(undef, $setID, $problemID);
 1145   return $self->{problem}->delete($setID, $problemID);
 1146 }
 1147 
 1148 ################################################################################
 1149 # problem_user functions
 1150 ################################################################################
 1151 
 1152 sub newUserProblem {
 1153   my ($self, $prototype) = @_;
 1154   return $self->{problem_user}->{record}->new($prototype);
 1155 }
 1156 
 1157 sub listProblemUsers($$$) {
 1158   my ($self, $setID, $problemID) = @_;
 1159 
 1160   croak "listProblemUsers: requires 2 arguments"
 1161     unless @_ == 3;
 1162   croak "listProblemUsers: argument 1 must contain a set_id"
 1163     unless defined $setID;
 1164   croak "listProblemUsers: argument 2 must contain a problem_id"
 1165     unless defined $problemID;
 1166 
 1167   return map { $_->[0] } # extract user_id
 1168     $self->{problem_user}->list(undef, $setID, $problemID);
 1169 }
 1170 
 1171 sub listUserProblems($$$) {
 1172   my ($self, $userID, $setID) = @_;
 1173 
 1174   croak "listUserProblems: requires 2 arguments"
 1175     unless @_ == 3;
 1176   croak "listUserProblems: argument 1 must contain a user_id"
 1177     unless defined $userID;
 1178   croak "listUserProblems: argument 2 must contain a set_id"
 1179     unless defined $setID;
 1180 
 1181   return map { $_->[2] } # extract problem_id
 1182     $self->{problem_user}->list($userID, $setID, undef);
 1183 }
 1184 
 1185 sub addUserProblem($$) {
 1186   my ($self, $UserProblem) = @_;
 1187 
 1188   croak "addUserProblem: requires 1 argument"
 1189     unless @_ == 2;
 1190   croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
 1191     unless ref $UserProblem eq $self->{problem_user}->{record};
 1192   croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
 1193     if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
 1194   croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
 1195     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
 1196   croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
 1197     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
 1198 
 1199   checkKeyfields($UserProblem);
 1200 
 1201   return $self->{problem_user}->add($UserProblem);
 1202 }
 1203 
 1204 sub getUserProblem($$$$) {
 1205   my ($self, $userID, $setID, $problemID) = @_;
 1206 
 1207   croak "getUserProblem: requires 3 arguments"
 1208     unless @_ == 4;
 1209   croak "getUserProblem: argument 1 must contain a user_id"
 1210     unless defined $userID;
 1211   croak "getUserProblem: argument 2 must contain a set_id"
 1212     unless defined $setID;
 1213   croak "getUserProblem: argument 3 must contain a problem_id"
 1214     unless defined $problemID;
 1215 
 1216   return $self->{problem_user}->get($userID, $setID, $problemID);
 1217 }
 1218 
 1219 =item getUserProblems(@userProblemIDs)
 1220 
 1221 Return a list of user set records associated with the user IDs given. If there
 1222 is no record associated with a given user ID, that element of the list will be
 1223 undefined. @userProblemIDs consists of references to arrays in which the first
 1224 element is the user_id, the second element is the set_id, and the third element
 1225 is the problem_id.
 1226 
 1227 =cut
 1228 
 1229 sub getUserProblems {
 1230   my ($self, @userProblemIDs) = @_;
 1231 
 1232   croak "getUserProblems: requires 1 or more argument"
 1233     unless @_ >= 2;
 1234   foreach my $i (0 .. $#userProblemIDs) {
 1235     croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
 1236       unless defined $userProblemIDs[$i]
 1237              and ref $userProblemIDs[$i] eq "ARRAY"
 1238              and @{$userProblemIDs[$i]} == 3
 1239              and defined $userProblemIDs[$i]->[0]
 1240              and defined $userProblemIDs[$i]->[1]
 1241              and defined $userProblemIDs[$i]->[2];
 1242   }
 1243 
 1244   return map { $self->getUserProblem(@{$_}) } @userProblemIDs;
 1245 }
 1246 
 1247 sub putUserProblem($$) {
 1248   my ($self, $UserProblem) = @_;
 1249 
 1250   croak "putUserProblem: requires 1 argument"
 1251     unless @_ == 2;
 1252   croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
 1253     unless ref $UserProblem eq $self->{problem_user}->{record};
 1254   croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
 1255     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
 1256   croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
 1257     unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
 1258   croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
 1259     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
 1260 
 1261   checkKeyfields($UserProblem);
 1262 
 1263   return $self->{problem_user}->put($UserProblem);
 1264 }
 1265 
 1266 sub deleteUserProblem($$$$) {
 1267   my ($self, $userID, $setID, $problemID) = @_;
 1268 
 1269   croak "getUserProblem: requires 3 arguments"
 1270     unless @_ == 4;
 1271   croak "getUserProblem: argument 1 must contain a user_id"
 1272     unless defined $userID or caller eq __PACKAGE__;
 1273   croak "getUserProblem: argument 2 must contain a set_id"
 1274     unless defined $setID or caller eq __PACKAGE__;
 1275   croak "getUserProblem: argument 3 must contain a problem_id"
 1276     unless defined $problemID or caller eq __PACKAGE__;
 1277 
 1278   return $self->{problem_user}->delete($userID, $setID, $problemID);
 1279 }
 1280 
 1281 ################################################################################
 1282 # set+set_user functions
 1283 ################################################################################
 1284 
 1285 sub getGlobalUserSet {
 1286   carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
 1287   return shift->getMergedSet(@_);
 1288 }
 1289 
 1290 sub getMergedSet {
 1291   my ($self, $userID, $setID) = @_;
 1292 
 1293   #my $timer = WeBWorK::Timing->new("getMergedSet");
 1294 
 1295   croak "getMergedSet: requires 2 arguments"
 1296     unless @_ == 3;
 1297   croak "getMergedSet: argument 1 must contain a user_id"
 1298     unless defined $userID;
 1299   croak "getMergedSet: argument 2 must contain a set_id"
 1300     unless defined $setID;
 1301 
 1302   #$timer->start;
 1303   my $UserSet = $self->getUserSet($userID, $setID);
 1304   #$timer->continue("got user set");
 1305   return unless $UserSet;
 1306   my $GlobalSet = $self->getGlobalSet($setID);
 1307   #$timer->continue("got global set");
 1308   if ($GlobalSet) {
 1309     foreach ($UserSet->FIELDS()) {
 1310       next unless $GlobalSet->can($_);
 1311       next if $UserSet->$_();
 1312       $UserSet->$_($GlobalSet->$_());
 1313     }
 1314   }
 1315   #$timer->continue("merged records");
 1316   #$timer->stop;
 1317   return $UserSet;
 1318 }
 1319 
 1320 
 1321 =item geMegedSets(@userSetIDs)
 1322 
 1323 
 1324 Return a list of merged set records associated with the user IDs given. If there
 1325 is no record associated with a given user ID, that element of the list will be
 1326 undefined. @userSetIDs consists of references to arrays in which the first
 1327 element is the user_id and the second element is the set_id.
 1328 
 1329 
 1330 =cut
 1331 
 1332 
 1333 sub getMergedSets {
 1334   my ($self, @userSetIDs) = @_;
 1335 
 1336   croak "getMergedSets: requires 1 or more argument"
 1337     unless @_ >= 2;
 1338   foreach my $i (0 .. $#userSetIDs) {
 1339     croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair"
 1340       unless defined $userSetIDs[$i]
 1341              and ref $userSetIDs[$i] eq "ARRAY"
 1342              and @{$userSetIDs[$i]} == 2
 1343              and defined $userSetIDs[$i]->[0]
 1344              and defined $userSetIDs[$i]->[1];
 1345   }
 1346 
 1347   return map { $self->getMergedSet(@{$_}) } @userSetIDs;
 1348 
 1349 }
 1350 
 1351 
 1352 
 1353 ################################################################################
 1354 # problem+problem_user functions
 1355 ################################################################################
 1356 
 1357 sub getGlobalUserProblem {
 1358   carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
 1359   return shift->getMergedProblem(@_);
 1360 }
 1361 
 1362 sub getMergedProblem {
 1363   my ($self, $userID, $setID, $problemID) = @_;
 1364 
 1365   #my $timer = WeBWorK::Timing->new("getMergedSet");
 1366 
 1367   croak "getGlobalUserSet: requires 3 arguments"
 1368     unless @_ == 4;
 1369   croak "getGlobalUserSet: argument 1 must contain a user_id"
 1370     unless defined $userID;
 1371   croak "getGlobalUserSet: argument 2 must contain a set_id"
 1372     unless defined $setID;
 1373   croak "getGlobalUserSet: argument 3 must contain a problem_id"
 1374     unless defined $problemID;
 1375 
 1376   #$timer->start;
 1377   my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);
 1378   #$timer->continue("got user problem");
 1379   return unless $UserProblem;
 1380   my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);
 1381   #$timer->continue("got global problem");
 1382   if ($GlobalProblem) {
 1383     foreach ($UserProblem->FIELDS()) {
 1384       next unless $GlobalProblem->can($_);
 1385       next if $UserProblem->$_();
 1386       $UserProblem->$_($GlobalProblem->$_());
 1387     }
 1388   }
 1389   #$timer->continue("merged records");
 1390   #$timer->stop;
 1391   return $UserProblem;
 1392 }
 1393 
 1394 =item getMergedProblems(@userProblemIDs)
 1395 
 1396 Return a list of merged set records associated with the user IDs given. If there
 1397 is no record associated with a given user ID, that element of the list will be
 1398 undefined. @userProblemIDs consists of references to arrays in which the first
 1399 element is the user_id, the second element is the set_id, and the third element
 1400 is the problem_id.
 1401 
 1402 =cut
 1403 
 1404 sub getMergedProblems {
 1405   my ($self, @userProblemIDs) = @_;
 1406 
 1407   croak "getMergedProblems: requires 1 or more argument"
 1408     unless @_ >= 2;
 1409   foreach my $i (0 .. $#userProblemIDs) {
 1410     croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
 1411       unless defined $userProblemIDs[$i]
 1412              and ref $userProblemIDs[$i] eq "ARRAY"
 1413              and @{$userProblemIDs[$i]} == 3
 1414              and defined $userProblemIDs[$i]->[0]
 1415              and defined $userProblemIDs[$i]->[1]
 1416              and defined $userProblemIDs[$i]->[2];
 1417   }
 1418 
 1419   return map { $self->getMergedProblem(@{$_}) } @userProblemIDs;
 1420 }
 1421 
 1422 ################################################################################
 1423 # debugging
 1424 ################################################################################
 1425 
 1426 sub dumpDB($$) {
 1427   my ($self, $table) = @_;
 1428   return $self->{$table}->dumpDB();
 1429 }
 1430 
 1431 ################################################################################
 1432 # sanity checking
 1433 ################################################################################
 1434 
 1435 sub checkKeyfields($) {
 1436   my ($Record) = @_;
 1437   foreach my $keyfield ($Record->KEYFIELDS) {
 1438     my $value = $Record->$keyfield;
 1439     croak "checkKeyfields: $keyfield is empty"
 1440       unless defined $value and $value ne "";
 1441 
 1442     if ($keyfield eq "problem_id") {
 1443       croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
 1444         unless $value =~ m/^\d*$/;
 1445     } else {
 1446       croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
 1447         unless $value =~ m/^[\w-]*$/;
 1448     }
 1449   }
 1450 }
 1451 
 1452 =head1 AUTHOR
 1453 
 1454 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
 1455 
 1456 =cut
 1457 
 1458 1;