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                / 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::Utils qw(runtime_use);
  133 
  134 use constant TABLES => qw(password permission key user set set_user problem problem_user);
  135 
  136 ################################################################################
  137 # constructor
  138 ################################################################################
  139 
  140 =head1 CONSTRUCTOR
  141 
  142 =over
  143 
  144 =item new($ce)
  145 
  146 The C<new> method creates a DB object and brings up the underlying
  147 schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a
  148 WeBWorK::CourseEnvironment object.
  149 
  150 =back
  151 
  152 =head2 C<%dbLayout> Format
  153 
  154 The C<%dbLayout> hash consists of items keyed by table names. The value of each
  155 item is a reference to a hash containing the following items:
  156 
  157 =over
  158 
  159 =item record
  160 
  161 The name of a perl module to use for representing the data in a record.
  162 
  163 =item schema
  164 
  165 The name of a perl module to use for access to the table.
  166 
  167 =item driver
  168 
  169 The name of a perl module to use for access to the data source.
  170 
  171 =item source
  172 
  173 The location of the data source that should be used by the driver module.
  174 Depending on the driver, this may be a path, a url, or a DBI spec.
  175 
  176 =item params
  177 
  178 A reference to a hash containing extra information needed by the schema. Some
  179 schemas require parameters, some do not. Consult the documentation for the
  180 schema in question.
  181 
  182 =back
  183 
  184 For each table defined in C<%dbLayout>, C<new> loads the record, schema, and
  185 driver modules. It the schema module's C<tables> method lists the current table
  186 (or contains the string "*") and the output of the schema and driver modules'
  187 C<style> methods match, the table is installed. Otherwise, an exception is
  188 thrown.
  189 
  190 =cut
  191 
  192 sub new($$) {
  193   my ($invocant, $ce) = @_;
  194   my $class = ref($invocant) || $invocant;
  195   my $self = {};
  196   bless $self, $class; # bless this here so we can pass it to the schema
  197 
  198   # load the modules required to handle each table, and create driver
  199   my %dbLayout = %{$ce->{dbLayout}};
  200   foreach my $table (keys %dbLayout) {
  201     my $layout = $dbLayout{$table};
  202     my $record = $layout->{record};
  203     my $schema = $layout->{schema};
  204     my $driver = $layout->{driver};
  205     my $source = $layout->{source};
  206     my $params = $layout->{params};
  207 
  208     runtime_use($record);
  209 
  210     runtime_use($driver);
  211     my $driverObject = eval { $driver->new($source, $params) };
  212     croak "error instantiating DB driver $driver for table $table: $@"
  213       if $@;
  214 
  215     runtime_use($schema);
  216     my $schemaObject = eval { $schema->new(
  217       $self, $driver->new($source, $params),
  218       $table, $record, $params) };
  219     croak "error instantiating DB schema $schema for table $table: $@"
  220       if $@;
  221 
  222     $self->{$table} = $schemaObject;
  223   }
  224 
  225   return $self;
  226 }
  227 
  228 =head1 METHODS
  229 
  230 =cut
  231 
  232 ################################################################################
  233 # password functions
  234 ################################################################################
  235 
  236 =head2 Password Methods
  237 
  238 =over
  239 
  240 =item listPasswords()
  241 
  242 Returns a list of user IDs representing the records in the password table.
  243 
  244 =cut
  245 
  246 sub listPasswords {
  247   my ($self) = @_;
  248 
  249   croak "listPasswords: requires 0 arguments"
  250     unless @_ == 1;
  251 
  252   return map { $_->[0] }
  253     $self->{password}->list(undef);
  254 }
  255 
  256 =item addPassword($Password)
  257 
  258 $Password is a record object. The password will be added to the password table
  259 if a password with the same user ID does not already exist. If one does exist,
  260 an exception is thrown. To add a password, a user with a matching user ID must
  261 exist in the user table.
  262 
  263 =cut
  264 
  265 sub addPassword($$) {
  266   my ($self, $Password) = @_;
  267 
  268   croak "addPassword: requires 1 argument"
  269     unless @_ == 2;
  270   croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
  271     unless ref $Password eq $self->{password}->{record};
  272   croak "addPassword: password exists (perhaps you meant to use putPassword?)"
  273     if $self->{password}->exists($Password->user_id);
  274   croak "addPassword: user ", $Password->user_id, " not found"
  275     unless $self->{user}->exists($Password->user_id);
  276 
  277   checkKeyfields($Password);
  278 
  279   return $self->{password}->add($Password);
  280 }
  281 
  282 =item getPassword($userID)
  283 
  284 If a record with a matching user ID exists, a record object containting that
  285 record's data will be returned. If no such record exists, an undefined value
  286 will be returned.
  287 
  288 =cut
  289 
  290 sub getPassword($$) {
  291   my ($self, $userID) = @_;
  292 
  293   croak "getPassword: requires 1 argument"
  294     unless @_ == 2;
  295   croak "getPassword: argument 1 must contain a user_id"
  296     unless defined $userID;
  297 
  298   return $self->{password}->get($userID);
  299 }
  300 
  301 =item putPassword($Password)
  302 
  303 $Password is a record object. If a password record with the same user ID exists
  304 in the password table, the data in the record is replaced with the data in
  305 $Password. If a matching password record does not exist, an exception is
  306 thrown.
  307 
  308 =cut
  309 
  310 sub putPassword($$) {
  311   my ($self, $Password) = @_;
  312 
  313   croak "putPassword: requires 1 argument"
  314     unless @_ == 2;
  315   croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
  316     unless ref $Password eq $self->{password}->{record};
  317   croak "putPassword: password not found (perhaps you meant to use addPassword?)"
  318     unless $self->{password}->exists($Password->user_id);
  319 
  320   checkKeyfields($Password);
  321 
  322   return $self->{password}->put($Password);
  323 }
  324 
  325 =item deletePassword($userID)
  326 
  327 If a password record with a user ID matching $userID exists in the password
  328 table, it is removed and the method returns a true value. If one does exist,
  329 a false value is returned.
  330 
  331 =cut
  332 
  333 sub deletePassword($$) {
  334   my ($self, $userID) = @_;
  335 
  336   croak "putPassword: requires 1 argument"
  337     unless @_ == 2;
  338   croak "deletePassword: argument 1 must contain a user_id"
  339     unless defined $userID;
  340 
  341   return $self->{password}->delete($userID);
  342 }
  343 
  344 =back
  345 
  346 =cut
  347 
  348 ################################################################################
  349 # permission functions
  350 ################################################################################
  351 
  352 =head2 Permission Level Methods
  353 
  354 =over
  355 
  356 =item listPermissionLevels()
  357 
  358 Returns a list of user IDs representing the records in the permission table.
  359 
  360 =cut
  361 
  362 sub listPermissionLevels($) {
  363   my ($self) = @_;
  364 
  365   croak "listPermissionLevels: requires 0 arguments"
  366     unless @_ == 1;
  367 
  368   return map { $_->[0] }
  369     $self->{permission}->list(undef);
  370 }
  371 
  372 =item addPermissionLevel($PermissionLevel)
  373 
  374 $PermissionLevel is a record object. The permission level will be added to the
  375 permission table if a permission level with the same user ID does not already
  376 exist. If one does exist, an exception is thrown. To add a permission level, a
  377 user with a matching user ID must exist in the user table.
  378 
  379 =cut
  380 
  381 sub addPermissionLevel($$) {
  382   my ($self, $PermissionLevel) = @_;
  383 
  384   croak "addPermissionLevel: requires 1 argument"
  385     unless @_ == 2;
  386   croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
  387     unless ref $PermissionLevel eq $self->{permission}->{record};
  388   croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
  389     if $self->{permission}->exists($PermissionLevel->user_id);
  390   croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
  391     unless $self->{user}->exists($PermissionLevel->user_id);
  392 
  393   checkKeyfields($PermissionLevel);
  394 
  395   return $self->{permission}->add($PermissionLevel);
  396 }
  397 
  398 =item getPermissionLevel($userID)
  399 
  400 If a record with a matching user ID exists, a record object containting that
  401 record's data will be returned. If no such record exists, an undefined value
  402 will be returned.
  403 
  404 =cut
  405 
  406 sub getPermissionLevel($$) {
  407   my ($self, $userID) = @_;
  408 
  409   croak "getPermissionLevel: requires 1 argument"
  410     unless @_ == 2;
  411   croak "getPermissionLevel: argument 1 must contain a user_id"
  412     unless defined $userID;
  413 
  414   return $self->{permission}->get($userID);
  415 }
  416 
  417 =item putPermissionLevel($PermissionLevel)
  418 
  419 $PermissionLevel is a record object. If a permission level record with the same
  420 user ID exists in the permission table, the data in the record is replaced with
  421 the data in $PermissionLevel. If a matching permission level record does not
  422 exist, an exception is thrown.
  423 
  424 =cut
  425 
  426 sub putPermissionLevel($$) {
  427   my ($self, $PermissionLevel) = @_;
  428 
  429   croak "putPermissionLevel: requires 1 argument"
  430     unless @_ == 2;
  431   croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
  432     unless ref $PermissionLevel eq $self->{permission}->{record};
  433   croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
  434     unless $self->{permission}->exists($PermissionLevel->user_id);
  435 
  436   checkKeyfields($PermissionLevel);
  437 
  438   return $self->{permission}->put($PermissionLevel);
  439 }
  440 
  441 =item deletePermissionLevel($userID)
  442 
  443 If a permission level record with a user ID matching $userID exists in the
  444 permission table, it is removed and the method returns a true value. If one
  445 does exist, a false value is returned.
  446 
  447 =cut
  448 
  449 sub deletePermissionLevel($$) {
  450   my ($self, $userID) = @_;
  451 
  452   croak "deletePermissionLevel: requires 1 argument"
  453     unless @_ == 2;
  454   croak "deletePermissionLevel: argument 1 must contain a user_id"
  455     unless defined $userID;
  456 
  457   return $self->{permission}->delete($userID);
  458 }
  459 
  460 ################################################################################
  461 # key functions
  462 ################################################################################
  463 
  464 =head2 Key Methods
  465 
  466 =over
  467 
  468 =item listKeys()
  469 
  470 Returns a list of user IDs representing the records in the key table.
  471 
  472 =cut
  473 
  474 sub listKeys($) {
  475   my ($self) = @_;
  476 
  477   croak "listKeys: requires 0 arguments"
  478     unless @_ == 1;
  479 
  480   return map { $_->[0] }
  481     $self->{key}->list(undef);
  482 }
  483 
  484 =item addKey($Key)
  485 
  486 $Key is a record object. The key will be added to the key table if a key with
  487 the same user ID does not already exist. If one does exist, an exception is
  488 thrown. To add a key, a user with a matching user ID must exist in the user
  489 table.
  490 
  491 =cut
  492 
  493 sub addKey($$) {
  494   my ($self, $Key) = @_;
  495 
  496   croak "addKey: requires 1 argument"
  497     unless @_ == 2;
  498   croak "addKey: argument 1 must be of type ", $self->{key}->{record}
  499     unless ref $Key eq $self->{key}->{record};
  500   croak "addKey: key exists (perhaps you meant to use putKey?)"
  501     if $self->{key}->exists($Key->user_id);
  502   croak "addKey: user ", $Key->user_id, " not found"
  503     unless $self->{user}->exists($Key->user_id);
  504 
  505   checkKeyfields($Key);
  506 
  507   return $self->{key}->add($Key);
  508 }
  509 
  510 =item getKey($userID)
  511 
  512 If a record with a matching user ID exists, a record object containting that
  513 record's data will be returned. If no such record exists, an undefined value
  514 will be returned.
  515 
  516 =cut
  517 
  518 sub getKey($$) {
  519   my ($self, $userID) = @_;
  520 
  521   croak "getKey: requires 1 argument"
  522     unless @_ == 2;
  523   croak "getKey: argument 1 must contain a user_id"
  524     unless defined $userID;
  525 
  526   return $self->{key}->get($userID);
  527 }
  528 
  529 =item putKey($Key)
  530 
  531 $Key is a record object. If a key record with the same user ID exists in the
  532 key table, the data in the record is replaced with the data in $Key. If a
  533 matching key record does not exist, an exception is thrown.
  534 
  535 =cut
  536 
  537 sub putKey($$) {
  538   my ($self, $Key) = @_;
  539 
  540   croak "putKey: requires 1 argument"
  541     unless @_ == 2;
  542   croak "putKey: argument 1 must be of type ", $self->{key}->{record}
  543     unless ref $Key eq $self->{key}->{record};
  544   croak "putKey: key not found (perhaps you meant to use addKey?)"
  545     unless $self->{key}->exists($Key->user_id);
  546 
  547   checkKeyfields($Key);
  548 
  549   return $self->{key}->put($Key);
  550 }
  551 
  552 =item deleteKey($userID)
  553 
  554 If a key record with a user ID matching $userID exists in the key table, it is
  555 removed and the method returns a true value. If one does exist, a false value
  556 is returned.
  557 
  558 =cut
  559 
  560 sub deleteKey($$) {
  561   my ($self, $userID) = @_;
  562 
  563   croak "deleteKey: requires 1 argument"
  564     unless @_ == 2;
  565   croak "deleteKey: argument 1 must contain a user_id"
  566     unless defined $userID;
  567 
  568   return $self->{key}->delete($userID);
  569 }
  570 
  571 ################################################################################
  572 # user functions
  573 ################################################################################
  574 
  575 =head2 User Methods
  576 
  577 =over
  578 
  579 =item listUsers()
  580 
  581 Returns a list of user IDs representing the records in the user table.
  582 
  583 =cut
  584 
  585 sub listUsers($) {
  586   my ($self) = @_;
  587 
  588   croak "listUsers: requires 0 arguments"
  589     unless @_ == 1;
  590 
  591   return map { $_->[0] }
  592     $self->{user}->list(undef);
  593 }
  594 
  595 =item addUser($User)
  596 
  597 $User is a record object. The user will be added to the user table if a user
  598 with the same user ID does not already exist. If one does exist, an exception
  599 is thrown.
  600 
  601 =cut
  602 
  603 sub addUser($$) {
  604   my ($self, $User) = @_;
  605 
  606   croak "addUser: requires 1 argument"
  607     unless @_ == 2;
  608   croak "addUser: argument 1 must be of type ", $self->{user}->{record}
  609     unless ref $User eq $self->{user}->{record};
  610   croak "addUser: user exists (perhaps you meant to use putUser?)"
  611     if $self->{user}->exists($User->user_id);
  612 
  613   checkKeyfields($User);
  614 
  615   return $self->{user}->add($User);
  616 }
  617 
  618 =item getUser($userID)
  619 
  620 If a record with a matching user ID exists, a record object containting that
  621 record's data will be returned. If no such record exists, an undefined value
  622 will be returned.
  623 
  624 =cut
  625 
  626 sub getUser($$) {
  627   my ($self, $userID) = @_;
  628 
  629   croak "getUser: requires 1 argument"
  630     unless @_ == 2;
  631   croak "getUser: argument 1 must contain a user_id"
  632     unless defined $userID;
  633 
  634   return $self->{user}->get($userID);
  635 }
  636 
  637 =item putUser($User)
  638 
  639 $User is a record object. If a user record with the same user ID exists in the
  640 user table, the data in the record is replaced with the data in $User. If a
  641 matching user record does not exist, an exception is thrown.
  642 
  643 =cut
  644 
  645 sub putUser($$) {
  646   my ($self, $User) = @_;
  647 
  648   croak "putUser: requires 1 argument"
  649     unless @_ == 2;
  650   croak "putUser: argument 1 must be of type ", $self->{user}->{record}
  651     unless ref $User eq $self->{user}->{record};
  652   croak "putUser: user not found (perhaps you meant to use addUser?)"
  653     unless $self->{user}->exists($User->user_id);
  654 
  655   checkKeyfields($User);
  656 
  657   return $self->{user}->put($User);
  658 }
  659 
  660 =item deleteUser($userID)
  661 
  662 If a user record with a user ID matching $userID exists in the user table, it
  663 is removed and the method returns a true value. If one does exist, a false
  664 value is returned. When a user record is deleted, all records associated with
  665 that user are also deleted. This includes the password, permission, and key
  666 records, and all user set records for that user.
  667 
  668 =cut
  669 
  670 sub deleteUser($$) {
  671   my ($self, $userID) = @_;
  672 
  673   croak "deleteUser: requires 1 argument"
  674     unless @_ == 2;
  675   croak "deleteUser: argument 1 must contain a user_id"
  676     unless defined $userID;
  677 
  678   #$self->deleteUserSet($userID, $_)
  679   # foreach $self->listUserSets($userID);
  680   $self->deleteUserSet($userID, undef);
  681   $self->deletePassword($userID);
  682   $self->deletePermissionLevel($userID);
  683   $self->deleteKey($userID);
  684   return $self->{user}->delete($userID);
  685 }
  686 
  687 ################################################################################
  688 # set functions
  689 ################################################################################
  690 
  691 sub listGlobalSets($) {
  692   my ($self) = @_;
  693 
  694   croak "listGlobalSets: requires 0 arguments"
  695     unless @_ == 1;
  696 
  697   return map { $_->[0] }
  698     $self->{set}->list(undef);
  699 }
  700 
  701 sub addGlobalSet($$) {
  702   my ($self, $GlobalSet) = @_;
  703 
  704   croak "addGlobalSet: requires 1 argument"
  705     unless @_ == 2;
  706   croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  707     unless ref $GlobalSet eq $self->{set}->{record};
  708   croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
  709     if $self->{set}->exists($GlobalSet->set_id);
  710 
  711   checkKeyfields($GlobalSet);
  712 
  713   return $self->{set}->add($GlobalSet);
  714 }
  715 
  716 sub getGlobalSet($$) {
  717   my ($self, $setID) = @_;
  718 
  719   croak "getGlobalSet: requires 1 argument"
  720     unless @_ == 2;
  721   croak "getGlobalSet: argument 1 must contain a set_id"
  722     unless defined $setID;
  723 
  724   return $self->{set}->get($setID);
  725 }
  726 
  727 sub putGlobalSet($$) {
  728   my ($self, $GlobalSet) = @_;
  729 
  730   croak "putGlobalSet: requires 1 argument"
  731     unless @_ == 2;
  732   croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
  733     unless ref $GlobalSet eq $self->{set}->{record};
  734   croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
  735     unless $self->{set}->exists($GlobalSet->set_id);
  736 
  737   checkKeyfields($GlobalSet);
  738 
  739   return $self->{set}->put($GlobalSet);
  740 }
  741 
  742 sub deleteGlobalSet($$) {
  743   my ($self, $setID) = @_;
  744 
  745   croak "deleteGlobalSet: requires 1 argument"
  746     unless @_ == 2;
  747   croak "deleteGlobalSet: argument 1 must contain a set_id"
  748     unless defined $setID or caller eq __PACKAGE__;
  749 
  750   #$self->deleteUserSet($_, $setID)
  751   # foreach $self->listSetUsers($setID);
  752   #$self->deleteGlobalProblem($setID, $_)
  753   # foreach $self->listGlobalProblems($setID);
  754   $self->deleteUserSet(undef, $setID);
  755   $self->deleteGlobalProblem($setID, undef);
  756   return $self->{set}->delete($setID);
  757 }
  758 
  759 ################################################################################
  760 # set_user functions
  761 ################################################################################
  762 
  763 sub listSetUsers($$) {
  764   my ($self, $setID) = @_;
  765 
  766   croak "listSetUsers: requires 1 argument"
  767     unless @_ == 2;
  768   croak "listSetUsers: argument 1 must contain a set_id"
  769     unless defined $setID;
  770 
  771   return map { $_->[0] } # extract user_id
  772     $self->{set_user}->list(undef, $setID);
  773 }
  774 
  775 sub listUserSets($$) {
  776   my ($self, $userID) = @_;
  777 
  778   croak "listUserSets: requires 1 argument"
  779     unless @_ == 2;
  780   croak "listUserSets: argument 1 must contain a user_id"
  781     unless defined $userID;
  782 
  783   return map { $_->[1] } # extract set_id
  784     $self->{set_user}->list($userID, undef);
  785 }
  786 
  787 sub addUserSet($$) {
  788   my ($self, $UserSet) = @_;
  789 
  790   croak "addUserSet: requires 1 argument"
  791     unless @_ == 2;
  792   croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
  793     unless ref $UserSet eq $self->{set_user}->{record};
  794   croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
  795     if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
  796   croak "addUserSet: user ", $UserSet->user_id, " not found"
  797     unless $self->{user}->exists($UserSet->user_id);
  798   croak "addUserSet: set ", $UserSet->set_id, " not found"
  799     unless $self->{set}->exists($UserSet->set_id);
  800 
  801   checkKeyfields($UserSet);
  802 
  803   return $self->{set_user}->add($UserSet);
  804 }
  805 
  806 sub getUserSet($$$) {
  807   my ($self, $userID, $setID) = @_;
  808 
  809   croak "getUserSet: requires 2 arguments"
  810     unless @_ == 3;
  811   croak "getUserSet: argument 1 must contain a user_id"
  812     unless defined $userID;
  813   croak "getUserSet: argument 2 must contain a set_id"
  814     unless defined $setID;
  815 
  816   return $self->{set_user}->get($userID, $setID);
  817 }
  818 
  819 sub putUserSet($$) {
  820   my ($self, $UserSet) = @_;
  821 
  822   croak "putUserSet: requires 1 argument"
  823     unless @_ == 2;
  824   croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
  825     unless ref $UserSet eq $self->{set_user}->{record};
  826   croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
  827     unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
  828   croak "putUserSet: user ", $UserSet->user_id, " not found"
  829     unless $self->{user}->exists($UserSet->user_id);
  830   croak "putUserSet: set ", $UserSet->set_id, " not found"
  831     unless $self->{set}->exists($UserSet->set_id);
  832 
  833   checkKeyfields($UserSet);
  834 
  835   return $self->{set_user}->put($UserSet);
  836 }
  837 
  838 sub deleteUserSet($$$) {
  839   my ($self, $userID, $setID) = @_;
  840 
  841   croak "getUserSet: requires 2 arguments"
  842     unless @_ == 3;
  843   croak "getUserSet: argument 1 must contain a user_id"
  844     unless defined $userID or caller eq __PACKAGE__;
  845   croak "getUserSet: argument 2 must contain a set_id"
  846     unless defined $userID or caller eq __PACKAGE__;
  847 
  848   #$self->deleteUserProblem($userID, $setID, $_)
  849   # foreach $self->listUserProblems($userID, $setID);
  850   $self->deleteUserProblem($userID, $setID, undef);
  851   return $self->{set_user}->delete($userID, $setID);
  852 }
  853 
  854 ################################################################################
  855 # problem functions
  856 ################################################################################
  857 
  858 sub listGlobalProblems($$) {
  859   my ($self, $setID) = @_;
  860 
  861   croak "listGlobalProblems: requires 1 arguments"
  862     unless @_ == 2;
  863   croak "listGlobalProblems: argument 1 must contain a set_id"
  864     unless defined $setID;
  865 
  866   return map { $_->[1] }
  867     $self->{problem}->list($setID, undef);
  868 }
  869 
  870 sub addGlobalProblem($$) {
  871   my ($self, $GlobalProblem) = @_;
  872 
  873   croak "addGlobalProblem: requires 1 argument"
  874     unless @_ == 2;
  875   croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
  876     unless ref $GlobalProblem eq $self->{problem}->{record};
  877   croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
  878     if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
  879   croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
  880     unless $self->{set}->exists($GlobalProblem->set_id);
  881 
  882   checkKeyfields($GlobalProblem);
  883 
  884   return $self->{problem}->add($GlobalProblem);
  885 }
  886 
  887 sub getGlobalProblem($$$) {
  888   my ($self, $setID, $problemID) = @_;
  889 
  890   croak "getGlobalProblem: requires 2 arguments"
  891     unless @_ == 3;
  892   croak "getGlobalProblem: argument 1 must contain a set_id"
  893     unless defined $setID;
  894   croak "getGlobalProblem: argument 2 must contain a problem_id"
  895     unless defined $problemID;
  896 
  897   return $self->{problem}->get($setID, $problemID);
  898 }
  899 
  900 sub putGlobalProblem($$) {
  901   my ($self, $GlobalProblem) = @_;
  902 
  903   croak "putGlobalProblem: requires 1 argument"
  904     unless @_ == 2;
  905   croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
  906     unless ref $GlobalProblem eq $self->{problem}->{record};
  907   croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
  908     unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
  909   croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
  910     unless $self->{set}->exists($GlobalProblem->set_id);
  911 
  912   checkKeyfields($GlobalProblem);
  913 
  914   return $self->{problem}->put($GlobalProblem);
  915 }
  916 
  917 sub deleteGlobalProblem($$$) {
  918   my ($self, $setID, $problemID) = @_;
  919 
  920   croak "deleteGlobalProblem: requires 2 arguments"
  921     unless @_ == 3;
  922   croak "deleteGlobalProblem: argument 1 must contain a set_id"
  923     unless defined $setID or caller eq __PACKAGE__;
  924   croak "deleteGlobalProblem: argument 2 must contain a problem_id"
  925     unless defined $problemID or caller eq __PACKAGE__;
  926 
  927   #$self->deleteUserProblem($_, $setID, $problemID)
  928   # foreach $self->listProblemUsers($setID, $problemID);
  929   $self->deleteUserProblem(undef, $setID, $problemID);
  930   return $self->{problem}->delete($setID, $problemID);
  931 }
  932 
  933 ################################################################################
  934 # problem_user functions
  935 ################################################################################
  936 
  937 sub listProblemUsers($$$) {
  938   my ($self, $setID, $problemID) = @_;
  939 
  940   croak "listProblemUsers: requires 2 arguments"
  941     unless @_ == 3;
  942   croak "listProblemUsers: argument 1 must contain a set_id"
  943     unless defined $setID;
  944   croak "listProblemUsers: argument 2 must contain a problem_id"
  945     unless defined $problemID;
  946 
  947   return map { $_->[0] } # extract user_id
  948     $self->{problem_user}->list(undef, $setID, $problemID);
  949 }
  950 
  951 sub listUserProblems($$$) {
  952   my ($self, $userID, $setID) = @_;
  953 
  954   croak "listUserProblems: requires 2 arguments"
  955     unless @_ == 3;
  956   croak "listUserProblems: argument 1 must contain a user_id"
  957     unless defined $userID;
  958   croak "listUserProblems: argument 2 must contain a set_id"
  959     unless defined $setID;
  960 
  961   return map { $_->[2] } # extract problem_id
  962     $self->{problem_user}->list($userID, $setID, undef);
  963 }
  964 
  965 sub addUserProblem($$) {
  966   my ($self, $UserProblem) = @_;
  967 
  968   croak "addUserProblem: requires 1 argument"
  969     unless @_ == 2;
  970   croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
  971     unless ref $UserProblem eq $self->{problem_user}->{record};
  972   croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
  973     if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
  974   croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
  975     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
  976   croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
  977     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
  978 
  979   checkKeyfields($UserProblem);
  980 
  981   return $self->{problem_user}->add($UserProblem);
  982 }
  983 
  984 sub getUserProblem($$$$) {
  985   my ($self, $userID, $setID, $problemID) = @_;
  986 
  987   croak "getUserProblem: requires 3 arguments"
  988     unless @_ == 4;
  989   croak "getUserProblem: argument 1 must contain a user_id"
  990     unless defined $userID;
  991   croak "getUserProblem: argument 2 must contain a set_id"
  992     unless defined $setID;
  993   croak "getUserProblem: argument 3 must contain a problem_id"
  994     unless defined $problemID;
  995 
  996   return $self->{problem_user}->get($userID, $setID, $problemID);
  997 }
  998 
  999 sub putUserProblem($$) {
 1000   my ($self, $UserProblem) = @_;
 1001 
 1002   croak "putUserProblem: requires 1 argument"
 1003     unless @_ == 2;
 1004   croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
 1005     unless ref $UserProblem eq $self->{problem_user}->{record};
 1006   croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
 1007     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
 1008   croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
 1009     unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
 1010   croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
 1011     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
 1012 
 1013   checkKeyfields($UserProblem);
 1014 
 1015   return $self->{problem_user}->put($UserProblem);
 1016 }
 1017 
 1018 sub deleteUserProblem($$$$) {
 1019   my ($self, $userID, $setID, $problemID) = @_;
 1020 
 1021   croak "getUserProblem: requires 3 arguments"
 1022     unless @_ == 4;
 1023   croak "getUserProblem: argument 1 must contain a user_id"
 1024     unless defined $userID or caller eq __PACKAGE__;
 1025   croak "getUserProblem: argument 2 must contain a set_id"
 1026     unless defined $setID or caller eq __PACKAGE__;
 1027   croak "getUserProblem: argument 3 must contain a problem_id"
 1028     unless defined $problemID or caller eq __PACKAGE__;
 1029 
 1030   return $self->{problem_user}->delete($userID, $setID, $problemID);
 1031 }
 1032 
 1033 ################################################################################
 1034 # set+set_user functions
 1035 ################################################################################
 1036 
 1037 sub getGlobalUserSet {
 1038   carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
 1039   return shift->getMergedSet(@_);
 1040 }
 1041 
 1042 sub getMergedSet {
 1043   my ($self, $userID, $setID) = @_;
 1044 
 1045   croak "getGlobalUserSet: requires 2 arguments"
 1046     unless @_ == 3;
 1047   croak "getGlobalUserSet: argument 1 must contain a user_id"
 1048     unless defined $userID;
 1049   croak "getGlobalUserSet: argument 2 must contain a set_id"
 1050     unless defined $setID;
 1051 
 1052   my $UserSet = $self->getUserSet($userID, $setID);
 1053   return unless $UserSet;
 1054   my $GlobalSet = $self->getGlobalSet($setID);
 1055   if ($GlobalSet) {
 1056     foreach ($UserSet->FIELDS()) {
 1057       next unless $GlobalSet->can($_);
 1058       next if $UserSet->$_();
 1059       $UserSet->$_($GlobalSet->$_());
 1060     }
 1061   }
 1062   return $UserSet;
 1063 }
 1064 
 1065 ################################################################################
 1066 # problem+problem_user functions
 1067 ################################################################################
 1068 
 1069 sub getGlobalUserProblem {
 1070   carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
 1071   return shift->getMergedProblem(@_);
 1072 }
 1073 
 1074 sub getMergedProblem {
 1075   my ($self, $userID, $setID, $problemID) = @_;
 1076 
 1077   croak "getGlobalUserSet: requires 3 arguments"
 1078     unless @_ == 4;
 1079   croak "getGlobalUserSet: argument 1 must contain a user_id"
 1080     unless defined $userID;
 1081   croak "getGlobalUserSet: argument 2 must contain a set_id"
 1082     unless defined $setID;
 1083   croak "getGlobalUserSet: argument 3 must contain a problem_id"
 1084     unless defined $problemID;
 1085 
 1086   my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);
 1087   return unless $UserProblem;
 1088   my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);
 1089   if ($GlobalProblem) {
 1090     foreach ($UserProblem->FIELDS()) {
 1091       next unless $GlobalProblem->can($_);
 1092       next if $UserProblem->$_();
 1093       $UserProblem->$_($GlobalProblem->$_());
 1094     }
 1095   }
 1096   return $UserProblem;
 1097 }
 1098 
 1099 ################################################################################
 1100 # debugging
 1101 ################################################################################
 1102 
 1103 sub dumpDB($$) {
 1104   my ($self, $table) = @_;
 1105   return $self->{$table}->dumpDB();
 1106 }
 1107 
 1108 ################################################################################
 1109 # sanity checking
 1110 ################################################################################
 1111 
 1112 sub checkKeyfields($) {
 1113   my ($Record) = @_;
 1114   foreach my $keyfield ($Record->KEYFIELDS) {
 1115     croak "checkKeyfields: invalid character in $keyfield field (valid characters are [A-Za-z0-9_])"
 1116       unless $Record->$keyfield =~ m/^\w*$/;
 1117   }
 1118 }
 1119 
 1120 =head1 AUTHOR
 1121 
 1122 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
 1123 
 1124 =cut
 1125 
 1126 1;