[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 2330 Revision 2331
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/DB.pm,v 1.46 2004/04/27 03:37:56 sh002i Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/DB.pm,v 1.48 2004/06/14 22:58:55 sh002i Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
237=head1 METHODS 237=head1 METHODS
238 238
239=cut 239=cut
240 240
241################################################################################ 241################################################################################
242# general functions
243################################################################################
244
245=head2 General Methods
246
247=over
248
249=cut
250
251=item hashDatabaseOK($fix)
252
253If the schema module in use for the C<set> and C<problem> tables is
254WeBWorK::DB::Schema::GlobalTableEmulator, the database is checked to make sure
255that the "global user" exists and all sets and problems are assigned to it. If
256$fix is true, problems found will be fixed: A global user will be created and
257all sets/problems assigned to it.
258
259A list of values is returned. The first value is a boolean value indicating
260whether problems remain in the database after hashDatabaseOK() is called. The
261remaining values are a list of strings indicating the particular ways in which
262the database is (or was) broken.
263
264=cut
265
266sub hashDatabaseOK {
267 my ($self, $fix) = @_;
268
269 my $errorsExist;
270 my @results;
271
272 ##### do we need to run? #####
273
274 unless (ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
275 #warn "hashDatabaseOK($fix): no checks necessary, set table does not use GlobalTableEmulator.\n";
276 return 1;
277 }
278
279 ##### is globalUserID defined? #####
280
281 my $globalUserID = $self->{set}->{params}->{globalUserID};
282 if ($globalUserID eq "") {
283 return 0, "globalUserID not specified (fix this in %dbLayout.)";
284 } else {
285 #warn "hashDatabaseOK($fix): globalUserID not empty ($globalUserID) -- good.\n";
286 }
287
288 ##### does a user with ID globalUserID exist? #####
289
290 my $GlobalUser = $self->getUser($globalUserID);
291 if (defined $GlobalUser) {
292 #warn "hashDatabaseOK($fix): user with ID '$globalUserID' exists -- good.\n";
293 } else {
294 #warn "hashDatabaseOK($fix): user with ID '$globalUserID' not found -- bad!\n";
295 if ($fix) {
296 $self->addUser($self->newUser(
297 user_id => $globalUserID,
298 first_name => "Global",
299 last_name => "User",
300 email_address => "",
301 student_id => $globalUserID,
302 status => "D",
303 section => "",
304 recitation => "",
305 comment => "This user is used to store data about global set and problem records when using a hash-style database.",
306 ));
307 push @results, "User $globalUserID does not exist -- FIXED.";
308 #warn "hashDatabaseOK($fix): created user with ID '$globalUserID' -- good.\n";
309 } else {
310 # at this point, we don't go on. no global user means everything below is going to fail.
311 return 0, "User $globalUserID does not exist.";
312 }
313 }
314
315 ##### are all sets assigned to the user with ID globalUserID? #####
316
317 my @userSetIDs = $self->{set_user}->list(undef, undef);
318
319 my %userSetStatus;
320 foreach my $userSetID (@userSetIDs) {
321 my ($userID, $setID) = @$userSetID;
322 $userSetStatus{$setID}->{$userID} = 1;
323 }
324
325 foreach my $setID (keys %userSetStatus) {
326 delete $userSetStatus{$setID}
327 if exists $userSetStatus{$setID}->{$globalUserID};
328 }
329
330 if (keys %userSetStatus) {
331 if ($fix) {
332 foreach my $setID (keys %userSetStatus) {
333 my $userID = ( keys %{$userSetStatus{$setID}} )[0];
334
335 # grab the first UserSet of this set (connect and disconnect required for get1*)
336 $self->{set_user}->{driver}->connect("ro");
337 my $RawUserSet = $self->{set_user}->get1NoFilter($userID, $setID);
338 $self->{set_user}->{driver}->disconnect();
339
340 # change user ID to globalUserID and add to database
341 $RawUserSet->user_id($globalUserID);
342 $self->{set_user}->add($RawUserSet);
343
344 push @results, "Set '$setID' not assigned to global user '$globalUserID' -- FIXED.";
345
346 #warn "hashDatabaseOK($fix): assigned set '$setID' to global user '$globalUserID' -- good.\n";
347 }
348 } else {
349 foreach my $setID (keys %userSetStatus) {
350 #warn "hashDatabaseOK($fix): set '$setID' not assigned to global user '$globalUserID' -- bad!\n";
351 push @results, "Set '$setID' not assigned to global user '$globalUserID'.";
352 }
353 $errorsExist = 1;
354 }
355 } else {
356 #warn "hashDatabaseOK($fix): all sets assigned to global user '$globalUserID' -- good.\n";
357 }
358
359 ##### done! #####
360
361 my $status = not $errorsExist;
362 return $status, @results;
363}
364
365=back
366
367=cut
368
369################################################################################
242# password functions 370# password functions
243################################################################################ 371################################################################################
244 372
245=head2 Password Methods 373=head2 Password Methods
246 374
… …
511 if (not defined $PermissionLevel) { 639 if (not defined $PermissionLevel) {
512 #warn "not defined\n"; 640 #warn "not defined\n";
513 if ($self->{user}->exists($userID)) { 641 if ($self->{user}->exists($userID)) {
514 #warn "user exists\n"; 642 #warn "user exists\n";
515 $PermissionLevel = $self->newPermissionLevel(user_id => $userID); 643 $PermissionLevel = $self->newPermissionLevel(user_id => $userID);
516 warn $PermissionLevel->toString, "\n"; 644 #warn $PermissionLevel->toString, "\n";
517 eval { $self->addPermissionLevel($PermissionLevel) }; 645 eval { $self->addPermissionLevel($PermissionLevel) };
518 if ($@ and $@ !~ m/permission level exists/) { 646 if ($@ and $@ !~ m/permission level exists/) {
519 die "error while auto-creating permission level record for user $userID: \"$@\""; 647 die "error while auto-creating permission level record for user $userID: \"$@\"";
520 } 648 }
521 $PermissionLevels[$i] = $PermissionLevel; 649 $PermissionLevels[$i] = $PermissionLevel;
… …
989 unless @_ == 2; 1117 unless @_ == 2;
990 croak "deleteGlobalSet: argument 1 must contain a set_id" 1118 croak "deleteGlobalSet: argument 1 must contain a set_id"
991 unless defined $setID or caller eq __PACKAGE__; 1119 unless defined $setID or caller eq __PACKAGE__;
992 1120
993 $self->deleteUserSet(undef, $setID); 1121 $self->deleteUserSet(undef, $setID);
1122
994 $self->deleteGlobalProblem($setID, undef); 1123 $self->deleteGlobalProblem($setID, undef);
995 return $self->{set}->delete($setID); 1124 return $self->{set}->delete($setID);
996} 1125}
997 1126
998=back 1127=back
… …
1074 unless $self->{user}->exists($UserSet->user_id); 1203 unless $self->{user}->exists($UserSet->user_id);
1075 croak "addUserSet: set ", $UserSet->set_id, " not found" 1204 croak "addUserSet: set ", $UserSet->set_id, " not found"
1076 unless $self->{set}->exists($UserSet->set_id); 1205 unless $self->{set}->exists($UserSet->set_id);
1077 1206
1078 return $self->{set_user}->add($UserSet); 1207 return $self->{set_user}->add($UserSet);
1208}
1209
1210sub addVersionedUserSet {
1211 my ($self, $UserSet) = @_;
1212
1213# this is the same as addUserSet,allowing for set names of the form setID,vN
1214
1215 croak "addVersionedUserSet: requires 1 argument"
1216 unless @_ == 2;
1217 croak "addVersionedUserSet: argument 1 must be of type ",
1218 $self->{set_user}->{record}
1219 unless ref $UserSet eq $self->{set_user}->{record};
1220
1221# $versioned is a flag that we send in to allow commas in the set name
1222# for versioned sets
1223 my $versioned = 1;
1224 checkKeyfields($UserSet, $versioned);
1225 my ($nonVersionedSetName) = ($UserSet->set_id =~ /^(.*),v\d+$/);
1226
1227 croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
1228 if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
1229 croak "addUserSet: user ", $UserSet->user_id, " not found"
1230 unless $self->{user}->exists($UserSet->user_id);
1231# croak "addUserSet: set ", $UserSet->set_id, " not found"
1232# unless $self->{set}->exists($UserSet->set_id);
1233# here the appropriate check is whether a global set of the nonversioned set
1234# name exists
1235 croak "addVersionedUserSet: set ", $nonVersionedSetName, " not found"
1236 unless $self->{set}->exists( $nonVersionedSetName );
1237
1238 return $self->{set_user}->add($UserSet);
1079} 1239}
1080 1240
1081sub getUserSet { 1241sub getUserSet {
1082 my ($self, $userID, $setID) = @_; 1242 my ($self, $userID, $setID) = @_;
1083 1243
… …
1116 } 1276 }
1117 1277
1118 return $self->{set_user}->gets(@userSetIDs); 1278 return $self->{set_user}->gets(@userSetIDs);
1119} 1279}
1120 1280
1281sub getUserSetVersions {
1282 my ( $self, $uid, $sid, $versionNum ) = @_;
1283# in: $uid is a userID, $sid is a setID, and $versionNum is a version number
1284# userID has set versions 1 through $versionNum defined
1285# out: an array of user set objects is returned for the indicated version
1286# numbers
1287
1288 croak "getUserSetVersions: requires three arguments, userID, setID, and " .
1289 "versionNum" if ( @_ < 3 );
1290
1291 my @userSetIDs = ();
1292 foreach my $i ( 1 .. $versionNum ) {
1293 push( @userSetIDs, [ $uid, "$sid,v$i" ] );
1294 }
1295
1296 return $self->getUserSets( @userSetIDs );
1297}
1298
1121sub putUserSet { 1299sub putUserSet {
1122 my ($self, $UserSet) = @_; 1300 my ($self, $UserSet) = @_;
1123 1301
1124 croak "putUserSet: requires 1 argument" 1302 croak "putUserSet: requires 1 argument"
1125 unless @_ == 2; 1303 unless @_ == 2;
… …
1136 unless $self->{set}->exists($UserSet->set_id); 1314 unless $self->{set}->exists($UserSet->set_id);
1137 1315
1138 return $self->{set_user}->put($UserSet); 1316 return $self->{set_user}->put($UserSet);
1139} 1317}
1140 1318
1319sub putVersionedUserSet {
1320 my ($self, $UserSet) = @_;
1321# this exists separate from putUserSet only so that we can make it harder
1322# for anyone else to use commas in setIDs
1323
1324 croak "putUserSet: requires 1 argument"
1325 unless @_ == 2;
1326 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
1327 unless ref $UserSet eq $self->{set_user}->{record};
1328
1329 # versioned allows us to have a wacked out setID
1330 my $versioned = 1;
1331 checkKeyfields($UserSet, $versioned);
1332
1333 my $nonVersionedSetID = $UserSet->set_id;
1334 $nonVersionedSetID =~ s/,v\d+$//;
1335# my ($nonVersionedSetID) = ($UserSet->set_id =~ /^(.*)(,v\d+)?$/);
1336 croak "putVersionedUserSet: user set not found (perhaps you meant " .
1337 "to use addUserSet?)"
1338 unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
1339 croak "putVersionedUserSet: user ", $UserSet->user_id, " not found"
1340 unless $self->{user}->exists($UserSet->user_id);
1341 croak "putVersionedUserSet: set $nonVersionedSetID not found"
1342 unless $self->{set}->exists($nonVersionedSetID);
1343
1344 return $self->{set_user}->put($UserSet);
1345}
1346
1141sub deleteUserSet { 1347sub deleteUserSet {
1142 my ($self, $userID, $setID) = @_; 1348 my ($self, $userID, $setID, $skipVersionDel) = @_;
1143 1349
1144 croak "getUserSet: requires 2 arguments" 1350 croak "getUserSet: requires 2 arguments"
1145 unless @_ == 3; 1351 unless @_ == 3 or @_ == 4;
1146 croak "getUserSet: argument 1 must contain a user_id" 1352 croak "getUserSet: argument 1 must contain a user_id"
1147 unless defined $userID or caller eq __PACKAGE__; 1353 unless defined $userID or caller eq __PACKAGE__;
1148 croak "getUserSet: argument 2 must contain a set_id" 1354 croak "getUserSet: argument 2 must contain a set_id"
1149 unless defined $userID or caller eq __PACKAGE__; 1355 unless defined $userID or caller eq __PACKAGE__;
1150 1356
1357 $self->deleteUserSetVersions( $userID, $setID )
1358 if ( defined($setID) && ! ( defined($skipVersionDel) &&
1359 $skipVersionDel ) );
1151 $self->deleteUserProblem($userID, $setID, undef); 1360 $self->deleteUserProblem($userID, $setID, undef);
1152 return $self->{set_user}->delete($userID, $setID); 1361 return $self->{set_user}->delete($userID, $setID);
1362}
1363
1364sub deleteUserSetVersions {
1365 my ($self, $userID, $setID) = @_;
1366
1367# this only gets called from deleteUserSet, so we don't worry about $setID
1368# not being defined
1369
1370# make a list of all users to delete set versions for. if we have a userID,
1371# then just delete versions for that user
1372 my @allUsers = ();
1373 if ( defined( $userID ) ) {
1374 push( @allUsers, $userID );
1375 } else {
1376# otherwise, get a list of all users to whom the set is assigned, and delete
1377# all versions for all of them
1378 @allUsers = $self->listSetUsers( $setID );
1379 }
1380
1381# skip version deletion when calling deleteUserSet from here
1382 my $skipVersionDel = 1;
1383
1384# go through each userID and delete all versions of the set for each
1385 foreach my $uid ( @allUsers ) {
1386 my $setVersionNumber = $self->getUserSetVersionNumber($uid, $setID);
1387 if ( $setVersionNumber ) {
1388 for ( my $i=1; $i<=$setVersionNumber; $i++ ) {
1389 eval { $self->deleteUserSet( $uid, "$setID,v$i",
1390 $skipVersionDel ) };
1391 return $@ if ( $@ );
1392 }
1393 }
1394 }
1395}
1396
1397sub getUserSetVersionNumber {
1398 my ( $self, $uid, $sid ) = @_;
1399# in: uid and sid are user and set ids. the setID is the 'global' setID
1400# for the user, not a versioned value
1401# out: the latest version number of the set that has been assigned to the
1402# user is returned.
1403
1404 croak "getUserSetVersionNumber: requires 2 arguments, a user and set ID"
1405 unless @_ == 3 && defined $uid && defined $sid;
1406
1407# is there a better way of doing this? it seems like we need to know the
1408# number of versions to be able to do a mass get. something like a get
1409# where sid looks like $sid,v\d would work... but is incompatible w/gdbm
1410# my $i=1;
1411# if ( $self->{set_user}->exists( $uid, $sid ) ) {
1412# while ( $self->{set_user}->exists( $uid, "$sid,v$i" ) ) {
1413# $i++;
1414# }
1415# }
1416# return ($i-1);
1417# or, we can just get all sets for the user and figure out which of them
1418# look like the sid.
1419 my @allSetIDs = $self->listUserSets( $uid );
1420 my @setIDs = sort( grep { /^$sid,v\d+$/ } @allSetIDs );
1421# my $lastSetID = ( sort( @setIDs ) )[-1];
1422 my $lastSetID = $setIDs[-1];
1423# I think this should be defined, unless the set hasn't been assigned to
1424# the user at all, which we hope wouldn't have happened at this juncture
1425 if ( not defined($lastSetID) ) {
1426 return 0;
1427 } else {
1428 # we have to deal with the fact that 10 sorts to precede 2 (etc.)
1429 my @vNums = map { /^$sid,v(\d+)$/ } @setIDs;
1430 return ( ( sort {$a<=>$b} @vNums )[-1] );
1431 }
1153} 1432}
1154 1433
1155=back 1434=back
1156 1435
1157=cut 1436=cut
… …
1291 unless @_ == 3; 1570 unless @_ == 3;
1292 croak "deleteGlobalProblem: argument 1 must contain a set_id" 1571 croak "deleteGlobalProblem: argument 1 must contain a set_id"
1293 unless defined $setID or caller eq __PACKAGE__; 1572 unless defined $setID or caller eq __PACKAGE__;
1294 croak "deleteGlobalProblem: argument 2 must contain a problem_id" 1573 croak "deleteGlobalProblem: argument 2 must contain a problem_id"
1295 unless defined $problemID or caller eq __PACKAGE__; 1574 unless defined $problemID or caller eq __PACKAGE__;
1296 1575
1297 $self->deleteUserProblem(undef, $setID, $problemID); 1576 $self->deleteUserProblem(undef, $setID, $problemID);
1298 return $self->{problem}->delete($setID, $problemID); 1577 return $self->{problem}->delete($setID, $problemID);
1299} 1578}
1300 1579
1301=back 1580=back
… …
1373 croak "addUserProblem: requires 1 argument" 1652 croak "addUserProblem: requires 1 argument"
1374 unless @_ == 2; 1653 unless @_ == 2;
1375 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1654 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1376 unless ref $UserProblem eq $self->{problem_user}->{record}; 1655 unless ref $UserProblem eq $self->{problem_user}->{record};
1377 1656
1657 my $setID = $UserProblem->set_id;
1658 if ( $setID =~ /^(.*),v\d+/ ) { # then it's a versioned set
1659 $setID = $1;
1660 checkKeyfields($UserProblem, 1);
1661 } else {
1378 checkKeyfields($UserProblem); 1662 checkKeyfields($UserProblem);
1663 }
1379 1664
1380 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)" 1665 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
1381 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1666 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1382 croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1667 croak "addUserProblem: user set $setID for user ", $UserProblem->user_id, " not found"
1383 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1668 unless $self->{set_user}->exists($UserProblem->user_id, $setID);
1384 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1669 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $setID, " not found"
1385 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1670 unless $self->{problem}->exists($setID, $UserProblem->problem_id);
1386 1671
1387 return $self->{problem_user}->add($UserProblem); 1672 return $self->{problem_user}->add($UserProblem);
1388} 1673}
1389 1674
1390sub getUserProblem { 1675sub getUserProblem {
… …
1455 return $self->{problem_user}->gets(@problemIDTriples); 1740 return $self->{problem_user}->gets(@problemIDTriples);
1456 } 1741 }
1457} 1742}
1458 1743
1459sub putUserProblem { 1744sub putUserProblem {
1460 my ($self, $UserProblem) = @_; 1745 my ($self, $UserProblem, $versioned) = @_;
1746# $versioned is an optional argument which lets us slip versioned setIDs
1747# through checkKeyfields. this makes the first croak message a little
1748# disingenuous, of course.
1461 1749
1462 croak "putUserProblem: requires 1 argument" 1750 croak "putUserProblem: requires 1 argument"
1463 unless @_ == 2; 1751 unless @_ == 2 or @_ == 3;
1464 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1752 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1465 unless ref $UserProblem eq $self->{problem_user}->{record}; 1753 unless ref $UserProblem eq $self->{problem_user}->{record};
1466 1754
1467 checkKeyfields($UserProblem); 1755 checkKeyfields($UserProblem, $versioned);
1468 1756
1469 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1757 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
1470 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1758 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
1471 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)" 1759 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
1472 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1760 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1761
1762# allow versioned set names when $versioned is defined and true
1763 my $unversionedSetID = $UserProblem->set_id;
1764 $unversionedSetID =~ s/,v\d+$// if ( defined($versioned) && $versioned );
1473 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1765 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
1474 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1766 unless $self->{problem}->exists($unversionedSetID, $UserProblem->problem_id);
1475 1767
1476 return $self->{problem_user}->put($UserProblem); 1768 return $self->{problem_user}->put($UserProblem);
1477} 1769}
1478 1770
1479sub deleteUserProblem { 1771sub deleteUserProblem {
… …
1531 croak "getMergedSet: argument 2 must contain a set_id" 1823 croak "getMergedSet: argument 2 must contain a set_id"
1532 unless defined $setID; 1824 unless defined $setID;
1533 1825
1534 return ( $self->getMergedSets([$userID, $setID]) )[0]; 1826 return ( $self->getMergedSets([$userID, $setID]) )[0];
1535} 1827}
1828
1829sub getMergedVersionedSet {
1830 my ( $self, $userID, $setID, $versionNum ) = @_;
1831#
1832# getMergedVersionedSet( self, uid, sid [, versionNum] )
1833# in: userID uid, setID sid, and optionally version number versionNum
1834# out: the merged set version for the user; if versionNum is specified,
1835# return that set version and otherwise the latest version. if
1836# no versioned set exists for the user, return undef.
1837# note that sid can be setid,vN, thereby specifying the version number
1838# explicitly. if this is the case, any specified versionNum is ignored
1839# we'd like to use getMergedSet to do the dirty work here, but that runs
1840# into problems because we want to merge with both the template set
1841# (that is, the userSet setID) and the global set
1842
1843 croak "getMergedVersionedSet: requires at least two arguments, a userID " .
1844 "and setID (missing setID)" if ( @_ < 3 || ! defined( $setID ) );
1845
1846 my $versionedSetID = $setID;
1847
1848 if ( ( ! defined($versionNum) || ! $versionNum ) && $setID !~ /,v\d+$/ ) {
1849 $versionNum = $self->getUserSetVersionNumber( $userID, $setID );
1850
1851 if ( ! $versionNum ) {
1852 return undef;
1853 } else {
1854 $versionedSetID .= ",v$versionNum";
1855 }
1856 } elsif ( defined($versionNum) && $versionNum ) {
1857 $versionedSetID = ($setID =~ /,v\d+$/ ? $setID : "$setID,v$versionNum");
1858 } else { # the last case is that $setID =~ /,v\d+$/
1859 $setID =~ s/,v\d+//;
1860 }
1861
1862 croak "getMergedVersionedSet: requires at least two arguments, a userID " .
1863 "and setID (missing userID)" if ( ! defined( $userID ) );
1864
1865 return ( $self->getMergedVersionedSets( [$userID, $setID,
1866 $versionedSetID] ) )[0];
1867}
1868
1536 1869
1537=item getMegedSets(@userSetIDs) 1870=item getMegedSets(@userSetIDs)
1538 1871
1539Return a list of merged set records associated with the record IDs given. If 1872Return a list of merged set records associated with the record IDs given. If
1540there is no record associated with a given record ID, that element of the list 1873there is no record associated with a given record ID, that element of the list
… …
1592 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 1925 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1593 1926
1594 return @UserSets; 1927 return @UserSets;
1595} 1928}
1596 1929
1930sub getMergedVersionedSets {
1931 my ($self, @userSetIDs) = @_;
1932
1933 foreach my $i (0 .. $#userSetIDs) {
1934 croak "getMergedSets: element $i of argument list must contain a " .
1935 "<user_id, set_id, versioned_set_id> triple"
1936 unless( defined $userSetIDs[$i]
1937 and ref $userSetIDs[$i] eq "ARRAY"
1938 and @{$userSetIDs[$i]} == 3
1939 and defined $userSetIDs[$i]->[0]
1940 and defined $userSetIDs[$i]->[1]
1941 and defined $userSetIDs[$i]->[2] );
1942 }
1943
1944# these are [user_id, set_id] pairs
1945 my @nonversionedUserSetIDs = map { [$_->[0], $_->[1]] } @userSetIDs;
1946# these are [user_id, versioned_set_id] pairs
1947 my @versionedUserSetIDs = map { [$_->[0], $_->[2]] } @userSetIDs;
1948
1949# FIXME as long as we're ignoring the global user for gdbm, this is ok...
1950# (are we?) FIXME
1951 # a horrible, terrible hack ;)
1952 if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
1953 and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
1954 #warn __PACKAGE__.": using a terrible hack.\n";
1955 $WeBWorK::timer->continue("DB: getsNoFilter start")
1956 if defined($WeBWorK::timer);
1957 my @MergedSets = $self->{set_user}->getsNoFilter(@versionedUserSetIDs);
1958 $WeBWorK::timer->continue("DB: getsNoFilter end")
1959 if defined($WeBWorK::timer);
1960 return @MergedSets;
1961 }
1962
1963# we merge the nonversioned ("template") user sets (user_id, set_id) and
1964# the global data into the versioned user sets
1965 $WeBWorK::timer->continue("DB: getUserSets start (nonversioned)")
1966 if defined($WeBWorK::timer);
1967 my @TemplateUserSets = $self->getUserSets(@nonversionedUserSetIDs);
1968 $WeBWorK::timer->continue("DB: getUserSets start (versioned)")
1969 if defined($WeBWorK::timer);
1970# these are the actual user sets that we want to use
1971 my @versionedUserSets = $self->getUserSets(@versionedUserSetIDs);
1972
1973 $WeBWorK::timer->continue("DB: pull out set IDs start")
1974 if defined($WeBWorK::timer);
1975 my @globalSetIDs = map { $_->[1] } @userSetIDs;
1976 $WeBWorK::timer->continue("DB: getGlobalSets start")
1977 if defined($WeBWorK::timer);
1978 my @GlobalSets = $self->getGlobalSets(@globalSetIDs);
1979
1980 $WeBWorK::timer->continue("DB: calc common fields start")
1981 if defined($WeBWorK::timer);
1982 my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
1983 my @commonFields =
1984 grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
1985
1986 $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
1987 for (my $i = 0; $i < @TemplateUserSets; $i++) {
1988 my $VersionedSet = $versionedUserSets[$i];
1989 my $TemplateSet = $TemplateUserSets[$i];
1990 my $GlobalSet = $GlobalSets[$i];
1991 # shouldn't all of these necessarily be defined? Hmm.
1992 next unless( defined $VersionedSet and (defined $TemplateSet or
1993 defined $GlobalSet) );
1994 foreach my $field (@commonFields) {
1995 next if defined $VersionedSet->$field;
1996 $VersionedSet->$field($GlobalSet->$field) if (defined($GlobalSet));
1997 $VersionedSet->$field($TemplateSet->$field)
1998 if (defined($TemplateSet) && defined($TemplateSet->$field));
1999 }
2000 }
2001 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
2002
2003 return @versionedUserSets;
2004}
2005
1597=back 2006=back
1598 2007
1599=cut 2008=cut
1600 2009
1601################################################################################ 2010################################################################################
… …
1636 unless defined $setID; 2045 unless defined $setID;
1637 croak "getGlobalUserSet: argument 3 must contain a problem_id" 2046 croak "getGlobalUserSet: argument 3 must contain a problem_id"
1638 unless defined $problemID; 2047 unless defined $problemID;
1639 2048
1640 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0]; 2049 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0];
2050}
2051
2052sub getMergedVersionedProblem {
2053 my ($self, $userID, $setID, $setVersionID, $problemID) = @_;
2054
2055# this exists distinct from getMergedProblem only to be able to include the
2056# setVersionID
2057
2058 croak "getGlobalUserSet: requires 4 arguments"
2059 unless @_ == 5;
2060 croak "getGlobalUserSet: argument 1 must contain a user_id"
2061 unless defined $userID;
2062 croak "getGlobalUserSet: argument 2 must contain a set_id"
2063 unless defined $setID;
2064 croak "getGlobalUserSet: argument 3 must contain a set_id"
2065 unless defined $setVersionID;
2066 croak "getGlobalUserSet: argument 4 must contain a problem_id"
2067 unless defined $problemID;
2068
2069 return ($self->getMergedVersionedProblems([$userID, $setID, $setVersionID,
2070 $problemID]))[0];
1641} 2071}
1642 2072
1643=item getMergedProblems(@userProblemIDs) 2073=item getMergedProblems(@userProblemIDs)
1644 2074
1645Return a list of merged problem records associated with the record IDs given. If 2075Return a list of merged problem records associated with the record IDs given. If
… …
1693 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 2123 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1694 2124
1695 return @UserProblems; 2125 return @UserProblems;
1696} 2126}
1697 2127
2128sub getMergedVersionedProblems {
2129 my ($self, @userProblemIDs) = @_;
2130
2131 foreach my $i (0 .. $#userProblemIDs) {
2132 croak "getMergedProblems: element $i of argument list must contain a " .
2133 "<user_id, set_id, versioned_set_id, problem_id> quadruple"
2134 unless( defined $userProblemIDs[$i]
2135 and ref $userProblemIDs[$i] eq "ARRAY"
2136 and @{$userProblemIDs[$i]} == 4
2137 and defined $userProblemIDs[$i]->[0]
2138 and defined $userProblemIDs[$i]->[1]
2139 and defined $userProblemIDs[$i]->[2]
2140 and defined $userProblemIDs[$i]->[3] );
2141 }
2142
2143 $WeBWorK::timer->continue("DB: getUserProblems start")
2144 if defined($WeBWorK::timer);
2145
2146# these are triples [user_id, set_id, problem_id]
2147 my @nonversionedProblemIDs = map {[$_->[0],$_->[1],$_->[3]]} @userProblemIDs;
2148# these are triples [user_id, versioned_set_id, problem_id]
2149 my @versionedProblemIDs = map {[$_->[0],$_->[2],$_->[3]]} @userProblemIDs;
2150
2151# these are the actual user problems for the version
2152 my @versionUserProblems = $self->getUserProblems(@versionedProblemIDs);
2153
2154# get global problems (no user_id, set_id = nonversioned set_id) and
2155# template problems (user_id, set_id = nonversioned set_id); we merge with
2156# both of these, replacing global values with template values and not
2157# taking either in the event that the versioned problem already has a
2158# value for the field in question
2159 $WeBWorK::timer->continue("DB: pull out set/problem IDs start")
2160 if defined($WeBWorK::timer);
2161 my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @nonversionedProblemIDs;
2162 $WeBWorK::timer->continue("DB: getGlobalProblems start")
2163 if defined($WeBWorK::timer);
2164 my @GlobalProblems = $self->getGlobalProblems( @globalProblemIDs );
2165 $WeBWorK::timer->continue("DB: getTemplateProblems start")
2166 if defined($WeBWorK::timer);
2167 my @TemplateProblems = $self->getUserProblems( @nonversionedProblemIDs );
2168
2169 $WeBWorK::timer->continue("DB: calc common fields start")
2170 if defined($WeBWorK::timer);
2171
2172 my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
2173 my @commonFields =
2174 grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
2175
2176 $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
2177 for (my $i = 0; $i < @versionUserProblems; $i++) {
2178 my $UserProblem = $versionUserProblems[$i];
2179 my $GlobalProblem = $GlobalProblems[$i];
2180 my $TemplateProblem = $TemplateProblems[$i];
2181 next unless defined $UserProblem and ( defined $GlobalProblem or
2182 defined $TemplateProblem );
2183 foreach my $field (@commonFields) {
2184 next if defined $UserProblem->$field;
2185 $UserProblem->$field($GlobalProblem->$field)
2186 if ( defined($GlobalProblem) && defined($GlobalProblem->$field)
2187 && $GlobalProblem->$field ne '' );
2188 $UserProblem->$field($TemplateProblem->$field)
2189 if ( defined($TemplateProblem) &&
2190 defined($TemplateProblem->$field) &&
2191 $TemplateProblem->$field ne '' );
2192 }
2193 }
2194 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
2195
2196 return @versionUserProblems;
2197}
2198
1698=back 2199=back
1699 2200
1700=cut 2201=cut
1701 2202
1702################################################################################ 2203################################################################################
… …
1710 2211
1711################################################################################ 2212################################################################################
1712# utilities 2213# utilities
1713################################################################################ 2214################################################################################
1714 2215
1715sub checkKeyfields($) { 2216sub checkKeyfields($;$) {
1716 my ($Record) = @_; 2217 my ($Record, $versioned) = @_;
1717 foreach my $keyfield ($Record->KEYFIELDS) { 2218 foreach my $keyfield ($Record->KEYFIELDS) {
1718 my $value = $Record->$keyfield; 2219 my $value = $Record->$keyfield;
1719 croak "checkKeyfields: $keyfield is empty" 2220 croak "checkKeyfields: $keyfield is empty"
1720 unless defined $value and $value ne ""; 2221 unless defined $value and $value ne "";
1721 2222
1722 if ($keyfield eq "problem_id") { 2223 if ($keyfield eq "problem_id") {
1723 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])" 2224 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
1724 unless $value =~ m/^\d*$/; 2225 unless $value =~ m/^\d*$/;
1725 } else { 2226 } else {
1726 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])" 2227 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
2228 # this logic is a bit ugly, but it enforces what we want,
2229 # which is that only versioned problem sets are allowed
2230 # to include commas in their names.
1727 unless $value =~ m/^[\w-]*$/; 2231 unless ( $value =~ m/^[\w-]*$/ ||
2232 ( $value =~ m/^[\w,-]*$/ &&
2233 (defined($versioned) && $versioned) &&
2234 $keyfield eq "set_id" ) );
1728 } 2235 }
1729 } 2236 }
1730} 2237}
1731 2238
1732=head1 AUTHOR 2239=head1 AUTHOR
Legend:
Removed from v.2330  
changed lines
  Added in v.2331
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9