View of /trunk/webwork-modperl/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* get*s 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 $self->{password}->gets(@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 $self->{permission}->gets(@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 $self->{key}->gets(@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 $self->{user}->gets(@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 =back
  815 
  816 =cut
  817 
  818 ################################################################################
  819 # set functions
  820 ################################################################################
  821 
  822 =head2 Global Set Methods
  823 
  824 FIXME: write this
  825 
  826 =over
  827 
  828 =cut
  829 
  830 sub newGlobalSet {
  831   my ($self, $prototype) = @_;
  832   return $self->{set}->{record}->new($prototype);
  833 }
  834 
  835 sub listGlobalSets($) {
  836   my ($self) = @_;
  837 
  838   croak "listGlobalSets: requires 0 arguments"
  839     unless @_ == 1;
  840 
  841   return map { $_->[0] }
  842     $self->{set}->list(undef);
  843 }
  844 
  845 sub addGlobalSet($$) {
  846   my ($self, $GlobalSet) = @_;
  847 
  848   croak "addGlobalSet: requires 1 argument"
  849     unless @_ == 2;
  850   croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  851     unless ref $GlobalSet eq $self->{set}->{record};
  852   croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
  853     if $self->{set}->exists($GlobalSet->set_id);
  854 
  855   checkKeyfields($GlobalSet);
  856 
  857   return $self->{set}->add($GlobalSet);
  858 }
  859 
  860 sub getGlobalSet($$) {
  861   my ($self, $setID) = @_;
  862 
  863   croak "getGlobalSet: requires 1 argument"
  864     unless @_ == 2;
  865   croak "getGlobalSet: argument 1 must contain a set_id"
  866     unless defined $setID;
  867 
  868   return $self->{set}->get($setID);
  869 }
  870 
  871 =item getGlobalSets(@setIDs)
  872 
  873 Return a list of global set records associated with the user IDs given. If there
  874 is no record associated with a given user ID, that element of the list will be
  875 undefined.
  876 
  877 =cut
  878 
  879 sub getGlobalSets {
  880   my ($self, @setIDs) = @_;
  881 
  882   croak "getGlobalSets: requires 1 or more argument"
  883     unless @_ >= 2;
  884   foreach my $i (0 .. $#setIDs) {
  885     croak "getGlobalSets: element $i of argument list must contain a set_id"
  886       unless defined $setIDs[$i];
  887   }
  888 
  889   return $self->{set}->gets(@setIDs);
  890 }
  891 
  892 sub putGlobalSet($$) {
  893   my ($self, $GlobalSet) = @_;
  894 
  895   croak "putGlobalSet: requires 1 argument"
  896     unless @_ == 2;
  897   croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  898     unless ref $GlobalSet eq $self->{set}->{record};
  899   croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
  900     unless $self->{set}->exists($GlobalSet->set_id);
  901 
  902   checkKeyfields($GlobalSet);
  903 
  904   return $self->{set}->put($GlobalSet);
  905 }
  906 
  907 sub deleteGlobalSet($$) {
  908   my ($self, $setID) = @_;
  909 
  910   croak "deleteGlobalSet: requires 1 argument"
  911     unless @_ == 2;
  912   croak "deleteGlobalSet: argument 1 must contain a set_id"
  913     unless defined $setID or caller eq __PACKAGE__;
  914 
  915   #$self->deleteUserSet($_, $setID)
  916   # foreach $self->listSetUsers($setID);
  917   #$self->deleteGlobalProblem($setID, $_)
  918   # foreach $self->listGlobalProblems($setID);
  919   $self->deleteUserSet(undef, $setID);
  920   $self->deleteGlobalProblem($setID, undef);
  921   return $self->{set}->delete($setID);
  922 }
  923 
  924 =back
  925 
  926 =cut
  927 
  928 ################################################################################
  929 # set_user functions
  930 ################################################################################
  931 
  932 =head2 User-Specific Set Methods
  933 
  934 FIXME: write this
  935 
  936 =over
  937 
  938 =cut
  939 
  940 sub newUserSet {
  941   my ($self, $prototype) = @_;
  942   return $self->{set_user}->{record}->new($prototype);
  943 }
  944 
  945 sub listSetUsers($$) {
  946   my ($self, $setID) = @_;
  947 
  948   croak "listSetUsers: requires 1 argument"
  949     unless @_ == 2;
  950   croak "listSetUsers: argument 1 must contain a set_id"
  951     unless defined $setID;
  952 
  953   return map { $_->[0] } # extract user_id
  954     $self->{set_user}->list(undef, $setID);
  955 }
  956 
  957 sub listUserSets($$) {
  958   my ($self, $userID) = @_;
  959 
  960   croak "listUserSets: requires 1 argument"
  961     unless @_ == 2;
  962   croak "listUserSets: argument 1 must contain a user_id"
  963     unless defined $userID;
  964 
  965   return map { $_->[1] } # extract set_id
  966     $self->{set_user}->list($userID, undef);
  967 }
  968 
  969 sub addUserSet($$) {
  970   my ($self, $UserSet) = @_;
  971 
  972   croak "addUserSet: requires 1 argument"
  973     unless @_ == 2;
  974   croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
  975     unless ref $UserSet eq $self->{set_user}->{record};
  976   croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
  977     if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
  978   croak "addUserSet: user ", $UserSet->user_id, " not found"
  979     unless $self->{user}->exists($UserSet->user_id);
  980   croak "addUserSet: set ", $UserSet->set_id, " not found"
  981     unless $self->{set}->exists($UserSet->set_id);
  982 
  983   checkKeyfields($UserSet);
  984 
  985   return $self->{set_user}->add($UserSet);
  986 }
  987 
  988 sub getUserSet($$$) {
  989   my ($self, $userID, $setID) = @_;
  990 
  991   croak "getUserSet: requires 2 arguments"
  992     unless @_ == 3;
  993   croak "getUserSet: argument 1 must contain a user_id"
  994     unless defined $userID;
  995   croak "getUserSet: argument 2 must contain a set_id"
  996     unless defined $setID;
  997 
  998   return $self->{set_user}->get($userID, $setID);
  999 }
 1000 
 1001 =item getUserSets(@userSetIDs)
 1002 
 1003 Return a list of user set records associated with the user IDs given. If there
 1004 is no record associated with a given user ID, that element of the list will be
 1005 undefined. @userProblemIDs consists of references to arrays in which the first
 1006 element is the user_id and the second element is the set_id.
 1007 
 1008 =cut
 1009 
 1010 sub getUserSets {
 1011   my ($self, @userSetIDs) = @_;
 1012 
 1013   croak "getUserSets: requires 1 or more argument"
 1014     unless @_ >= 2;
 1015   foreach my $i (0 .. $#userSetIDs) {
 1016     croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair"
 1017       unless defined $userSetIDs[$i]
 1018              and ref $userSetIDs[$i] eq "ARRAY"
 1019              and @{$userSetIDs[$i]} == 2
 1020              and defined $userSetIDs[$i]->[0]
 1021              and defined $userSetIDs[$i]->[1];
 1022   }
 1023 
 1024   return $self->{set_user}->gets(@userSetIDs);
 1025 }
 1026 
 1027 sub putUserSet($$) {
 1028   my ($self, $UserSet) = @_;
 1029 
 1030   croak "putUserSet: requires 1 argument"
 1031     unless @_ == 2;
 1032   croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
 1033     unless ref $UserSet eq $self->{set_user}->{record};
 1034   croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
 1035     unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
 1036   croak "putUserSet: user ", $UserSet->user_id, " not found"
 1037     unless $self->{user}->exists($UserSet->user_id);
 1038   croak "putUserSet: set ", $UserSet->set_id, " not found"
 1039     unless $self->{set}->exists($UserSet->set_id);
 1040 
 1041   checkKeyfields($UserSet);
 1042 
 1043   return $self->{set_user}->put($UserSet);
 1044 }
 1045 
 1046 sub deleteUserSet($$$) {
 1047   my ($self, $userID, $setID) = @_;
 1048 
 1049   croak "getUserSet: requires 2 arguments"
 1050     unless @_ == 3;
 1051   croak "getUserSet: argument 1 must contain a user_id"
 1052     unless defined $userID or caller eq __PACKAGE__;
 1053   croak "getUserSet: argument 2 must contain a set_id"
 1054     unless defined $userID or caller eq __PACKAGE__;
 1055 
 1056   #$self->deleteUserProblem($userID, $setID, $_)
 1057   # foreach $self->listUserProblems($userID, $setID);
 1058   $self->deleteUserProblem($userID, $setID, undef);
 1059   return $self->{set_user}->delete($userID, $setID);
 1060 }
 1061 
 1062 =back
 1063 
 1064 =cut
 1065 
 1066 ################################################################################
 1067 # problem functions
 1068 ################################################################################
 1069 
 1070 =head2 Global Problem Methods
 1071 
 1072 FIXME: write this
 1073 
 1074 =over
 1075 
 1076 =cut
 1077 
 1078 sub newGlobalProblem {
 1079   my ($self, $prototype) = @_;
 1080   return $self->{problem}->{record}->new($prototype);
 1081 }
 1082 
 1083 sub listGlobalProblems($$) {
 1084   my ($self, $setID) = @_;
 1085 
 1086   croak "listGlobalProblems: requires 1 arguments"
 1087     unless @_ == 2;
 1088   croak "listGlobalProblems: argument 1 must contain a set_id"
 1089     unless defined $setID;
 1090 
 1091   return map { $_->[1] }
 1092     $self->{problem}->list($setID, undef);
 1093 }
 1094 
 1095 sub addGlobalProblem($$) {
 1096   my ($self, $GlobalProblem) = @_;
 1097 
 1098   croak "addGlobalProblem: requires 1 argument"
 1099     unless @_ == 2;
 1100   croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
 1101     unless ref $GlobalProblem eq $self->{problem}->{record};
 1102   croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
 1103     if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
 1104   croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
 1105     unless $self->{set}->exists($GlobalProblem->set_id);
 1106 
 1107   checkKeyfields($GlobalProblem);
 1108 
 1109   return $self->{problem}->add($GlobalProblem);
 1110 }
 1111 
 1112 sub getGlobalProblem($$$) {
 1113   my ($self, $setID, $problemID) = @_;
 1114 
 1115   croak "getGlobalProblem: requires 2 arguments"
 1116     unless @_ == 3;
 1117   croak "getGlobalProblem: argument 1 must contain a set_id"
 1118     unless defined $setID;
 1119   croak "getGlobalProblem: argument 2 must contain a problem_id"
 1120     unless defined $problemID;
 1121 
 1122   return $self->{problem}->get($setID, $problemID);
 1123 }
 1124 
 1125 =item getGlobalProblems(@problemIDs)
 1126 
 1127 Return a list of global set records associated with the user IDs given. If there
 1128 is no record associated with a given user ID, that element of the list will be
 1129 undefined. @problemIDs consists of references to arrays in which the first
 1130 element is the set_id, and the second element is the problem_id.
 1131 
 1132 =cut
 1133 
 1134 sub getGlobalProblems {
 1135   my ($self, @problemIDs) = @_;
 1136 
 1137   croak "getGlobalProblems: requires 1 or more argument"
 1138     unless @_ >= 2;
 1139   foreach my $i (0 .. $#problemIDs) {
 1140     croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair"
 1141       unless defined $problemIDs[$i]
 1142              and ref $problemIDs[$i] eq "ARRAY"
 1143              and @{$problemIDs[$i]} == 2
 1144              and defined $problemIDs[$i]->[0]
 1145              and defined $problemIDs[$i]->[1];
 1146   }
 1147 
 1148   return $self->{problem}->gets(@problemIDs);
 1149 }
 1150 
 1151 sub putGlobalProblem($$) {
 1152   my ($self, $GlobalProblem) = @_;
 1153 
 1154   croak "putGlobalProblem: requires 1 argument"
 1155     unless @_ == 2;
 1156   croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
 1157     unless ref $GlobalProblem eq $self->{problem}->{record};
 1158   croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
 1159     unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
 1160   croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
 1161     unless $self->{set}->exists($GlobalProblem->set_id);
 1162 
 1163   checkKeyfields($GlobalProblem);
 1164 
 1165   return $self->{problem}->put($GlobalProblem);
 1166 }
 1167 
 1168 sub deleteGlobalProblem($$$) {
 1169   my ($self, $setID, $problemID) = @_;
 1170 
 1171   croak "deleteGlobalProblem: requires 2 arguments"
 1172     unless @_ == 3;
 1173   croak "deleteGlobalProblem: argument 1 must contain a set_id"
 1174     unless defined $setID or caller eq __PACKAGE__;
 1175   croak "deleteGlobalProblem: argument 2 must contain a problem_id"
 1176     unless defined $problemID or caller eq __PACKAGE__;
 1177 
 1178   #$self->deleteUserProblem($_, $setID, $problemID)
 1179   # foreach $self->listProblemUsers($setID, $problemID);
 1180   $self->deleteUserProblem(undef, $setID, $problemID);
 1181   return $self->{problem}->delete($setID, $problemID);
 1182 }
 1183 
 1184 =back
 1185 
 1186 =cut
 1187 
 1188 ################################################################################
 1189 # problem_user functions
 1190 ################################################################################
 1191 
 1192 =head2 User-Specific Problem Methods
 1193 
 1194 FIXME: write this
 1195 
 1196 =over
 1197 
 1198 =cut
 1199 
 1200 sub newUserProblem {
 1201   my ($self, $prototype) = @_;
 1202   return $self->{problem_user}->{record}->new($prototype);
 1203 }
 1204 
 1205 sub listProblemUsers($$$) {
 1206   my ($self, $setID, $problemID) = @_;
 1207 
 1208   croak "listProblemUsers: requires 2 arguments"
 1209     unless @_ == 3;
 1210   croak "listProblemUsers: argument 1 must contain a set_id"
 1211     unless defined $setID;
 1212   croak "listProblemUsers: argument 2 must contain a problem_id"
 1213     unless defined $problemID;
 1214 
 1215   return map { $_->[0] } # extract user_id
 1216     $self->{problem_user}->list(undef, $setID, $problemID);
 1217 }
 1218 
 1219 sub listUserProblems($$$) {
 1220   my ($self, $userID, $setID) = @_;
 1221 
 1222   croak "listUserProblems: requires 2 arguments"
 1223     unless @_ == 3;
 1224   croak "listUserProblems: argument 1 must contain a user_id"
 1225     unless defined $userID;
 1226   croak "listUserProblems: argument 2 must contain a set_id"
 1227     unless defined $setID;
 1228 
 1229   return map { $_->[2] } # extract problem_id
 1230     $self->{problem_user}->list($userID, $setID, undef);
 1231 }
 1232 
 1233 sub addUserProblem($$) {
 1234   my ($self, $UserProblem) = @_;
 1235 
 1236   croak "addUserProblem: requires 1 argument"
 1237     unless @_ == 2;
 1238   croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
 1239     unless ref $UserProblem eq $self->{problem_user}->{record};
 1240   croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
 1241     if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
 1242   croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
 1243     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
 1244   croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
 1245     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
 1246 
 1247   checkKeyfields($UserProblem);
 1248 
 1249   return $self->{problem_user}->add($UserProblem);
 1250 }
 1251 
 1252 sub getUserProblem($$$$) {
 1253   my ($self, $userID, $setID, $problemID) = @_;
 1254 
 1255   croak "getUserProblem: requires 3 arguments"
 1256     unless @_ == 4;
 1257   croak "getUserProblem: argument 1 must contain a user_id"
 1258     unless defined $userID;
 1259   croak "getUserProblem: argument 2 must contain a set_id"
 1260     unless defined $setID;
 1261   croak "getUserProblem: argument 3 must contain a problem_id"
 1262     unless defined $problemID;
 1263 
 1264   return $self->{problem_user}->get($userID, $setID, $problemID);
 1265 }
 1266 
 1267 =item getUserProblems(@userProblemIDs)
 1268 
 1269 Return a list of user set records associated with the user IDs given. If there
 1270 is no record associated with a given user ID, that element of the list will be
 1271 undefined. @userProblemIDs consists of references to arrays in which the first
 1272 element is the user_id, the second element is the set_id, and the third element
 1273 is the problem_id.
 1274 
 1275 =cut
 1276 
 1277 sub getUserProblems {
 1278   my ($self, @userProblemIDs) = @_;
 1279 
 1280   croak "getUserProblems: requires 1 or more argument"
 1281     unless @_ >= 2;
 1282   foreach my $i (0 .. $#userProblemIDs) {
 1283     croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
 1284       unless defined $userProblemIDs[$i]
 1285              and ref $userProblemIDs[$i] eq "ARRAY"
 1286              and @{$userProblemIDs[$i]} == 3
 1287              and defined $userProblemIDs[$i]->[0]
 1288              and defined $userProblemIDs[$i]->[1]
 1289              and defined $userProblemIDs[$i]->[2];
 1290   }
 1291 
 1292   return $self->{problem_user}->get(@userProblemIDs);
 1293 }
 1294 
 1295 sub putUserProblem($$) {
 1296   my ($self, $UserProblem) = @_;
 1297 
 1298   croak "putUserProblem: requires 1 argument"
 1299     unless @_ == 2;
 1300   croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
 1301     unless ref $UserProblem eq $self->{problem_user}->{record};
 1302   croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
 1303     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
 1304   croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
 1305     unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
 1306   croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
 1307     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
 1308 
 1309   checkKeyfields($UserProblem);
 1310 
 1311   return $self->{problem_user}->put($UserProblem);
 1312 }
 1313 
 1314 sub deleteUserProblem($$$$) {
 1315   my ($self, $userID, $setID, $problemID) = @_;
 1316 
 1317   croak "getUserProblem: requires 3 arguments"
 1318     unless @_ == 4;
 1319   croak "getUserProblem: argument 1 must contain a user_id"
 1320     unless defined $userID or caller eq __PACKAGE__;
 1321   croak "getUserProblem: argument 2 must contain a set_id"
 1322     unless defined $setID or caller eq __PACKAGE__;
 1323   croak "getUserProblem: argument 3 must contain a problem_id"
 1324     unless defined $problemID or caller eq __PACKAGE__;
 1325 
 1326   return $self->{problem_user}->delete($userID, $setID, $problemID);
 1327 }
 1328 
 1329 =back
 1330 
 1331 =cut
 1332 
 1333 ################################################################################
 1334 # set+set_user functions
 1335 ################################################################################
 1336 
 1337 =head2 Set Merging Methods
 1338 
 1339 FIXME: write this
 1340 
 1341 =over
 1342 
 1343 =cut
 1344 
 1345 sub getGlobalUserSet {
 1346   carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
 1347   return shift->getMergedSet(@_);
 1348 }
 1349 
 1350 sub getMergedSet {
 1351   my ($self, $userID, $setID) = @_;
 1352 
 1353   croak "getMergedSet: requires 2 arguments"
 1354     unless @_ == 3;
 1355   croak "getMergedSet: argument 1 must contain a user_id"
 1356     unless defined $userID;
 1357   croak "getMergedSet: argument 2 must contain a set_id"
 1358     unless defined $setID;
 1359 
 1360   #my $UserSet = $self->getUserSet($userID, $setID);
 1361   #return unless $UserSet;
 1362   #my $GlobalSet = $self->getGlobalSet($setID);
 1363   #if ($GlobalSet) {
 1364   # foreach ($UserSet->FIELDS()) {
 1365   #   next unless $GlobalSet->can($_);
 1366   #   next if $UserSet->$_();
 1367   #   $UserSet->$_($GlobalSet->$_());
 1368   # }
 1369   #}
 1370   #return $UserSet;
 1371 
 1372   return $self->getMergedSets([$userID, $setID]);
 1373 }
 1374 
 1375 =item geMegedSets(@userSetIDs)
 1376 
 1377 Return a list of merged set records associated with the user IDs given. If there
 1378 is no record associated with a given user ID, that element of the list will be
 1379 undefined. @userSetIDs consists of references to arrays in which the first
 1380 element is the user_id and the second element is the set_id.
 1381 
 1382 =cut
 1383 
 1384 sub getMergedSets {
 1385   my ($self, @userSetIDs) = @_;
 1386 
 1387   croak "getMergedSets: requires 1 or more argument"
 1388     unless @_ >= 2;
 1389   foreach my $i (0 .. $#userSetIDs) {
 1390     croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair"
 1391       unless defined $userSetIDs[$i]
 1392              and ref $userSetIDs[$i] eq "ARRAY"
 1393              and @{$userSetIDs[$i]} == 2
 1394              and defined $userSetIDs[$i]->[0]
 1395              and defined $userSetIDs[$i]->[1];
 1396   }
 1397 
 1398   my @UserSets = $self->getUserSets(@userSetIDs);
 1399 
 1400   my @globalSetIDs = map { [ $_->[1] ] } @userSetIDs;
 1401   my @GlobalSets = $self->getGlobalSets(@globalSetIDs);
 1402 
 1403   my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
 1404   my @commonFields = grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
 1405 
 1406   for (my $i = 0; $i < @UserSets; $i++) {
 1407     my $UserSet = $UserSets[$i];
 1408     my $GlobalSet = $GlobalSets[$i];
 1409     next unless $UserSet and $GlobalSet;
 1410     foreach my $field (@commonFields) {
 1411       next if $UserSet->$field;
 1412       $UserSet->$field($GlobalSet->$field);
 1413     }
 1414   }
 1415 
 1416   return @UserSets;
 1417 }
 1418 
 1419 =back
 1420 
 1421 =cut
 1422 
 1423 ################################################################################
 1424 # problem+problem_user functions
 1425 ################################################################################
 1426 
 1427 =head2 Problem Merging Methods
 1428 
 1429 FIXME: write this
 1430 
 1431 =over
 1432 
 1433 =cut
 1434 
 1435 sub getGlobalUserProblem {
 1436   carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
 1437   return shift->getMergedProblem(@_);
 1438 }
 1439 
 1440 sub getMergedProblem {
 1441   my ($self, $userID, $setID, $problemID) = @_;
 1442 
 1443   croak "getGlobalUserSet: requires 3 arguments"
 1444     unless @_ == 4;
 1445   croak "getGlobalUserSet: argument 1 must contain a user_id"
 1446     unless defined $userID;
 1447   croak "getGlobalUserSet: argument 2 must contain a set_id"
 1448     unless defined $setID;
 1449   croak "getGlobalUserSet: argument 3 must contain a problem_id"
 1450     unless defined $problemID;
 1451 
 1452   #my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);
 1453   #return unless $UserProblem;
 1454   #my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);
 1455   #if ($GlobalProblem) {
 1456   # foreach ($UserProblem->FIELDS()) {
 1457   #   next unless $GlobalProblem->can($_);
 1458   #   next if $UserProblem->$_();
 1459   #   $UserProblem->$_($GlobalProblem->$_());
 1460   # }
 1461   #}
 1462   #return $UserProblem;
 1463 
 1464   return $self->getMergedProblems([$userID, $setID, $problemID]);
 1465 }
 1466 
 1467 =item getMergedProblems(@userProblemIDs)
 1468 
 1469 Return a list of merged set records associated with the user IDs given. If there
 1470 is no record associated with a given user ID, that element of the list will be
 1471 undefined. @userProblemIDs consists of references to arrays in which the first
 1472 element is the user_id, the second element is the set_id, and the third element
 1473 is the problem_id.
 1474 
 1475 =cut
 1476 
 1477 #sub getMergedProblems {
 1478 # my ($self, @userProblemIDs) = @_;
 1479 #
 1480 # croak "getMergedProblems: requires 1 or more argument"
 1481 #   unless @_ >= 2;
 1482 # foreach my $i (0 .. $#userProblemIDs) {
 1483 #   croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
 1484 #     unless defined $userProblemIDs[$i]
 1485 #            and ref $userProblemIDs[$i] eq "ARRAY"
 1486 #            and @{$userProblemIDs[$i]} == 3
 1487 #            and defined $userProblemIDs[$i]->[0]
 1488 #            and defined $userProblemIDs[$i]->[1]
 1489 #            and defined $userProblemIDs[$i]->[2];
 1490 # }
 1491 #
 1492 # return map { $self->getMergedProblem(@{$_}) } @userProblemIDs;
 1493 #}
 1494 
 1495 sub getMergedProblems {
 1496   my ($self, @userProblemIDs) = @_;
 1497 
 1498   croak "getMergedProblems: requires 1 or more argument"
 1499     unless @_ >= 2;
 1500   foreach my $i (0 .. $#userProblemIDs) {
 1501     croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
 1502       unless defined $userProblemIDs[$i]
 1503              and ref $userProblemIDs[$i] eq "ARRAY"
 1504              and @{$userProblemIDs[$i]} == 3
 1505              and defined $userProblemIDs[$i]->[0]
 1506              and defined $userProblemIDs[$i]->[1]
 1507              and defined $userProblemIDs[$i]->[2];
 1508   }
 1509 
 1510   my @UserProblems = $self->getUserProblems(@userProblemIDs);
 1511 
 1512   my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @userProblemIDs;
 1513   my @GlobalProblems = $self->getGlobalProblems(@globalProblemIDs);
 1514 
 1515   my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
 1516   my @commonFields = grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
 1517 
 1518   for (my $i = 0; $i < @UserProblems; $i++) {
 1519     my $UserProblem = $UserProblems[$i];
 1520     my $GlobalProblem = $GlobalProblems[$i];
 1521     next unless $UserProblem and $GlobalProblem;
 1522     foreach my $field (@commonFields) {
 1523       next if $UserProblem->$field;
 1524       $UserProblem->$field($GlobalProblem->$field);
 1525     }
 1526   }
 1527 
 1528   return @UserProblems;
 1529 }
 1530 
 1531 =back
 1532 
 1533 =cut
 1534 
 1535 ################################################################################
 1536 # debugging
 1537 ################################################################################
 1538 
 1539 #sub dumpDB($$) {
 1540 # my ($self, $table) = @_;
 1541 # return $self->{$table}->dumpDB();
 1542 #}
 1543 
 1544 ################################################################################
 1545 # sanity checking
 1546 ################################################################################
 1547 
 1548 sub checkKeyfields($) {
 1549   my ($Record) = @_;
 1550   foreach my $keyfield ($Record->KEYFIELDS) {
 1551     my $value = $Record->$keyfield;
 1552     croak "checkKeyfields: $keyfield is empty"
 1553       unless defined $value and $value ne "";
 1554 
 1555     if ($keyfield eq "problem_id") {
 1556       croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
 1557         unless $value =~ m/^\d*$/;
 1558     } else {
 1559       croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
 1560         unless $value =~ m/^[\w-]*$/;
 1561     }
 1562   }
 1563 }
 1564 
 1565 =head1 AUTHOR
 1566 
 1567 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
 1568 
 1569 =cut
 1570 
 1571 1;