[system] / branches / rel-2-1-a1 / webwork-modperl / lib / WeBWorK / DB.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-1-a1/webwork-modperl/lib/WeBWorK/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1589 Revision 1635
… …
241Returns a new, empty password object. 241Returns a new, empty password object.
242 242
243=cut 243=cut
244 244
245sub newPassword { 245sub newPassword {
246 my ($self, $prototype) = @_; 246 my ($self, @prototype) = @_;
247 return $self->{password}->{record}->new($prototype); 247 return $self->{password}->{record}->new(@prototype);
248} 248}
249 249
250=item listPasswords() 250=item listPasswords()
251 251
252Returns a list of user IDs representing the records in the password table. 252Returns a list of user IDs representing the records in the password table.
… …
277 277
278 croak "addPassword: requires 1 argument" 278 croak "addPassword: requires 1 argument"
279 unless @_ == 2; 279 unless @_ == 2;
280 croak "addPassword: argument 1 must be of type ", $self->{password}->{record} 280 croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
281 unless ref $Password eq $self->{password}->{record}; 281 unless ref $Password eq $self->{password}->{record};
282
283 checkKeyfields($Password);
284
282 croak "addPassword: password exists (perhaps you meant to use putPassword?)" 285 croak "addPassword: password exists (perhaps you meant to use putPassword?)"
283 if $self->{password}->exists($Password->user_id); 286 if $self->{password}->exists($Password->user_id);
284 croak "addPassword: user ", $Password->user_id, " not found" 287 croak "addPassword: user ", $Password->user_id, " not found"
285 unless $self->{user}->exists($Password->user_id); 288 unless $self->{user}->exists($Password->user_id);
286 289
287 checkKeyfields($Password);
288
289 return $self->{password}->add($Password); 290 return $self->{password}->add($Password);
290} 291}
291 292
292=item getPassword($userID) 293=item getPassword($userID)
293 294
294If a record with a matching user ID exists, a record object containting that 295If a record with a matching user ID exists, a record object containting that
295record's data will be returned. If no such record exists, an undefined value 296record's data will be returned. If no such record exists, one will be created.
296will be returned.
297 297
298=cut 298=cut
299 299
300sub getPassword { 300sub getPassword {
301 my ($self, $userID) = @_; 301 my ($self, $userID) = @_;
… …
303 croak "getPassword: requires 1 argument" 303 croak "getPassword: requires 1 argument"
304 unless @_ == 2; 304 unless @_ == 2;
305 croak "getPassword: argument 1 must contain a user_id" 305 croak "getPassword: argument 1 must contain a user_id"
306 unless defined $userID; 306 unless defined $userID;
307 307
308 return $self->{password}->get($userID); 308 #return $self->{password}->get($userID);
309 return ( $self->getPasswords($userID) )[0];
309} 310}
310 311
311=item getPasswords(@uesrIDs) 312=item getPasswords(@uesrIDs)
312 313
313Return a list of password records associated with the user IDs given. If there 314Return a list of password records associated with the user IDs given. If there
314is no record associated with a given user ID, that element of the list will be 315is no record associated with a given user ID, one will be created.
315undefined.
316 316
317=cut 317=cut
318 318
319sub getPasswords { 319sub getPasswords {
320 my ($self, @userIDs) = @_; 320 my ($self, @userIDs) = @_;
… …
324 foreach my $i (0 .. $#userIDs) { 324 foreach my $i (0 .. $#userIDs) {
325 croak "getPasswords: element $i of argument list must contain a user_id" 325 croak "getPasswords: element $i of argument list must contain a user_id"
326 unless defined $userIDs[$i]; 326 unless defined $userIDs[$i];
327 } 327 }
328 328
329 return $self->{password}->gets(map { [$_] } @userIDs); 329 my @Passwords = $self->{password}->gets(map { [$_] } @userIDs);
330
331 for (my $i = 0; $i < @Passwords; $i++) {
332 my $Password = $Passwords[$i];
333 my $userID = $userIDs[$i];
334 if (not defined $Password) {
335 #warn "not defined\n";
336 if ($self->{user}->exists($userID)) {
337 #warn "user exists\n";
338 $Password = $self->newPassword(user_id => $userID);
339 eval { $self->addPassword($Password) };
340 if ($@ and $@ !~ m/password exists/) {
341 die "error while auto-creating password record for user $userID: \"$@\"";
342 }
343 }
344 }
345 }
346
347 return @Passwords;
330} 348}
331 349
332=item putPassword($Password) 350=item putPassword($Password)
333 351
334$Password is a record object. If a password record with the same user ID exists 352$Password is a record object. If a password record with the same user ID exists
… …
343 361
344 croak "putPassword: requires 1 argument" 362 croak "putPassword: requires 1 argument"
345 unless @_ == 2; 363 unless @_ == 2;
346 croak "putPassword: argument 1 must be of type ", $self->{password}->{record} 364 croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
347 unless ref $Password eq $self->{password}->{record}; 365 unless ref $Password eq $self->{password}->{record};
366
367 checkKeyfields($Password);
368
348 croak "putPassword: password not found (perhaps you meant to use addPassword?)" 369 croak "putPassword: password not found (perhaps you meant to use addPassword?)"
349 unless $self->{password}->exists($Password->user_id); 370 unless $self->{password}->exists($Password->user_id);
350
351 checkKeyfields($Password);
352 371
353 return $self->{password}->put($Password); 372 return $self->{password}->put($Password);
354} 373}
355 374
356=item deletePassword($userID) 375=item deletePassword($userID)
… …
389Returns a new, empty permission level object. 408Returns a new, empty permission level object.
390 409
391=cut 410=cut
392 411
393sub newPermissionLevel { 412sub newPermissionLevel {
394 my ($self, $prototype) = @_; 413 my ($self, @prototype) = @_;
395 return $self->{permission}->{record}->new($prototype); 414 return $self->{permission}->{record}->new(@prototype);
396} 415}
397 416
398=item listPermissionLevels() 417=item listPermissionLevels()
399 418
400Returns a list of user IDs representing the records in the permission table. 419Returns a list of user IDs representing the records in the permission table.
… …
425 444
426 croak "addPermissionLevel: requires 1 argument" 445 croak "addPermissionLevel: requires 1 argument"
427 unless @_ == 2; 446 unless @_ == 2;
428 croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record} 447 croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
429 unless ref $PermissionLevel eq $self->{permission}->{record}; 448 unless ref $PermissionLevel eq $self->{permission}->{record};
449
450 checkKeyfields($PermissionLevel);
451
430 croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)" 452 croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
431 if $self->{permission}->exists($PermissionLevel->user_id); 453 if $self->{permission}->exists($PermissionLevel->user_id);
432 croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found" 454 croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
433 unless $self->{user}->exists($PermissionLevel->user_id); 455 unless $self->{user}->exists($PermissionLevel->user_id);
434 456
435 checkKeyfields($PermissionLevel);
436
437 return $self->{permission}->add($PermissionLevel); 457 return $self->{permission}->add($PermissionLevel);
438} 458}
439 459
440=item getPermissionLevel($userID) 460=item getPermissionLevel($userID)
441 461
442If a record with a matching user ID exists, a record object containting that 462If a record with a matching user ID exists, a record object containting that
443record's data will be returned. If no such record exists, an undefined value 463record's data will be returned. If no such record exists, one will be created.
444will be returned.
445 464
446=cut 465=cut
447 466
448sub getPermissionLevel($$) { 467sub getPermissionLevel($$) {
449 my ($self, $userID) = @_; 468 my ($self, $userID) = @_;
… …
451 croak "getPermissionLevel: requires 1 argument" 470 croak "getPermissionLevel: requires 1 argument"
452 unless @_ == 2; 471 unless @_ == 2;
453 croak "getPermissionLevel: argument 1 must contain a user_id" 472 croak "getPermissionLevel: argument 1 must contain a user_id"
454 unless defined $userID; 473 unless defined $userID;
455 474
456 return $self->{permission}->get($userID); 475 #return $self->{permission}->get($userID);
476 return ( $self->getPermissionLevels($userID) )[0];
457} 477}
458 478
459=item getPermissionLevels(@uesrIDs) 479=item getPermissionLevels(@uesrIDs)
460 480
461Return a list of permission level records associated with the user IDs given. If 481Return a list of permission level records associated with the user IDs given. If
462there is no record associated with a given user ID, that element of the list 482there is no record associated with a given user ID, one will be created.
463will be undefined.
464 483
465=cut 484=cut
466 485
467sub getPermissionLevels { 486sub getPermissionLevels {
468 my ($self, @userIDs) = @_; 487 my ($self, @userIDs) = @_;
… …
472 foreach my $i (0 .. $#userIDs) { 491 foreach my $i (0 .. $#userIDs) {
473 croak "getPermissionLevels: element $i of argument list must contain a user_id" 492 croak "getPermissionLevels: element $i of argument list must contain a user_id"
474 unless defined $userIDs[$i]; 493 unless defined $userIDs[$i];
475 } 494 }
476 495
477 return $self->{permission}->gets(map { [$_] } @userIDs); 496 my @PermissionLevels = $self->{permission}->gets(map { [$_] } @userIDs);
497
498 for (my $i = 0; $i < @PermissionLevels; $i++) {
499 my $PermissionLevel = $PermissionLevels[$i];
500 my $userID = $userIDs[$i];
501 if (not defined $PermissionLevel) {
502 #warn "not defined\n";
503 if ($self->{user}->exists($userID)) {
504 #warn "user exists\n";
505 $PermissionLevel = $self->newPermissionLevel(user_id => $userID);
506 warn $PermissionLevel->toString, "\n";
507 eval { $self->addPermissionLevel($PermissionLevel) };
508 if ($@ and $@ !~ m/permission level exists/) {
509 die "error while auto-creating permission level record for user $userID: \"$@\"";
510 }
511 }
512 }
513 }
514
515 return @PermissionLevels;
478} 516}
479 517
480=item putPermissionLevel($PermissionLevel) 518=item putPermissionLevel($PermissionLevel)
481 519
482$PermissionLevel is a record object. If a permission level record with the same 520$PermissionLevel is a record object. If a permission level record with the same
… …
491 529
492 croak "putPermissionLevel: requires 1 argument" 530 croak "putPermissionLevel: requires 1 argument"
493 unless @_ == 2; 531 unless @_ == 2;
494 croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record} 532 croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
495 unless ref $PermissionLevel eq $self->{permission}->{record}; 533 unless ref $PermissionLevel eq $self->{permission}->{record};
534
535 checkKeyfields($PermissionLevel);
536
496 croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)" 537 croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
497 unless $self->{permission}->exists($PermissionLevel->user_id); 538 unless $self->{permission}->exists($PermissionLevel->user_id);
498
499 checkKeyfields($PermissionLevel);
500 539
501 return $self->{permission}->put($PermissionLevel); 540 return $self->{permission}->put($PermissionLevel);
502} 541}
503 542
504=item deletePermissionLevel($userID) 543=item deletePermissionLevel($userID)
… …
533Returns a new, empty key object. 572Returns a new, empty key object.
534 573
535=cut 574=cut
536 575
537sub newKey { 576sub newKey {
538 my ($self, $prototype) = @_; 577 my ($self, @prototype) = @_;
539 return $self->{key}->{record}->new($prototype); 578 return $self->{key}->{record}->new(@prototype);
540} 579}
541 580
542=item listKeys() 581=item listKeys()
543 582
544Returns a list of user IDs representing the records in the key table. 583Returns a list of user IDs representing the records in the key table.
… …
569 608
570 croak "addKey: requires 1 argument" 609 croak "addKey: requires 1 argument"
571 unless @_ == 2; 610 unless @_ == 2;
572 croak "addKey: argument 1 must be of type ", $self->{key}->{record} 611 croak "addKey: argument 1 must be of type ", $self->{key}->{record}
573 unless ref $Key eq $self->{key}->{record}; 612 unless ref $Key eq $self->{key}->{record};
613
614 checkKeyfields($Key);
615
574 croak "addKey: key exists (perhaps you meant to use putKey?)" 616 croak "addKey: key exists (perhaps you meant to use putKey?)"
575 if $self->{key}->exists($Key->user_id); 617 if $self->{key}->exists($Key->user_id);
576 croak "addKey: user ", $Key->user_id, " not found" 618 croak "addKey: user ", $Key->user_id, " not found"
577 unless $self->{user}->exists($Key->user_id); 619 unless $self->{user}->exists($Key->user_id);
578
579 checkKeyfields($Key);
580 620
581 return $self->{key}->add($Key); 621 return $self->{key}->add($Key);
582} 622}
583 623
584=item getKey($userID) 624=item getKey($userID)
… …
634 674
635 croak "putKey: requires 1 argument" 675 croak "putKey: requires 1 argument"
636 unless @_ == 2; 676 unless @_ == 2;
637 croak "putKey: argument 1 must be of type ", $self->{key}->{record} 677 croak "putKey: argument 1 must be of type ", $self->{key}->{record}
638 unless ref $Key eq $self->{key}->{record}; 678 unless ref $Key eq $self->{key}->{record};
679
680 checkKeyfields($Key);
681
639 croak "putKey: key not found (perhaps you meant to use addKey?)" 682 croak "putKey: key not found (perhaps you meant to use addKey?)"
640 unless $self->{key}->exists($Key->user_id); 683 unless $self->{key}->exists($Key->user_id);
641
642 checkKeyfields($Key);
643 684
644 return $self->{key}->put($Key); 685 return $self->{key}->put($Key);
645} 686}
646 687
647=item deleteKey($userID) 688=item deleteKey($userID)
… …
676Returns a new, empty user object. 717Returns a new, empty user object.
677 718
678=cut 719=cut
679 720
680sub newUser { 721sub newUser {
681 my ($self, $prototype) = @_; 722 my ($self, @prototype) = @_;
682 return $self->{user}->{record}->new($prototype); 723 return $self->{user}->{record}->new(@prototype);
683} 724}
684 725
685=item listUsers() 726=item listUsers()
686 727
687Returns a list of user IDs representing the records in the user table. 728Returns a list of user IDs representing the records in the user table.
… …
711 752
712 croak "addUser: requires 1 argument" 753 croak "addUser: requires 1 argument"
713 unless @_ == 2; 754 unless @_ == 2;
714 croak "addUser: argument 1 must be of type ", $self->{user}->{record} 755 croak "addUser: argument 1 must be of type ", $self->{user}->{record}
715 unless ref $User eq $self->{user}->{record}; 756 unless ref $User eq $self->{user}->{record};
757
758 checkKeyfields($User);
759
716 croak "addUser: user exists (perhaps you meant to use putUser?)" 760 croak "addUser: user exists (perhaps you meant to use putUser?)"
717 if $self->{user}->exists($User->user_id); 761 if $self->{user}->exists($User->user_id);
718
719 checkKeyfields($User);
720 762
721 return $self->{user}->add($User); 763 return $self->{user}->add($User);
722} 764}
723 765
724=item getUser($userID) 766=item getUser($userID)
… …
774 816
775 croak "putUser: requires 1 argument" 817 croak "putUser: requires 1 argument"
776 unless @_ == 2; 818 unless @_ == 2;
777 croak "putUser: argument 1 must be of type ", $self->{user}->{record} 819 croak "putUser: argument 1 must be of type ", $self->{user}->{record}
778 unless ref $User eq $self->{user}->{record}; 820 unless ref $User eq $self->{user}->{record};
821
822 checkKeyfields($User);
823
779 croak "putUser: user not found (perhaps you meant to use addUser?)" 824 croak "putUser: user not found (perhaps you meant to use addUser?)"
780 unless $self->{user}->exists($User->user_id); 825 unless $self->{user}->exists($User->user_id);
781
782 checkKeyfields($User);
783 826
784 return $self->{user}->put($User); 827 return $self->{user}->put($User);
785} 828}
786 829
787=item deleteUser($userID) 830=item deleteUser($userID)
… …
826=over 869=over
827 870
828=cut 871=cut
829 872
830sub newGlobalSet { 873sub newGlobalSet {
831 my ($self, $prototype) = @_; 874 my ($self, @prototype) = @_;
832 return $self->{set}->{record}->new($prototype); 875 return $self->{set}->{record}->new(@prototype);
833} 876}
834 877
835sub listGlobalSets($) { 878sub listGlobalSets($) {
836 my ($self) = @_; 879 my ($self) = @_;
837 880
… …
847 890
848 croak "addGlobalSet: requires 1 argument" 891 croak "addGlobalSet: requires 1 argument"
849 unless @_ == 2; 892 unless @_ == 2;
850 croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record} 893 croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
851 unless ref $GlobalSet eq $self->{set}->{record}; 894 unless ref $GlobalSet eq $self->{set}->{record};
895
896 checkKeyfields($GlobalSet);
897
852 croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)" 898 croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
853 if $self->{set}->exists($GlobalSet->set_id); 899 if $self->{set}->exists($GlobalSet->set_id);
854
855 checkKeyfields($GlobalSet);
856 900
857 return $self->{set}->add($GlobalSet); 901 return $self->{set}->add($GlobalSet);
858} 902}
859 903
860sub getGlobalSet($$) { 904sub getGlobalSet($$) {
… …
894 938
895 croak "putGlobalSet: requires 1 argument" 939 croak "putGlobalSet: requires 1 argument"
896 unless @_ == 2; 940 unless @_ == 2;
897 croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record} 941 croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
898 unless ref $GlobalSet eq $self->{set}->{record}; 942 unless ref $GlobalSet eq $self->{set}->{record};
943
944 checkKeyfields($GlobalSet);
945
899 croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)" 946 croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
900 unless $self->{set}->exists($GlobalSet->set_id); 947 unless $self->{set}->exists($GlobalSet->set_id);
901
902 checkKeyfields($GlobalSet);
903 948
904 return $self->{set}->put($GlobalSet); 949 return $self->{set}->put($GlobalSet);
905} 950}
906 951
907sub deleteGlobalSet($$) { 952sub deleteGlobalSet($$) {
… …
936=over 981=over
937 982
938=cut 983=cut
939 984
940sub newUserSet { 985sub newUserSet {
941 my ($self, $prototype) = @_; 986 my ($self, @prototype) = @_;
942 return $self->{set_user}->{record}->new($prototype); 987 return $self->{set_user}->{record}->new(@prototype);
943} 988}
944 989
945sub listSetUsers($$) { 990sub listSetUsers($$) {
946 my ($self, $setID) = @_; 991 my ($self, $setID) = @_;
947 992
… …
971 1016
972 croak "addUserSet: requires 1 argument" 1017 croak "addUserSet: requires 1 argument"
973 unless @_ == 2; 1018 unless @_ == 2;
974 croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record} 1019 croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
975 unless ref $UserSet eq $self->{set_user}->{record}; 1020 unless ref $UserSet eq $self->{set_user}->{record};
1021
1022 checkKeyfields($UserSet);
1023
976 croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)" 1024 croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
977 if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id); 1025 if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
978 croak "addUserSet: user ", $UserSet->user_id, " not found" 1026 croak "addUserSet: user ", $UserSet->user_id, " not found"
979 unless $self->{user}->exists($UserSet->user_id); 1027 unless $self->{user}->exists($UserSet->user_id);
980 croak "addUserSet: set ", $UserSet->set_id, " not found" 1028 croak "addUserSet: set ", $UserSet->set_id, " not found"
981 unless $self->{set}->exists($UserSet->set_id); 1029 unless $self->{set}->exists($UserSet->set_id);
982
983 checkKeyfields($UserSet);
984 1030
985 return $self->{set_user}->add($UserSet); 1031 return $self->{set_user}->add($UserSet);
986} 1032}
987 1033
988sub getUserSet($$$) { 1034sub getUserSet($$$) {
… …
1030 1076
1031 croak "putUserSet: requires 1 argument" 1077 croak "putUserSet: requires 1 argument"
1032 unless @_ == 2; 1078 unless @_ == 2;
1033 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record} 1079 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
1034 unless ref $UserSet eq $self->{set_user}->{record}; 1080 unless ref $UserSet eq $self->{set_user}->{record};
1081
1082 checkKeyfields($UserSet);
1083
1035 croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)" 1084 croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
1036 unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id); 1085 unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
1037 croak "putUserSet: user ", $UserSet->user_id, " not found" 1086 croak "putUserSet: user ", $UserSet->user_id, " not found"
1038 unless $self->{user}->exists($UserSet->user_id); 1087 unless $self->{user}->exists($UserSet->user_id);
1039 croak "putUserSet: set ", $UserSet->set_id, " not found" 1088 croak "putUserSet: set ", $UserSet->set_id, " not found"
1040 unless $self->{set}->exists($UserSet->set_id); 1089 unless $self->{set}->exists($UserSet->set_id);
1041 1090
1042 checkKeyfields($UserSet);
1043
1044 return $self->{set_user}->put($UserSet); 1091 return $self->{set_user}->put($UserSet);
1045} 1092}
1046 1093
1047sub deleteUserSet($$$) { 1094sub deleteUserSet($$$) {
1048 my ($self, $userID, $setID) = @_; 1095 my ($self, $userID, $setID) = @_;
… …
1075=over 1122=over
1076 1123
1077=cut 1124=cut
1078 1125
1079sub newGlobalProblem { 1126sub newGlobalProblem {
1080 my ($self, $prototype) = @_; 1127 my ($self, @prototype) = @_;
1081 return $self->{problem}->{record}->new($prototype); 1128 return $self->{problem}->{record}->new(@prototype);
1082} 1129}
1083 1130
1084sub listGlobalProblems($$) { 1131sub listGlobalProblems($$) {
1085 my ($self, $setID) = @_; 1132 my ($self, $setID) = @_;
1086 1133
… …
1098 1145
1099 croak "addGlobalProblem: requires 1 argument" 1146 croak "addGlobalProblem: requires 1 argument"
1100 unless @_ == 2; 1147 unless @_ == 2;
1101 croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record} 1148 croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
1102 unless ref $GlobalProblem eq $self->{problem}->{record}; 1149 unless ref $GlobalProblem eq $self->{problem}->{record};
1150
1151 checkKeyfields($GlobalProblem);
1152
1103 croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)" 1153 croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
1104 if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id); 1154 if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
1105 croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found" 1155 croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
1106 unless $self->{set}->exists($GlobalProblem->set_id); 1156 unless $self->{set}->exists($GlobalProblem->set_id);
1107
1108 checkKeyfields($GlobalProblem);
1109 1157
1110 return $self->{problem}->add($GlobalProblem); 1158 return $self->{problem}->add($GlobalProblem);
1111} 1159}
1112 1160
1113sub getGlobalProblem($$$) { 1161sub getGlobalProblem($$$) {
… …
1154 1202
1155 croak "putGlobalProblem: requires 1 argument" 1203 croak "putGlobalProblem: requires 1 argument"
1156 unless @_ == 2; 1204 unless @_ == 2;
1157 croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record} 1205 croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
1158 unless ref $GlobalProblem eq $self->{problem}->{record}; 1206 unless ref $GlobalProblem eq $self->{problem}->{record};
1207
1208 checkKeyfields($GlobalProblem);
1209
1159 croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)" 1210 croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
1160 unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id); 1211 unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
1161 croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found" 1212 croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
1162 unless $self->{set}->exists($GlobalProblem->set_id); 1213 unless $self->{set}->exists($GlobalProblem->set_id);
1163
1164 checkKeyfields($GlobalProblem);
1165 1214
1166 return $self->{problem}->put($GlobalProblem); 1215 return $self->{problem}->put($GlobalProblem);
1167} 1216}
1168 1217
1169sub deleteGlobalProblem($$$) { 1218sub deleteGlobalProblem($$$) {
… …
1197=over 1246=over
1198 1247
1199=cut 1248=cut
1200 1249
1201sub newUserProblem { 1250sub newUserProblem {
1202 my ($self, $prototype) = @_; 1251 my ($self, @prototype) = @_;
1203 return $self->{problem_user}->{record}->new($prototype); 1252 return $self->{problem_user}->{record}->new(@prototype);
1204} 1253}
1205 1254
1206sub listProblemUsers($$$) { 1255sub listProblemUsers($$$) {
1207 my ($self, $setID, $problemID) = @_; 1256 my ($self, $setID, $problemID) = @_;
1208 1257
… …
1236 1285
1237 croak "addUserProblem: requires 1 argument" 1286 croak "addUserProblem: requires 1 argument"
1238 unless @_ == 2; 1287 unless @_ == 2;
1239 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1288 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1240 unless ref $UserProblem eq $self->{problem_user}->{record}; 1289 unless ref $UserProblem eq $self->{problem_user}->{record};
1290
1291 checkKeyfields($UserProblem);
1292
1241 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)" 1293 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
1242 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1294 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1243 croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1295 croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
1244 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1296 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
1245 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1297 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
1246 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1298 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
1247
1248 checkKeyfields($UserProblem);
1249 1299
1250 return $self->{problem_user}->add($UserProblem); 1300 return $self->{problem_user}->add($UserProblem);
1251} 1301}
1252 1302
1253sub getUserProblem($$$$) { 1303sub getUserProblem($$$$) {
… …
1299 1349
1300 croak "putUserProblem: requires 1 argument" 1350 croak "putUserProblem: requires 1 argument"
1301 unless @_ == 2; 1351 unless @_ == 2;
1302 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1352 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1303 unless ref $UserProblem eq $self->{problem_user}->{record}; 1353 unless ref $UserProblem eq $self->{problem_user}->{record};
1354
1355 checkKeyfields($UserProblem);
1356
1304 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1357 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
1305 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1358 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
1306 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)" 1359 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
1307 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1360 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1308 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1361 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
1309 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1362 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
1310
1311 checkKeyfields($UserProblem);
1312 1363
1313 return $self->{problem_user}->put($UserProblem); 1364 return $self->{problem_user}->put($UserProblem);
1314} 1365}
1315 1366
1316sub deleteUserProblem($$$$) { 1367sub deleteUserProblem($$$$) {
… …
1395 and @{$userSetIDs[$i]} == 2 1446 and @{$userSetIDs[$i]} == 2
1396 and defined $userSetIDs[$i]->[0] 1447 and defined $userSetIDs[$i]->[0]
1397 and defined $userSetIDs[$i]->[1]; 1448 and defined $userSetIDs[$i]->[1];
1398 } 1449 }
1399 1450
1400 my @UserSets = $self->getUserSets(@userSetIDs); 1451 my @UserSets = $self->getUserSets(@userSetIDs); # checked
1401 1452
1402 my @globalSetIDs = map { $_->[1] } @userSetIDs; 1453 my @globalSetIDs = map { $_->[1] } @userSetIDs;
1403 my @GlobalSets = $self->getGlobalSets(@globalSetIDs); 1454 my @GlobalSets = $self->getGlobalSets(@globalSetIDs); # checked
1404 1455
1405 my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS; 1456 my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
1406 my @commonFields = grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS; 1457 my @commonFields = grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
1407 1458
1408 for (my $i = 0; $i < @UserSets; $i++) { 1459 for (my $i = 0; $i < @UserSets; $i++) {
1409 my $UserSet = $UserSets[$i]; 1460 my $UserSet = $UserSets[$i];
1410 my $GlobalSet = $GlobalSets[$i]; 1461 my $GlobalSet = $GlobalSets[$i];
1411 next unless $UserSet and $GlobalSet; 1462 next unless defined $UserSet and defined $GlobalSet;
1412 #warn "---------- USER SET\n", $UserSet->toString, "---------- USER SET\n"; 1463 #warn "---------- USER SET\n", $UserSet->toString, "---------- USER SET\n";
1413 #warn "---------- GLOBAL SET\n", $GlobalSet->toString, "---------- GLOBAL SET\n"; 1464 #warn "---------- GLOBAL SET\n", $GlobalSet->toString, "---------- GLOBAL SET\n";
1414 foreach my $field (@commonFields) { 1465 foreach my $field (@commonFields) {
1415 next if defined $UserSet->$field; 1466 next if defined $UserSet->$field;
1416 #warn "using global value for field $field\n"; 1467 #warn "using global value for field $field\n";
… …
1510 and defined $userProblemIDs[$i]->[0] 1561 and defined $userProblemIDs[$i]->[0]
1511 and defined $userProblemIDs[$i]->[1] 1562 and defined $userProblemIDs[$i]->[1]
1512 and defined $userProblemIDs[$i]->[2]; 1563 and defined $userProblemIDs[$i]->[2];
1513 } 1564 }
1514 1565
1515 my @UserProblems = $self->getUserProblems(@userProblemIDs); 1566 my @UserProblems = $self->getUserProblems(@userProblemIDs); # checked
1516 1567
1517 my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @userProblemIDs; 1568 my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @userProblemIDs;
1518 my @GlobalProblems = $self->getGlobalProblems(@globalProblemIDs); 1569 my @GlobalProblems = $self->getGlobalProblems(@globalProblemIDs); # checked
1519 1570
1520 my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS; 1571 my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
1521 my @commonFields = grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS; 1572 my @commonFields = grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
1522 1573
1523 for (my $i = 0; $i < @UserProblems; $i++) { 1574 for (my $i = 0; $i < @UserProblems; $i++) {
1524 my $UserProblem = $UserProblems[$i]; 1575 my $UserProblem = $UserProblems[$i];
1525 my $GlobalProblem = $GlobalProblems[$i]; 1576 my $GlobalProblem = $GlobalProblems[$i];
1526 next unless $UserProblem and $GlobalProblem; 1577 next unless defined $UserProblem and defined $GlobalProblem;
1527 foreach my $field (@commonFields) { 1578 foreach my $field (@commonFields) {
1528 next if defined $UserProblem->$field; 1579 next if defined $UserProblem->$field;
1529 $UserProblem->$field($GlobalProblem->$field); 1580 $UserProblem->$field($GlobalProblem->$field);
1530 } 1581 }
1531 } 1582 }
… …
1545# my ($self, $table) = @_; 1596# my ($self, $table) = @_;
1546# return $self->{$table}->dumpDB(); 1597# return $self->{$table}->dumpDB();
1547#} 1598#}
1548 1599
1549################################################################################ 1600################################################################################
1550# sanity checking 1601# utilities
1551################################################################################ 1602################################################################################
1552 1603
1553sub checkKeyfields($) { 1604sub checkKeyfields($) {
1554 my ($Record) = @_; 1605 my ($Record) = @_;
1555 foreach my $keyfield ($Record->KEYFIELDS) { 1606 foreach my $keyfield ($Record->KEYFIELDS) {
1556 my $value = $Record->$keyfield; 1607 my $value = $Record->$keyfield;
1557 croak "checkKeyfields: $keyfield is empty" 1608 croak "checkKeyfields: $keyfield is empty"
1558 unless defined $value and $value ne ""; 1609 unless defined $value and $value ne "";
1559 1610
1560 if ($keyfield eq "problem_id") { 1611 if ($keyfield eq "problem_id") {
1561 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])" 1612 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
1562 unless $value =~ m/^\d*$/; 1613 unless $value =~ m/^\d*$/;
1563 } else { 1614 } else {
1564 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])" 1615 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
Legend:
Removed from v.1589  
changed lines
  Added in v.1635
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9