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

Diff of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/DB.pm

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

Revision 1635 Revision 1641
… …
317=cut 317=cut
318 318
319sub getPasswords { 319sub getPasswords {
320 my ($self, @userIDs) = @_; 320 my ($self, @userIDs) = @_;
321 321
322 croak "getPasswords: requires 1 or more argument" 322 #croak "getPasswords: requires 1 or more argument"
323 unless @_ >= 2; 323 # unless @_ >= 2;
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
… …
484=cut 484=cut
485 485
486sub getPermissionLevels { 486sub getPermissionLevels {
487 my ($self, @userIDs) = @_; 487 my ($self, @userIDs) = @_;
488 488
489 croak "getPermissionLevels: requires 1 or more argument" 489 #croak "getPermissionLevels: requires 1 or more argument"
490 unless @_ >= 2; 490 # unless @_ >= 2;
491 foreach my $i (0 .. $#userIDs) { 491 foreach my $i (0 .. $#userIDs) {
492 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"
493 unless defined $userIDs[$i]; 493 unless defined $userIDs[$i];
494 } 494 }
495 495
… …
649=cut 649=cut
650 650
651sub getKeys { 651sub getKeys {
652 my ($self, @userIDs) = @_; 652 my ($self, @userIDs) = @_;
653 653
654 croak "getKeys: requires 1 or more argument" 654 #croak "getKeys: requires 1 or more argument"
655 unless @_ >= 2; 655 # unless @_ >= 2;
656 foreach my $i (0 .. $#userIDs) { 656 foreach my $i (0 .. $#userIDs) {
657 croak "getKeys: element $i of argument list must contain a user_id" 657 croak "getKeys: element $i of argument list must contain a user_id"
658 unless defined $userIDs[$i]; 658 unless defined $userIDs[$i];
659 } 659 }
660 660
… …
791=cut 791=cut
792 792
793sub getUsers { 793sub getUsers {
794 my ($self, @userIDs) = @_; 794 my ($self, @userIDs) = @_;
795 795
796 croak "getUsers: requires 1 or more argument" 796 #croak "getUsers: requires 1 or more argument"
797 unless @_ >= 2; 797 # unless @_ >= 2;
798 foreach my $i (0 .. $#userIDs) { 798 foreach my $i (0 .. $#userIDs) {
799 croak "getUsers: element $i of argument list must contain a user_id" 799 croak "getUsers: element $i of argument list must contain a user_id"
800 unless defined $userIDs[$i]; 800 unless defined $userIDs[$i];
801 } 801 }
802 802
… …
843 croak "deleteUser: requires 1 argument" 843 croak "deleteUser: requires 1 argument"
844 unless @_ == 2; 844 unless @_ == 2;
845 croak "deleteUser: argument 1 must contain a user_id" 845 croak "deleteUser: argument 1 must contain a user_id"
846 unless defined $userID; 846 unless defined $userID;
847 847
848 #$self->deleteUserSet($userID, $_)
849 # foreach $self->listUserSets($userID);
850 $self->deleteUserSet($userID, undef); 848 $self->deleteUserSet($userID, undef);
851 $self->deletePassword($userID); 849 $self->deletePassword($userID);
852 $self->deletePermissionLevel($userID); 850 $self->deletePermissionLevel($userID);
853 $self->deleteKey($userID); 851 $self->deleteKey($userID);
854 return $self->{user}->delete($userID); 852 return $self->{user}->delete($userID);
… …
873sub newGlobalSet { 871sub newGlobalSet {
874 my ($self, @prototype) = @_; 872 my ($self, @prototype) = @_;
875 return $self->{set}->{record}->new(@prototype); 873 return $self->{set}->{record}->new(@prototype);
876} 874}
877 875
878sub listGlobalSets($) { 876sub listGlobalSets {
879 my ($self) = @_; 877 my ($self) = @_;
880 878
881 croak "listGlobalSets: requires 0 arguments" 879 croak "listGlobalSets: requires 0 arguments"
882 unless @_ == 1; 880 unless @_ == 1;
883 881
884 return map { $_->[0] } 882 return map { $_->[0] }
885 $self->{set}->list(undef); 883 $self->{set}->list(undef);
886} 884}
887 885
888sub addGlobalSet($$) { 886sub addGlobalSet {
889 my ($self, $GlobalSet) = @_; 887 my ($self, $GlobalSet) = @_;
890 888
891 croak "addGlobalSet: requires 1 argument" 889 croak "addGlobalSet: requires 1 argument"
892 unless @_ == 2; 890 unless @_ == 2;
893 croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record} 891 croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
… …
899 if $self->{set}->exists($GlobalSet->set_id); 897 if $self->{set}->exists($GlobalSet->set_id);
900 898
901 return $self->{set}->add($GlobalSet); 899 return $self->{set}->add($GlobalSet);
902} 900}
903 901
904sub getGlobalSet($$) { 902sub getGlobalSet {
905 my ($self, $setID) = @_; 903 my ($self, $setID) = @_;
906 904
907 croak "getGlobalSet: requires 1 argument" 905 croak "getGlobalSet: requires 1 argument"
908 unless @_ == 2; 906 unless @_ == 2;
909 croak "getGlobalSet: argument 1 must contain a set_id" 907 croak "getGlobalSet: argument 1 must contain a set_id"
… …
912 return $self->{set}->get($setID); 910 return $self->{set}->get($setID);
913} 911}
914 912
915=item getGlobalSets(@setIDs) 913=item getGlobalSets(@setIDs)
916 914
917Return a list of global set records associated with the user IDs given. If there 915Return a list of global set records associated with the record IDs given. If
918is no record associated with a given user ID, that element of the list will be 916there is no record associated with a given record ID, that element of the list
919undefined. 917will be undefined.
920 918
921=cut 919=cut
922 920
923sub getGlobalSets { 921sub getGlobalSets {
924 my ($self, @setIDs) = @_; 922 my ($self, @setIDs) = @_;
925 923
926 croak "getGlobalSets: requires 1 or more argument" 924 #croak "getGlobalSets: requires 1 or more argument"
927 unless @_ >= 2; 925 # unless @_ >= 2;
928 foreach my $i (0 .. $#setIDs) { 926 foreach my $i (0 .. $#setIDs) {
929 croak "getGlobalSets: element $i of argument list must contain a set_id" 927 croak "getGlobalSets: element $i of argument list must contain a set_id"
930 unless defined $setIDs[$i]; 928 unless defined $setIDs[$i];
931 } 929 }
932 930
933 return $self->{set}->gets(map { [$_] } @setIDs); 931 return $self->{set}->gets(map { [$_] } @setIDs);
934} 932}
935 933
936sub putGlobalSet($$) { 934sub putGlobalSet {
937 my ($self, $GlobalSet) = @_; 935 my ($self, $GlobalSet) = @_;
938 936
939 croak "putGlobalSet: requires 1 argument" 937 croak "putGlobalSet: requires 1 argument"
940 unless @_ == 2; 938 unless @_ == 2;
941 croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record} 939 croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
… …
947 unless $self->{set}->exists($GlobalSet->set_id); 945 unless $self->{set}->exists($GlobalSet->set_id);
948 946
949 return $self->{set}->put($GlobalSet); 947 return $self->{set}->put($GlobalSet);
950} 948}
951 949
952sub deleteGlobalSet($$) { 950sub deleteGlobalSet {
953 my ($self, $setID) = @_; 951 my ($self, $setID) = @_;
954 952
955 croak "deleteGlobalSet: requires 1 argument" 953 croak "deleteGlobalSet: requires 1 argument"
956 unless @_ == 2; 954 unless @_ == 2;
957 croak "deleteGlobalSet: argument 1 must contain a set_id" 955 croak "deleteGlobalSet: argument 1 must contain a set_id"
958 unless defined $setID or caller eq __PACKAGE__; 956 unless defined $setID or caller eq __PACKAGE__;
959 957
960 #$self->deleteUserSet($_, $setID)
961 # foreach $self->listSetUsers($setID);
962 #$self->deleteGlobalProblem($setID, $_)
963 # foreach $self->listGlobalProblems($setID);
964 $self->deleteUserSet(undef, $setID); 958 $self->deleteUserSet(undef, $setID);
965 $self->deleteGlobalProblem($setID, undef); 959 $self->deleteGlobalProblem($setID, undef);
966 return $self->{set}->delete($setID); 960 return $self->{set}->delete($setID);
967} 961}
968 962
… …
985sub newUserSet { 979sub newUserSet {
986 my ($self, @prototype) = @_; 980 my ($self, @prototype) = @_;
987 return $self->{set_user}->{record}->new(@prototype); 981 return $self->{set_user}->{record}->new(@prototype);
988} 982}
989 983
990sub listSetUsers($$) { 984sub listSetUsers {
991 my ($self, $setID) = @_; 985 my ($self, $setID) = @_;
992 986
993 croak "listSetUsers: requires 1 argument" 987 croak "listSetUsers: requires 1 argument"
994 unless @_ == 2; 988 unless @_ == 2;
995 croak "listSetUsers: argument 1 must contain a set_id" 989 croak "listSetUsers: argument 1 must contain a set_id"
… …
997 991
998 return map { $_->[0] } # extract user_id 992 return map { $_->[0] } # extract user_id
999 $self->{set_user}->list(undef, $setID); 993 $self->{set_user}->list(undef, $setID);
1000} 994}
1001 995
1002sub listUserSets($$) { 996sub listUserSets {
1003 my ($self, $userID) = @_; 997 my ($self, $userID) = @_;
1004 998
1005 croak "listUserSets: requires 1 argument" 999 croak "listUserSets: requires 1 argument"
1006 unless @_ == 2; 1000 unless @_ == 2;
1007 croak "listUserSets: argument 1 must contain a user_id" 1001 croak "listUserSets: argument 1 must contain a user_id"
… …
1009 1003
1010 return map { $_->[1] } # extract set_id 1004 return map { $_->[1] } # extract set_id
1011 $self->{set_user}->list($userID, undef); 1005 $self->{set_user}->list($userID, undef);
1012} 1006}
1013 1007
1014sub addUserSet($$) { 1008sub addUserSet {
1015 my ($self, $UserSet) = @_; 1009 my ($self, $UserSet) = @_;
1016 1010
1017 croak "addUserSet: requires 1 argument" 1011 croak "addUserSet: requires 1 argument"
1018 unless @_ == 2; 1012 unless @_ == 2;
1019 croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record} 1013 croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
… …
1029 unless $self->{set}->exists($UserSet->set_id); 1023 unless $self->{set}->exists($UserSet->set_id);
1030 1024
1031 return $self->{set_user}->add($UserSet); 1025 return $self->{set_user}->add($UserSet);
1032} 1026}
1033 1027
1034sub getUserSet($$$) { 1028sub getUserSet {
1035 my ($self, $userID, $setID) = @_; 1029 my ($self, $userID, $setID) = @_;
1036 1030
1037 croak "getUserSet: requires 2 arguments" 1031 croak "getUserSet: requires 2 arguments"
1038 unless @_ == 3; 1032 unless @_ == 3;
1039 croak "getUserSet: argument 1 must contain a user_id" 1033 croak "getUserSet: argument 1 must contain a user_id"
… …
1045 return ( $self->getUserSets([$userID, $setID]) )[0]; 1039 return ( $self->getUserSets([$userID, $setID]) )[0];
1046} 1040}
1047 1041
1048=item getUserSets(@userSetIDs) 1042=item getUserSets(@userSetIDs)
1049 1043
1050Return a list of user set records associated with the user IDs given. If there 1044Return a list of user set records associated with the record IDs given. If there
1051is no record associated with a given user ID, that element of the list will be 1045is no record associated with a given record ID, that element of the list will be
1052undefined. @userProblemIDs consists of references to arrays in which the first 1046undefined. @userProblemIDs consists of references to arrays in which the first
1053element is the user_id and the second element is the set_id. 1047element is the user_id and the second element is the set_id.
1054 1048
1055=cut 1049=cut
1056 1050
1057sub getUserSets { 1051sub getUserSets {
1058 my ($self, @userSetIDs) = @_; 1052 my ($self, @userSetIDs) = @_;
1059 1053
1060 croak "getUserSets: requires 1 or more argument" 1054 #croak "getUserSets: requires 1 or more argument"
1061 unless @_ >= 2; 1055 # unless @_ >= 2;
1062 foreach my $i (0 .. $#userSetIDs) { 1056 foreach my $i (0 .. $#userSetIDs) {
1063 croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair" 1057 croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair"
1064 unless defined $userSetIDs[$i] 1058 unless defined $userSetIDs[$i]
1065 and ref $userSetIDs[$i] eq "ARRAY" 1059 and ref $userSetIDs[$i] eq "ARRAY"
1066 and @{$userSetIDs[$i]} == 2 1060 and @{$userSetIDs[$i]} == 2
… …
1069 } 1063 }
1070 1064
1071 return $self->{set_user}->gets(@userSetIDs); 1065 return $self->{set_user}->gets(@userSetIDs);
1072} 1066}
1073 1067
1074sub putUserSet($$) { 1068sub putUserSet {
1075 my ($self, $UserSet) = @_; 1069 my ($self, $UserSet) = @_;
1076 1070
1077 croak "putUserSet: requires 1 argument" 1071 croak "putUserSet: requires 1 argument"
1078 unless @_ == 2; 1072 unless @_ == 2;
1079 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record} 1073 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
… …
1089 unless $self->{set}->exists($UserSet->set_id); 1083 unless $self->{set}->exists($UserSet->set_id);
1090 1084
1091 return $self->{set_user}->put($UserSet); 1085 return $self->{set_user}->put($UserSet);
1092} 1086}
1093 1087
1094sub deleteUserSet($$$) { 1088sub deleteUserSet {
1095 my ($self, $userID, $setID) = @_; 1089 my ($self, $userID, $setID) = @_;
1096 1090
1097 croak "getUserSet: requires 2 arguments" 1091 croak "getUserSet: requires 2 arguments"
1098 unless @_ == 3; 1092 unless @_ == 3;
1099 croak "getUserSet: argument 1 must contain a user_id" 1093 croak "getUserSet: argument 1 must contain a user_id"
1100 unless defined $userID or caller eq __PACKAGE__; 1094 unless defined $userID or caller eq __PACKAGE__;
1101 croak "getUserSet: argument 2 must contain a set_id" 1095 croak "getUserSet: argument 2 must contain a set_id"
1102 unless defined $userID or caller eq __PACKAGE__; 1096 unless defined $userID or caller eq __PACKAGE__;
1103 1097
1104 #$self->deleteUserProblem($userID, $setID, $_)
1105 # foreach $self->listUserProblems($userID, $setID);
1106 $self->deleteUserProblem($userID, $setID, undef); 1098 $self->deleteUserProblem($userID, $setID, undef);
1107 return $self->{set_user}->delete($userID, $setID); 1099 return $self->{set_user}->delete($userID, $setID);
1108} 1100}
1109 1101
1110=back 1102=back
… …
1126sub newGlobalProblem { 1118sub newGlobalProblem {
1127 my ($self, @prototype) = @_; 1119 my ($self, @prototype) = @_;
1128 return $self->{problem}->{record}->new(@prototype); 1120 return $self->{problem}->{record}->new(@prototype);
1129} 1121}
1130 1122
1131sub listGlobalProblems($$) { 1123sub listGlobalProblems {
1132 my ($self, $setID) = @_; 1124 my ($self, $setID) = @_;
1133 1125
1134 croak "listGlobalProblems: requires 1 arguments" 1126 croak "listGlobalProblems: requires 1 arguments"
1135 unless @_ == 2; 1127 unless @_ == 2;
1136 croak "listGlobalProblems: argument 1 must contain a set_id" 1128 croak "listGlobalProblems: argument 1 must contain a set_id"
… …
1138 1130
1139 return map { $_->[1] } 1131 return map { $_->[1] }
1140 $self->{problem}->list($setID, undef); 1132 $self->{problem}->list($setID, undef);
1141} 1133}
1142 1134
1143sub addGlobalProblem($$) { 1135sub addGlobalProblem {
1144 my ($self, $GlobalProblem) = @_; 1136 my ($self, $GlobalProblem) = @_;
1145 1137
1146 croak "addGlobalProblem: requires 1 argument" 1138 croak "addGlobalProblem: requires 1 argument"
1147 unless @_ == 2; 1139 unless @_ == 2;
1148 croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record} 1140 croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
… …
1156 unless $self->{set}->exists($GlobalProblem->set_id); 1148 unless $self->{set}->exists($GlobalProblem->set_id);
1157 1149
1158 return $self->{problem}->add($GlobalProblem); 1150 return $self->{problem}->add($GlobalProblem);
1159} 1151}
1160 1152
1161sub getGlobalProblem($$$) { 1153sub getGlobalProblem {
1162 my ($self, $setID, $problemID) = @_; 1154 my ($self, $setID, $problemID) = @_;
1163 1155
1164 croak "getGlobalProblem: requires 2 arguments" 1156 croak "getGlobalProblem: requires 2 arguments"
1165 unless @_ == 3; 1157 unless @_ == 3;
1166 croak "getGlobalProblem: argument 1 must contain a set_id" 1158 croak "getGlobalProblem: argument 1 must contain a set_id"
… …
1171 return $self->{problem}->get($setID, $problemID); 1163 return $self->{problem}->get($setID, $problemID);
1172} 1164}
1173 1165
1174=item getGlobalProblems(@problemIDs) 1166=item getGlobalProblems(@problemIDs)
1175 1167
1176Return a list of global set records associated with the user IDs given. If there 1168Return a list of global set records associated with the record IDs given. If
1177is no record associated with a given user ID, that element of the list will be 1169there is no record associated with a given record ID, that element of the list
1178undefined. @problemIDs consists of references to arrays in which the first 1170will be undefined. @problemIDs consists of references to arrays in which the
1179element is the set_id, and the second element is the problem_id. 1171first element is the set_id, and the second element is the problem_id.
1180 1172
1181=cut 1173=cut
1182 1174
1183sub getGlobalProblems { 1175sub getGlobalProblems {
1184 my ($self, @problemIDs) = @_; 1176 my ($self, @problemIDs) = @_;
1185 1177
1186 croak "getGlobalProblems: requires 1 or more argument" 1178 #croak "getGlobalProblems: requires 1 or more argument"
1187 unless @_ >= 2; 1179 # unless @_ >= 2;
1188 foreach my $i (0 .. $#problemIDs) { 1180 foreach my $i (0 .. $#problemIDs) {
1189 croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair" 1181 croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair"
1190 unless defined $problemIDs[$i] 1182 unless defined $problemIDs[$i]
1191 and ref $problemIDs[$i] eq "ARRAY" 1183 and ref $problemIDs[$i] eq "ARRAY"
1192 and @{$problemIDs[$i]} == 2 1184 and @{$problemIDs[$i]} == 2
… …
1195 } 1187 }
1196 1188
1197 return $self->{problem}->gets(@problemIDs); 1189 return $self->{problem}->gets(@problemIDs);
1198} 1190}
1199 1191
1200sub putGlobalProblem($$) { 1192sub putGlobalProblem {
1201 my ($self, $GlobalProblem) = @_; 1193 my ($self, $GlobalProblem) = @_;
1202 1194
1203 croak "putGlobalProblem: requires 1 argument" 1195 croak "putGlobalProblem: requires 1 argument"
1204 unless @_ == 2; 1196 unless @_ == 2;
1205 croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record} 1197 croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
… …
1213 unless $self->{set}->exists($GlobalProblem->set_id); 1205 unless $self->{set}->exists($GlobalProblem->set_id);
1214 1206
1215 return $self->{problem}->put($GlobalProblem); 1207 return $self->{problem}->put($GlobalProblem);
1216} 1208}
1217 1209
1218sub deleteGlobalProblem($$$) { 1210sub deleteGlobalProblem {
1219 my ($self, $setID, $problemID) = @_; 1211 my ($self, $setID, $problemID) = @_;
1220 1212
1221 croak "deleteGlobalProblem: requires 2 arguments" 1213 croak "deleteGlobalProblem: requires 2 arguments"
1222 unless @_ == 3; 1214 unless @_ == 3;
1223 croak "deleteGlobalProblem: argument 1 must contain a set_id" 1215 croak "deleteGlobalProblem: argument 1 must contain a set_id"
1224 unless defined $setID or caller eq __PACKAGE__; 1216 unless defined $setID or caller eq __PACKAGE__;
1225 croak "deleteGlobalProblem: argument 2 must contain a problem_id" 1217 croak "deleteGlobalProblem: argument 2 must contain a problem_id"
1226 unless defined $problemID or caller eq __PACKAGE__; 1218 unless defined $problemID or caller eq __PACKAGE__;
1227 1219
1228 #$self->deleteUserProblem($_, $setID, $problemID)
1229 # foreach $self->listProblemUsers($setID, $problemID);
1230 $self->deleteUserProblem(undef, $setID, $problemID); 1220 $self->deleteUserProblem(undef, $setID, $problemID);
1231 return $self->{problem}->delete($setID, $problemID); 1221 return $self->{problem}->delete($setID, $problemID);
1232} 1222}
1233 1223
1234=back 1224=back
… …
1250sub newUserProblem { 1240sub newUserProblem {
1251 my ($self, @prototype) = @_; 1241 my ($self, @prototype) = @_;
1252 return $self->{problem_user}->{record}->new(@prototype); 1242 return $self->{problem_user}->{record}->new(@prototype);
1253} 1243}
1254 1244
1255sub listProblemUsers($$$) { 1245sub listProblemUsers {
1256 my ($self, $setID, $problemID) = @_; 1246 my ($self, $setID, $problemID) = @_;
1257 1247
1258 croak "listProblemUsers: requires 2 arguments" 1248 croak "listProblemUsers: requires 2 arguments"
1259 unless @_ == 3; 1249 unless @_ == 3;
1260 croak "listProblemUsers: argument 1 must contain a set_id" 1250 croak "listProblemUsers: argument 1 must contain a set_id"
… …
1264 1254
1265 return map { $_->[0] } # extract user_id 1255 return map { $_->[0] } # extract user_id
1266 $self->{problem_user}->list(undef, $setID, $problemID); 1256 $self->{problem_user}->list(undef, $setID, $problemID);
1267} 1257}
1268 1258
1269sub listUserProblems($$$) { 1259sub listUserProblems {
1270 my ($self, $userID, $setID) = @_; 1260 my ($self, $userID, $setID) = @_;
1271 1261
1272 croak "listUserProblems: requires 2 arguments" 1262 croak "listUserProblems: requires 2 arguments"
1273 unless @_ == 3; 1263 unless @_ == 3;
1274 croak "listUserProblems: argument 1 must contain a user_id" 1264 croak "listUserProblems: argument 1 must contain a user_id"
… …
1278 1268
1279 return map { $_->[2] } # extract problem_id 1269 return map { $_->[2] } # extract problem_id
1280 $self->{problem_user}->list($userID, $setID, undef); 1270 $self->{problem_user}->list($userID, $setID, undef);
1281} 1271}
1282 1272
1283sub addUserProblem($$) { 1273sub addUserProblem {
1284 my ($self, $UserProblem) = @_; 1274 my ($self, $UserProblem) = @_;
1285 1275
1286 croak "addUserProblem: requires 1 argument" 1276 croak "addUserProblem: requires 1 argument"
1287 unless @_ == 2; 1277 unless @_ == 2;
1288 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1278 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
… …
1298 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1288 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
1299 1289
1300 return $self->{problem_user}->add($UserProblem); 1290 return $self->{problem_user}->add($UserProblem);
1301} 1291}
1302 1292
1303sub getUserProblem($$$$) { 1293sub getUserProblem {
1304 my ($self, $userID, $setID, $problemID) = @_; 1294 my ($self, $userID, $setID, $problemID) = @_;
1305 1295
1306 croak "getUserProblem: requires 3 arguments" 1296 croak "getUserProblem: requires 3 arguments"
1307 unless @_ == 4; 1297 unless @_ == 4;
1308 croak "getUserProblem: argument 1 must contain a user_id" 1298 croak "getUserProblem: argument 1 must contain a user_id"
… …
1310 croak "getUserProblem: argument 2 must contain a set_id" 1300 croak "getUserProblem: argument 2 must contain a set_id"
1311 unless defined $setID; 1301 unless defined $setID;
1312 croak "getUserProblem: argument 3 must contain a problem_id" 1302 croak "getUserProblem: argument 3 must contain a problem_id"
1313 unless defined $problemID; 1303 unless defined $problemID;
1314 1304
1315 #return $self->{problem_user}->get($userID, $setID, $problemID);
1316 return ( $self->getUserProblems([$userID, $setID, $problemID]) )[0]; 1305 return ( $self->getUserProblems([$userID, $setID, $problemID]) )[0];
1317} 1306}
1318 1307
1319=item getUserProblems(@userProblemIDs) 1308=item getUserProblems(@userProblemIDs)
1320 1309
… …
1327=cut 1316=cut
1328 1317
1329sub getUserProblems { 1318sub getUserProblems {
1330 my ($self, @userProblemIDs) = @_; 1319 my ($self, @userProblemIDs) = @_;
1331 1320
1332 croak "getUserProblems: requires 1 or more argument" 1321 #croak "getUserProblems: requires 1 or more argument"
1333 unless @_ >= 2; 1322 # unless @_ >= 2;
1334 foreach my $i (0 .. $#userProblemIDs) { 1323 foreach my $i (0 .. $#userProblemIDs) {
1335 croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple" 1324 croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
1336 unless defined $userProblemIDs[$i] 1325 unless defined $userProblemIDs[$i]
1337 and ref $userProblemIDs[$i] eq "ARRAY" 1326 and ref $userProblemIDs[$i] eq "ARRAY"
1338 and @{$userProblemIDs[$i]} == 3 1327 and @{$userProblemIDs[$i]} == 3
… …
1342 } 1331 }
1343 1332
1344 return $self->{problem_user}->gets(@userProblemIDs); 1333 return $self->{problem_user}->gets(@userProblemIDs);
1345} 1334}
1346 1335
1347sub putUserProblem($$) { 1336sub putUserProblem {
1348 my ($self, $UserProblem) = @_; 1337 my ($self, $UserProblem) = @_;
1349 1338
1350 croak "putUserProblem: requires 1 argument" 1339 croak "putUserProblem: requires 1 argument"
1351 unless @_ == 2; 1340 unless @_ == 2;
1352 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1341 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
… …
1362 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1351 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
1363 1352
1364 return $self->{problem_user}->put($UserProblem); 1353 return $self->{problem_user}->put($UserProblem);
1365} 1354}
1366 1355
1367sub deleteUserProblem($$$$) { 1356sub deleteUserProblem {
1368 my ($self, $userID, $setID, $problemID) = @_; 1357 my ($self, $userID, $setID, $problemID) = @_;
1369 1358
1370 croak "getUserProblem: requires 3 arguments" 1359 croak "getUserProblem: requires 3 arguments"
1371 unless @_ == 4; 1360 unless @_ == 4;
1372 croak "getUserProblem: argument 1 must contain a user_id" 1361 croak "getUserProblem: argument 1 must contain a user_id"
… …
1387# set+set_user functions 1376# set+set_user functions
1388################################################################################ 1377################################################################################
1389 1378
1390=head2 Set Merging Methods 1379=head2 Set Merging Methods
1391 1380
1392FIXME: write this 1381These functions combine a global set and a user set to create a merged set,
1382which is returned. Any field that is not defined in the user set is taken from
1383the global set. Merged sets have the same type as user sets.
1393 1384
1394=over 1385=over
1395 1386
1396=cut 1387=cut
1397 1388
1398sub getGlobalUserSet { 1389sub getGlobalUserSet {
1399 carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead"; 1390 carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
1400 return shift->getMergedSet(@_); 1391 return shift->getMergedSet(@_);
1401} 1392}
1393
1394=item getMergedSet($userID, $setID)
1395
1396Returns a merged set record associated with the record IDs given. If there is no
1397record associated with a given record ID, the undefined value is returned.
1398
1399=cut
1402 1400
1403sub getMergedSet { 1401sub getMergedSet {
1404 my ($self, $userID, $setID) = @_; 1402 my ($self, $userID, $setID) = @_;
1405 1403
1406 croak "getMergedSet: requires 2 arguments" 1404 croak "getMergedSet: requires 2 arguments"
… …
1408 croak "getMergedSet: argument 1 must contain a user_id" 1406 croak "getMergedSet: argument 1 must contain a user_id"
1409 unless defined $userID; 1407 unless defined $userID;
1410 croak "getMergedSet: argument 2 must contain a set_id" 1408 croak "getMergedSet: argument 2 must contain a set_id"
1411 unless defined $setID; 1409 unless defined $setID;
1412 1410
1413 #my $UserSet = $self->getUserSet($userID, $setID);
1414 #return unless $UserSet;
1415 #my $GlobalSet = $self->getGlobalSet($setID);
1416 #if ($GlobalSet) {
1417 # foreach ($UserSet->FIELDS()) {
1418 # next unless $GlobalSet->can($_);
1419 # next if $UserSet->$_();
1420 # $UserSet->$_($GlobalSet->$_());
1421 # }
1422 #}
1423 #return $UserSet;
1424
1425 return ( $self->getMergedSets([$userID, $setID]) )[0]; 1411 return ( $self->getMergedSets([$userID, $setID]) )[0];
1426} 1412}
1427 1413
1428=item geMegedSets(@userSetIDs) 1414=item getMegedSets(@userSetIDs)
1429 1415
1430Return a list of merged set records associated with the user IDs given. If there 1416Return a list of merged set records associated with the record IDs given. If
1431is no record associated with a given user ID, that element of the list will be 1417there is no record associated with a given record ID, that element of the list
1432undefined. @userSetIDs consists of references to arrays in which the first 1418will be undefined. @userSetIDs consists of references to arrays in which the
1433element is the user_id and the second element is the set_id. 1419first element is the user_id and the second element is the set_id.
1434 1420
1435=cut 1421=cut
1436 1422
1437sub getMergedSets { 1423sub getMergedSets {
1438 my ($self, @userSetIDs) = @_; 1424 my ($self, @userSetIDs) = @_;
1439 1425
1440 croak "getMergedSets: requires 1 or more argument" 1426 #croak "getMergedSets: requires 1 or more argument"
1441 unless @_ >= 2; 1427 # unless @_ >= 2;
1442 foreach my $i (0 .. $#userSetIDs) { 1428 foreach my $i (0 .. $#userSetIDs) {
1443 croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair" 1429 croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair"
1444 unless defined $userSetIDs[$i] 1430 unless defined $userSetIDs[$i]
1445 and ref $userSetIDs[$i] eq "ARRAY" 1431 and ref $userSetIDs[$i] eq "ARRAY"
1446 and @{$userSetIDs[$i]} == 2 1432 and @{$userSetIDs[$i]} == 2
… …
1458 1444
1459 for (my $i = 0; $i < @UserSets; $i++) { 1445 for (my $i = 0; $i < @UserSets; $i++) {
1460 my $UserSet = $UserSets[$i]; 1446 my $UserSet = $UserSets[$i];
1461 my $GlobalSet = $GlobalSets[$i]; 1447 my $GlobalSet = $GlobalSets[$i];
1462 next unless defined $UserSet and defined $GlobalSet; 1448 next unless defined $UserSet and defined $GlobalSet;
1463 #warn "---------- USER SET\n", $UserSet->toString, "---------- USER SET\n";
1464 #warn "---------- GLOBAL SET\n", $GlobalSet->toString, "---------- GLOBAL SET\n";
1465 foreach my $field (@commonFields) { 1449 foreach my $field (@commonFields) {
1466 next if defined $UserSet->$field; 1450 next if defined $UserSet->$field;
1467 #warn "using global value for field $field\n";
1468 $UserSet->$field($GlobalSet->$field); 1451 $UserSet->$field($GlobalSet->$field);
1469 } 1452 }
1470 } 1453 }
1471 1454
1472 return @UserSets; 1455 return @UserSets;
… …
1480# problem+problem_user functions 1463# problem+problem_user functions
1481################################################################################ 1464################################################################################
1482 1465
1483=head2 Problem Merging Methods 1466=head2 Problem Merging Methods
1484 1467
1485FIXME: write this 1468These functions combine a global problem and a user problem to create a merged
1469problem, which is returned. Any field that is not defined in the user problem is
1470taken from the global problem. Merged problems have the same type as user
1471problems.
1486 1472
1487=over 1473=over
1488 1474
1489=cut 1475=cut
1490 1476
1491sub getGlobalUserProblem { 1477sub getGlobalUserProblem {
1492 carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead"; 1478 carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
1493 return shift->getMergedProblem(@_); 1479 return shift->getMergedProblem(@_);
1494} 1480}
1481
1482=item getMergedProblem($userID, $setID, $problemID)
1483
1484Returns a merged problem record associated with the record IDs given. If there
1485is no record associated with a given record ID, the undefined value is returned.
1486
1487=cut
1495 1488
1496sub getMergedProblem { 1489sub getMergedProblem {
1497 my ($self, $userID, $setID, $problemID) = @_; 1490 my ($self, $userID, $setID, $problemID) = @_;
1498 1491
1499 croak "getGlobalUserSet: requires 3 arguments" 1492 croak "getGlobalUserSet: requires 3 arguments"
… …
1503 croak "getGlobalUserSet: argument 2 must contain a set_id" 1496 croak "getGlobalUserSet: argument 2 must contain a set_id"
1504 unless defined $setID; 1497 unless defined $setID;
1505 croak "getGlobalUserSet: argument 3 must contain a problem_id" 1498 croak "getGlobalUserSet: argument 3 must contain a problem_id"
1506 unless defined $problemID; 1499 unless defined $problemID;
1507 1500
1508 #my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);
1509 #return unless $UserProblem;
1510 #my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);
1511 #if ($GlobalProblem) {
1512 # foreach ($UserProblem->FIELDS()) {
1513 # next unless $GlobalProblem->can($_);
1514 # next if $UserProblem->$_();
1515 # $UserProblem->$_($GlobalProblem->$_());
1516 # }
1517 #}
1518 #return $UserProblem;
1519
1520 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0]; 1501 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0];
1521} 1502}
1522 1503
1523=item getMergedProblems(@userProblemIDs) 1504=item getMergedProblems(@userProblemIDs)
1524 1505
1525Return a list of merged set records associated with the user IDs given. If there 1506Return a list of merged problem records associated with the record IDs given. If
1526is no record associated with a given user ID, that element of the list will be 1507there is no record associated with a given record ID, that element of the list
1527undefined. @userProblemIDs consists of references to arrays in which the first 1508will be undefined. @userProblemIDs consists of references to arrays in which the
1528element is the user_id, the second element is the set_id, and the third element 1509first element is the user_id, the second element is the set_id, and the third
1529is the problem_id. 1510element is the problem_id.
1530 1511
1531=cut 1512=cut
1532
1533#sub getMergedProblems {
1534# my ($self, @userProblemIDs) = @_;
1535#
1536# croak "getMergedProblems: requires 1 or more argument"
1537# unless @_ >= 2;
1538# foreach my $i (0 .. $#userProblemIDs) {
1539# croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
1540# unless defined $userProblemIDs[$i]
1541# and ref $userProblemIDs[$i] eq "ARRAY"
1542# and @{$userProblemIDs[$i]} == 3
1543# and defined $userProblemIDs[$i]->[0]
1544# and defined $userProblemIDs[$i]->[1]
1545# and defined $userProblemIDs[$i]->[2];
1546# }
1547#
1548# return map { $self->getMergedProblem(@{$_}) } @userProblemIDs;
1549#}
1550 1513
1551sub getMergedProblems { 1514sub getMergedProblems {
1552 my ($self, @userProblemIDs) = @_; 1515 my ($self, @userProblemIDs) = @_;
1553 1516
1554 croak "getMergedProblems: requires 1 or more argument" 1517 #croak "getMergedProblems: requires 1 or more argument"
1555 unless @_ >= 2; 1518 # unless @_ >= 2;
1556 foreach my $i (0 .. $#userProblemIDs) { 1519 foreach my $i (0 .. $#userProblemIDs) {
1557 croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple" 1520 croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
1558 unless defined $userProblemIDs[$i] 1521 unless defined $userProblemIDs[$i]
1559 and ref $userProblemIDs[$i] eq "ARRAY" 1522 and ref $userProblemIDs[$i] eq "ARRAY"
1560 and @{$userProblemIDs[$i]} == 3 1523 and @{$userProblemIDs[$i]} == 3
Legend:
Removed from v.1635  
changed lines
  Added in v.1641
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9