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