[system] / trunk / webwork2 / lib / WeBWorK / DB.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/DB.pm

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

Revision 3376 Revision 3377
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: webwork2/lib/WeBWorK/DB.pm,v 1.62 2004/12/20 15:24:16 sh002i Exp $ 4# $CVSHeader: webwork2/lib/WeBWorK/DB.pm,v 1.63 2005/06/10 15:59:51 gage 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.
… …
840$Key is a record object. The key will be added to the key table if a key with 840$Key is a record object. The key will be added to the key table if a key with
841the same user ID does not already exist. If one does exist, an exception is 841the same user ID does not already exist. If one does exist, an exception is
842thrown. To add a key, a user with a matching user ID must exist in the user 842thrown. To add a key, a user with a matching user ID must exist in the user
843table. 843table.
844 844
845We also allow user IDs to match userID1,userID2 where both userIDs are valid,
846to allow for proctored tests, where the second userID is the ID of the
847proctor.
848
845=cut 849=cut
846 850
847sub addKey($$) { 851sub addKey($$) {
848 my ($self, $Key) = @_; 852 my ($self, $Key) = @_;
849 853
850 croak "addKey: requires 1 argument" 854 croak "addKey: requires 1 argument"
851 unless @_ == 2; 855 unless @_ == 2;
852 croak "addKey: argument 1 must be of type ", $self->{key}->{record} 856 croak "addKey: argument 1 must be of type ", $self->{key}->{record}
853 unless ref $Key eq $self->{key}->{record}; 857 unless ref $Key eq $self->{key}->{record};
854 858
855 checkKeyfields($Key); 859 checkKeyfields($Key, 1); # 1 flags that we can have a comma
856 860
857 croak "addKey: key exists (perhaps you meant to use putKey?)" 861 croak "addKey: key exists (perhaps you meant to use putKey?)"
858 if $self->{key}->exists($Key->user_id); 862 if $self->{key}->exists($Key->user_id);
863 if ( $Key->user_id !~ /,/ ) {
859 croak "addKey: user ", $Key->user_id, " not found" 864 croak "addKey: user ", $Key->user_id, " not found"
860 unless $self->{user}->exists($Key->user_id); 865 unless $self->{user}->exists($Key->user_id);
866 } else {
867 my ( $userID, $proctorID ) = split(/,/, $Key->user_id);
868 croak "addKey: user $userID not found"
869 unless $self->{user}->exists($userID);
870 croak "addKey: proctor $proctorID not found"
871 unless $self->{user}->exists($proctorID);
872 }
861 873
862 return $self->{key}->add($Key); 874 return $self->{key}->add($Key);
863} 875}
864 876
865=item getKey($userID) 877=item getKey($userID)
… …
916 croak "putKey: requires 1 argument" 928 croak "putKey: requires 1 argument"
917 unless @_ == 2; 929 unless @_ == 2;
918 croak "putKey: argument 1 must be of type ", $self->{key}->{record} 930 croak "putKey: argument 1 must be of type ", $self->{key}->{record}
919 unless ref $Key eq $self->{key}->{record}; 931 unless ref $Key eq $self->{key}->{record};
920 932
921 checkKeyfields($Key); 933 checkKeyfields($Key, 1); # 1 allows commas for versioned sets
922 934
923 croak "putKey: key not found (perhaps you meant to use addKey?)" 935 croak "putKey: key not found (perhaps you meant to use addKey?)"
924 unless $self->{key}->exists($Key->user_id); 936 unless $self->{key}->exists($Key->user_id);
925 937
926 return $self->{key}->put($Key); 938 return $self->{key}->put($Key);
… …
1300 unless defined $userID; 1312 unless defined $userID;
1301 1313
1302 return map { $_->[1] } # extract set_id 1314 return map { $_->[1] } # extract set_id
1303 $self->{set_user}->list($userID, undef); 1315 $self->{set_user}->list($userID, undef);
1304} 1316}
1317
1318# the code from addUserSet() is duplicated in large part following in
1319# addVersionedUserSet; changes here should accordingly be propagated down there
1305 1320
1306sub addUserSet { 1321sub addUserSet {
1307 my ($self, $UserSet) = @_; 1322 my ($self, $UserSet) = @_;
1308 1323
1309 croak "addUserSet: requires 1 argument" 1324 croak "addUserSet: requires 1 argument"
… …
1319 unless $self->{user}->exists($UserSet->user_id); 1334 unless $self->{user}->exists($UserSet->user_id);
1320 croak "addUserSet: set ", $UserSet->set_id, " not found" 1335 croak "addUserSet: set ", $UserSet->set_id, " not found"
1321 unless $self->{set}->exists($UserSet->set_id); 1336 unless $self->{set}->exists($UserSet->set_id);
1322 1337
1323 return $self->{set_user}->add($UserSet); 1338 return $self->{set_user}->add($UserSet);
1339}
1340
1341sub addVersionedUserSet {
1342 my ($self, $UserSet) = @_;
1343
1344# this is the same as addUserSet,allowing for set names of the form setID,vN
1345
1346 croak "addVersionedUserSet: requires 1 argument"
1347 unless @_ == 2;
1348 croak "addVersionedUserSet: argument 1 must be of type ",
1349 $self->{set_user}->{record}
1350 unless ref $UserSet eq $self->{set_user}->{record};
1351
1352# $versioned is a flag that we send in to allow commas in the set name
1353# for versioned sets
1354 my $versioned = 1;
1355 checkKeyfields($UserSet, $versioned);
1356 my ($nonVersionedSetName) = ($UserSet->set_id =~ /^(.*),v\d+$/);
1357
1358 croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
1359 if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
1360 croak "addUserSet: user ", $UserSet->user_id, " not found"
1361 unless $self->{user}->exists($UserSet->user_id);
1362# croak "addUserSet: set ", $UserSet->set_id, " not found"
1363# unless $self->{set}->exists($UserSet->set_id);
1364# here the appropriate check is whether a global set of the nonversioned set
1365# name exists
1366 croak "addVersionedUserSet: set ", $nonVersionedSetName, " not found"
1367 unless $self->{set}->exists( $nonVersionedSetName );
1368
1369 return $self->{set_user}->add($UserSet);
1324} 1370}
1325 1371
1326sub getUserSet { 1372sub getUserSet {
1327 my ($self, $userID, $setID) = @_; 1373 my ($self, $userID, $setID) = @_;
1328 1374
… …
1361 } 1407 }
1362 1408
1363 return $self->{set_user}->gets(@userSetIDs); 1409 return $self->{set_user}->gets(@userSetIDs);
1364} 1410}
1365 1411
1412sub getUserSetVersions {
1413 my ( $self, $uid, $sid, $versionNum ) = @_;
1414# in: $uid is a userID, $sid is a setID, and $versionNum is a version number
1415# userID has set versions 1 through $versionNum defined
1416# out: an array of user set objects is returned for the indicated version
1417# numbers
1418
1419 croak "getUserSetVersions: requires three arguments, userID, setID, and " .
1420 "versionNum" if ( @_ < 3 );
1421
1422 my @userSetIDs = ();
1423 foreach my $i ( 1 .. $versionNum ) {
1424 push( @userSetIDs, [ $uid, "$sid,v$i" ] );
1425 }
1426
1427 return $self->getUserSets( @userSetIDs );
1428}
1429
1430# the code from putUserSet() is duplicated in large part in the following
1431# putVersionedUserSet; c.f. that routine
1432
1366sub putUserSet { 1433sub putUserSet {
1367 my ($self, $UserSet) = @_; 1434 my ($self, $UserSet) = @_;
1368 1435
1369 croak "putUserSet: requires 1 argument" 1436 croak "putUserSet: requires 1 argument"
1370 unless @_ == 2; 1437 unless @_ == 2;
… …
1381 unless $self->{set}->exists($UserSet->set_id); 1448 unless $self->{set}->exists($UserSet->set_id);
1382 1449
1383 return $self->{set_user}->put($UserSet); 1450 return $self->{set_user}->put($UserSet);
1384} 1451}
1385 1452
1453sub putVersionedUserSet {
1454 my ($self, $UserSet) = @_;
1455# this exists separate from putUserSet only so that we can make it harder
1456# for anyone else to use commas in setIDs
1457
1458 croak "putUserSet: requires 1 argument"
1459 unless @_ == 2;
1460 croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
1461 unless ref $UserSet eq $self->{set_user}->{record};
1462
1463 # versioned allows us to have a wacked out setID
1464 my $versioned = 1;
1465 checkKeyfields($UserSet, $versioned);
1466
1467 my $nonVersionedSetID = $UserSet->set_id;
1468 $nonVersionedSetID =~ s/,v\d+$//;
1469# my ($nonVersionedSetID) = ($UserSet->set_id =~ /^(.*)(,v\d+)?$/);
1470 croak "putVersionedUserSet: user set not found (perhaps you meant " .
1471 "to use addUserSet?)"
1472 unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
1473 croak "putVersionedUserSet: user ", $UserSet->user_id, " not found"
1474 unless $self->{user}->exists($UserSet->user_id);
1475 croak "putVersionedUserSet: set $nonVersionedSetID not found"
1476 unless $self->{set}->exists($nonVersionedSetID);
1477
1478 return $self->{set_user}->put($UserSet);
1479}
1480
1386sub deleteUserSet { 1481sub deleteUserSet {
1387 my ($self, $userID, $setID) = @_; 1482 my ($self, $userID, $setID, $skipVersionDel) = @_;
1388 1483
1389 croak "getUserSet: requires 2 arguments" 1484 croak "getUserSet: requires 2 arguments"
1390 unless @_ == 3; 1485 unless @_ == 3;
1391 croak "getUserSet: argument 1 must contain a user_id" 1486 croak "getUserSet: argument 1 must contain a user_id"
1392 unless defined $userID or caller eq __PACKAGE__; 1487 unless defined $userID or caller eq __PACKAGE__;
1393 croak "getUserSet: argument 2 must contain a set_id" 1488 croak "getUserSet: argument 2 must contain a set_id"
1394 unless defined $userID or caller eq __PACKAGE__; 1489 unless defined $userID or caller eq __PACKAGE__;
1395 1490
1491 $self->deleteUserSetVersions( $userID, $setID )
1492 if ( defined($setID) && ! ( defined($skipVersionDel) &&
1493 $skipVersionDel ) );
1396 $self->deleteUserProblem($userID, $setID, undef); 1494 $self->deleteUserProblem($userID, $setID, undef);
1397 return $self->{set_user}->delete($userID, $setID); 1495 return $self->{set_user}->delete($userID, $setID);
1496}
1497
1498sub deleteUserSetVersions {
1499 my ($self, $userID, $setID) = @_;
1500
1501# this only gets called from deleteUserSet, so we don't worry about $setID
1502# not being defined
1503
1504# make a list of all users to delete set versions for. if we have a userID,
1505# then just delete versions for that user
1506 my @allUsers = ();
1507 if ( defined( $userID ) ) {
1508 push( @allUsers, $userID );
1509 } else {
1510# otherwise, get a list of all users to whom the set is assigned, and delete
1511# all versions for all of them
1512 @allUsers = $self->listSetUsers( $setID );
1513 }
1514
1515# skip version deletion when calling deleteUserSet from here
1516 my $skipVersionDel = 1;
1517
1518# go through each userID and delete all versions of the set for each
1519 foreach my $uid ( @allUsers ) {
1520 my $setVersionNumber = $self->getUserSetVersionNumber($uid, $setID);
1521 if ( $setVersionNumber ) {
1522 for ( my $i=1; $i<=$setVersionNumber; $i++ ) {
1523 eval { $self->deleteUserSet( $uid, "$setID,v$i",
1524 $skipVersionDel ) };
1525 return $@ if ( $@ );
1526 }
1527 }
1528 }
1529}
1530
1531sub getUserSetVersionNumber {
1532 my ( $self, $uid, $sid ) = @_;
1533# in: uid and sid are user and set ids. the setID is the 'global' setID
1534# for the user, not a versioned value
1535# out: the latest version number of the set that has been assigned to the
1536# user is returned.
1537
1538 croak "getUserSetVersionNumber: requires 2 arguments, a user and set ID"
1539 unless @_ == 3 && defined $uid && defined $sid;
1540
1541# we just get all sets for the user and figure out which of them
1542# look like the sid.
1543 my @allSetIDs = $self->listUserSets( $uid );
1544 my @setIDs = sort( grep { /^$sid,v\d+$/ } @allSetIDs );
1545 my $lastSetID = $setIDs[-1];
1546# I think this should be defined, unless the set hasn't been assigned to
1547# the user at all, which we hope wouldn't have happened at this juncture
1548 if ( not defined($lastSetID) ) {
1549 return 0;
1550 } else {
1551 # we have to deal with the fact that 10 sorts to precede 2 (etc.)
1552 my @vNums = map { /^$sid,v(\d+)$/ } @setIDs;
1553 return ( ( sort {$a<=>$b} @vNums )[-1] );
1554 }
1398} 1555}
1399 1556
1400=back 1557=back
1401 1558
1402=cut 1559=cut
… …
1617 1774
1618 croak "addUserProblem: requires 1 argument" 1775 croak "addUserProblem: requires 1 argument"
1619 unless @_ == 2; 1776 unless @_ == 2;
1620 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1777 croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1621 unless ref $UserProblem eq $self->{problem_user}->{record}; 1778 unless ref $UserProblem eq $self->{problem_user}->{record};
1622 1779
1780# catch versioned sets here and check them allowing commas in some fields
1781 my $setID = $UserProblem->set_id;
1782 if ( $setID =~ /^(.*),v\d+/ ) { # then it's a versioned set
1783 $setID = $1;
1784 checkKeyfields($UserProblem, 1);
1785 } else {
1623 checkKeyfields($UserProblem); 1786 checkKeyfields($UserProblem);
1787 }
1624 1788
1625 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)" 1789 croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
1626 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1790 if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1627 croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1791 croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
1628 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1792 unless $self->{set_user}->exists($UserProblem->user_id, $setID);
1629 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1793 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
1630 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1794 unless $self->{problem}->exists($setID, $UserProblem->problem_id);
1631 1795
1632 return $self->{problem_user}->add($UserProblem); 1796 return $self->{problem_user}->add($UserProblem);
1633} 1797}
1634 1798
1635sub getUserProblem { 1799sub getUserProblem {
… …
1700 return $self->{problem_user}->gets(@problemIDTriples); 1864 return $self->{problem_user}->gets(@problemIDTriples);
1701 } 1865 }
1702} 1866}
1703 1867
1704sub putUserProblem { 1868sub putUserProblem {
1705 my ($self, $UserProblem) = @_; 1869 my ($self, $UserProblem, $versioned) = @_;
1870# $versioned is an optional argument which lets us slip versioned setIDs
1871# through checkKeyfields. this makes the first croak message a little
1872# disingenuous, of course.
1706 1873
1707 croak "putUserProblem: requires 1 argument" 1874 croak "putUserProblem: requires 1 argument"
1708 unless @_ == 2; 1875 unless @_ == 2 or @_ == 3;
1709 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record} 1876 croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
1710 unless ref $UserProblem eq $self->{problem_user}->{record}; 1877 unless ref $UserProblem eq $self->{problem_user}->{record};
1711 1878
1712 checkKeyfields($UserProblem); 1879 checkKeyfields($UserProblem, $versioned);
1713 1880
1714 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" 1881 croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
1715 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); 1882 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
1716 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)" 1883 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
1717 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); 1884 unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
1885
1886# allow versioned set names when $versioned is defined and true
1887 my $unversionedSetID = $UserProblem->set_id;
1888 $unversionedSetID =~ s/,v\d+$// if ( defined($versioned) && $versioned );
1889
1718 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" 1890 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
1719 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); 1891 unless $self->{problem}->exists($unversionedSetID, $UserProblem->problem_id);
1720 1892
1721 return $self->{problem_user}->put($UserProblem); 1893 return $self->{problem_user}->put($UserProblem);
1722} 1894}
1723 1895
1724sub deleteUserProblem { 1896sub deleteUserProblem {
… …
1777 unless defined $setID; 1949 unless defined $setID;
1778 1950
1779 return ( $self->getMergedSets([$userID, $setID]) )[0]; 1951 return ( $self->getMergedSets([$userID, $setID]) )[0];
1780} 1952}
1781 1953
1954=item getMergedVersionedSet($userID, $setID, $versionNum)
1955
1956Returns a merged set record associated with the record IDs given, for
1957versioned sets. If versionNum is supplied, the that version of the set
1958is returned; otherwise, the latest version is returned. If there is no
1959record associated with a given record ID, the undefined value is returned.
1960
1961Note that sid can be setid,vN, thereby specifying the version number
1962explicitly. If this is the case, any specified versionNum is ignored.
1963
1964=cut
1965
1966sub getMergedVersionedSet {
1967 my ( $self, $userID, $setID, $versionNum ) = @_;
1968#
1969# getMergedVersionedSet( self, uid, sid [, versionNum] )
1970# in: userID uid, setID sid, and optionally version number versionNum
1971# out: the merged set version for the user; if versionNum is specified,
1972# return that set version and otherwise the latest version. if
1973# no versioned set exists for the user, return undef.
1974# note that sid can be setid,vN, thereby specifying the version number
1975# explicitly. if this is the case, any specified versionNum is ignored
1976# we'd like to use getMergedSet to do the dirty work here, but that runs
1977# into problems because we want to merge with both the template set
1978# (that is, the userSet setID) and the global set
1979
1980 croak "getMergedVersionedSet: requires at least two arguments, a userID " .
1981 "and setID (missing setID)" if ( @_ < 3 || ! defined( $setID ) );
1982
1983 my $versionedSetID = $setID;
1984
1985 if ( ( ! defined($versionNum) || ! $versionNum ) && $setID !~ /,v\d+$/ ) {
1986 $versionNum = $self->getUserSetVersionNumber( $userID, $setID );
1987
1988 if ( ! $versionNum ) {
1989 return undef;
1990 } else {
1991 $versionedSetID .= ",v$versionNum";
1992 }
1993 } elsif ( defined($versionNum) && $versionNum ) {
1994 $versionedSetID = ($setID =~ /,v\d+$/ ? $setID : "$setID,v$versionNum");
1995 } else { # the last case is that $setID =~ /,v\d+$/
1996 $setID =~ s/,v\d+//;
1997 }
1998
1999 croak "getMergedVersionedSet: requires at least two arguments, a userID " .
2000 "and setID (missing userID)" if ( ! defined( $userID ) );
2001
2002 return ( $self->getMergedVersionedSets( [$userID, $setID,
2003 $versionedSetID] ) )[0];
2004}
2005
1782=item getMegedSets(@userSetIDs) 2006=item getMergedSets(@userSetIDs)
1783 2007
1784Return a list of merged set records associated with the record IDs given. If 2008Return a list of merged set records associated with the record IDs given. If
1785there is no record associated with a given record ID, that element of the list 2009there is no record associated with a given record ID, that element of the list
1786will be undefined. @userSetIDs consists of references to arrays in which the 2010will be undefined. @userSetIDs consists of references to arrays in which the
1787first element is the user_id and the second element is the set_id. 2011first element is the user_id and the second element is the set_id.
1788 2012
1789=cut 2013=cut
2014
2015# a significant amount of getMergedSets is duplicated in getMergedVersionedSets
2016# below
1790 2017
1791sub getMergedSets { 2018sub getMergedSets {
1792 my ($self, @userSetIDs) = @_; 2019 my ($self, @userSetIDs) = @_;
1793 2020
1794 #croak "getMergedSets: requires 1 or more argument" 2021 #croak "getMergedSets: requires 1 or more argument"
… …
1839 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 2066 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1840 2067
1841 return @UserSets; 2068 return @UserSets;
1842} 2069}
1843 2070
2071sub getMergedVersionedSets {
2072 my ($self, @userSetIDs) = @_;
2073
2074 foreach my $i (0 .. $#userSetIDs) {
2075 croak "getMergedSets: element $i of argument list must contain a " .
2076 "<user_id, set_id, versioned_set_id> triple"
2077 unless( defined $userSetIDs[$i]
2078 and ref $userSetIDs[$i] eq "ARRAY"
2079 and @{$userSetIDs[$i]} == 3
2080 and defined $userSetIDs[$i]->[0]
2081 and defined $userSetIDs[$i]->[1]
2082 and defined $userSetIDs[$i]->[2] );
2083 }
2084
2085# these are [user_id, set_id] pairs
2086 my @nonversionedUserSetIDs = map { [$_->[0], $_->[1]] } @userSetIDs;
2087# these are [user_id, versioned_set_id] pairs
2088 my @versionedUserSetIDs = map { [$_->[0], $_->[2]] } @userSetIDs;
2089
2090# the following has never been tested, and probably doesn't actually work
2091# will anyone every try and do gateways on a GDBM install of WeBWorK2?
2092 # a horrible, terrible hack ;)
2093 if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
2094 and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
2095 #warn __PACKAGE__.": using a terrible hack.\n";
2096# $WeBWorK::timer->continue("DB: getsNoFilter start")
2097# if defined($WeBWorK::timer);
2098# my @MergedSets = $self->{set_user}->getsNoFilter(@versionedUserSetIDs);
2099# $WeBWorK::timer->continue("DB: getsNoFilter end")
2100# if defined($WeBWorK::timer);
2101# return @MergedSets;
2102 croak 'getMergedVersionedSets: using WW1Hash DB Schema! Versioned ' .
2103 'sets are not supported in this context.';
2104 }
2105
2106# we merge the nonversioned ("template") user sets (user_id, set_id) and
2107# the global data into the versioned user sets
2108 $WeBWorK::timer->continue("DB: getUserSets start (nonversioned)")
2109 if defined($WeBWorK::timer);
2110 my @TemplateUserSets = $self->getUserSets(@nonversionedUserSetIDs);
2111 $WeBWorK::timer->continue("DB: getUserSets start (versioned)")
2112 if defined($WeBWorK::timer);
2113# these are the actual user sets that we want to use
2114 my @versionedUserSets = $self->getUserSets(@versionedUserSetIDs);
2115
2116 $WeBWorK::timer->continue("DB: pull out set IDs start")
2117 if defined($WeBWorK::timer);
2118 my @globalSetIDs = map { $_->[1] } @userSetIDs;
2119 $WeBWorK::timer->continue("DB: getGlobalSets start")
2120 if defined($WeBWorK::timer);
2121 my @GlobalSets = $self->getGlobalSets(@globalSetIDs);
2122
2123 $WeBWorK::timer->continue("DB: calc common fields start")
2124 if defined($WeBWorK::timer);
2125 my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
2126 my @commonFields =
2127 grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
2128
2129 $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
2130 for (my $i = 0; $i < @TemplateUserSets; $i++) {
2131 next unless( defined $versionedUserSets[$i] and
2132 (defined $TemplateUserSets[$i] or
2133 defined $GlobalSets[$i]) );
2134 foreach my $field (@commonFields) {
2135 next if ( defined( $versionedUserSets[$i]->$field ) &&
2136 $versionedUserSets[$i]->$field ne '' );
2137 $versionedUserSets[$i]->$field($GlobalSets[$i]->$field) if
2138 (defined($GlobalSets[$i]->$field) &&
2139 $GlobalSets[$i]->$field ne '');
2140 $versionedUserSets[$i]->$field($TemplateUserSets[$i]->$field)
2141 if (defined($TemplateUserSets[$i]) &&
2142 defined($TemplateUserSets[$i]->$field) &&
2143 $TemplateUserSets[$i]->$field ne '');
2144 }
2145 }
2146 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
2147
2148 return @versionedUserSets;
2149}
2150
1844=back 2151=back
1845 2152
1846=cut 2153=cut
1847 2154
1848################################################################################ 2155################################################################################
… …
1883 unless defined $setID; 2190 unless defined $setID;
1884 croak "getGlobalUserSet: argument 3 must contain a problem_id" 2191 croak "getGlobalUserSet: argument 3 must contain a problem_id"
1885 unless defined $problemID; 2192 unless defined $problemID;
1886 2193
1887 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0]; 2194 return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0];
2195}
2196
2197=item getMergedVersionedProblem($userID, $setID, $setVersionID, $problemID)
2198
2199Returns a merged problem record associated with the record IDs given, for
2200versioned problem sets. If there is no record associated with a given
2201record ID, the undefined value is returned.
2202
2203=cut
2204
2205sub getMergedVersionedProblem {
2206 my ($self, $userID, $setID, $setVersionID, $problemID) = @_;
2207
2208# this exists distinct from getMergedProblem only to be able to include the
2209# setVersionID
2210
2211 croak "getGlobalUserSet: requires 4 arguments"
2212 unless @_ == 5;
2213 croak "getGlobalUserSet: argument 1 must contain a user_id"
2214 unless defined $userID;
2215 croak "getGlobalUserSet: argument 2 must contain a set_id"
2216 unless defined $setID;
2217 croak "getGlobalUserSet: argument 3 must contain a versioned set_id"
2218 unless defined $setVersionID;
2219 croak "getGlobalUserSet: argument 4 must contain a problem_id"
2220 unless defined $problemID;
2221
2222 return ($self->getMergedVersionedProblems([$userID, $setID, $setVersionID,
2223 $problemID]))[0];
1888} 2224}
1889 2225
1890=item getMergedProblems(@userProblemIDs) 2226=item getMergedProblems(@userProblemIDs)
1891 2227
1892Return a list of merged problem records associated with the record IDs given. If 2228Return a list of merged problem records associated with the record IDs given. If
… …
1942 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 2278 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1943 2279
1944 return @UserProblems; 2280 return @UserProblems;
1945} 2281}
1946 2282
2283sub getMergedVersionedProblems {
2284 my ($self, @userProblemIDs) = @_;
2285
2286 foreach my $i (0 .. $#userProblemIDs) {
2287 croak "getMergedProblems: element $i of argument list must contain a " .
2288 "<user_id, set_id, versioned_set_id, problem_id> quadruple"
2289 unless( defined $userProblemIDs[$i]
2290 and ref $userProblemIDs[$i] eq "ARRAY"
2291 and @{$userProblemIDs[$i]} == 4
2292 and defined $userProblemIDs[$i]->[0]
2293 and defined $userProblemIDs[$i]->[1]
2294 and defined $userProblemIDs[$i]->[2]
2295 and defined $userProblemIDs[$i]->[3] );
2296 }
2297
2298 $WeBWorK::timer->continue("DB: getUserProblems start")
2299 if defined($WeBWorK::timer);
2300
2301# these are triples [user_id, set_id, problem_id]
2302 my @nonversionedProblemIDs = map {[$_->[0],$_->[1],$_->[3]]} @userProblemIDs;
2303# these are triples [user_id, versioned_set_id, problem_id]
2304 my @versionedProblemIDs = map {[$_->[0],$_->[2],$_->[3]]} @userProblemIDs;
2305
2306# these are the actual user problems for the version
2307 my @versionUserProblems = $self->getUserProblems(@versionedProblemIDs);
2308
2309# get global problems (no user_id, set_id = nonversioned set_id) and
2310# template problems (user_id, set_id = nonversioned set_id); we merge with
2311# both of these, replacing global values with template values and not
2312# taking either in the event that the versioned problem already has a
2313# value for the field in question
2314 $WeBWorK::timer->continue("DB: pull out set/problem IDs start")
2315 if defined($WeBWorK::timer);
2316 my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @nonversionedProblemIDs;
2317 $WeBWorK::timer->continue("DB: getGlobalProblems start")
2318 if defined($WeBWorK::timer);
2319 my @GlobalProblems = $self->getGlobalProblems( @globalProblemIDs );
2320 $WeBWorK::timer->continue("DB: getTemplateProblems start")
2321 if defined($WeBWorK::timer);
2322 my @TemplateProblems = $self->getUserProblems( @nonversionedProblemIDs );
2323
2324 $WeBWorK::timer->continue("DB: calc common fields start")
2325 if defined($WeBWorK::timer);
2326
2327 my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
2328 my @commonFields =
2329 grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
2330
2331 $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
2332 for (my $i = 0; $i < @versionUserProblems; $i++) {
2333 my $UserProblem = $versionUserProblems[$i];
2334 my $GlobalProblem = $GlobalProblems[$i];
2335 my $TemplateProblem = $TemplateProblems[$i];
2336 next unless defined $UserProblem and ( defined $GlobalProblem or
2337 defined $TemplateProblem );
2338 foreach my $field (@commonFields) {
2339 next if defined $UserProblem->$field && $UserProblem->$field ne '';
2340 $UserProblem->$field($GlobalProblem->$field)
2341 if ( defined($GlobalProblem) && defined($GlobalProblem->$field)
2342 && $GlobalProblem->$field ne '' );
2343 $UserProblem->$field($TemplateProblem->$field)
2344 if ( defined($TemplateProblem) &&
2345 defined($TemplateProblem->$field) &&
2346 $TemplateProblem->$field ne '' );
2347 }
2348 }
2349 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
2350
2351 return @versionUserProblems;
2352}
2353
1947=back 2354=back
1948 2355
1949=cut 2356=cut
1950 2357
1951################################################################################ 2358################################################################################
… …
1959 2366
1960################################################################################ 2367################################################################################
1961# utilities 2368# utilities
1962################################################################################ 2369################################################################################
1963 2370
2371# the (optional) second argument to checkKeyfields is to support versioned
2372# (gateway) sets, which may include commas in certain fields (in particular,
2373# set names (e.g., setDerivativeGateway,v1) and user names (e.g.,
2374# username,proctorname)
2375
1964sub checkKeyfields($) { 2376sub checkKeyfields($;$) {
1965 my ($Record) = @_; 2377 my ($Record, $versioned) = @_;
1966 foreach my $keyfield ($Record->KEYFIELDS) { 2378 foreach my $keyfield ($Record->KEYFIELDS) {
1967 my $value = $Record->$keyfield; 2379 my $value = $Record->$keyfield;
1968 croak "checkKeyfields: $keyfield is empty" 2380 croak "checkKeyfields: $keyfield is empty"
1969 unless defined $value and $value ne ""; 2381 unless defined $value and $value ne "";
1970 2382
1971 if ($keyfield eq "problem_id") { 2383 if ($keyfield eq "problem_id") {
1972 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])" 2384 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
1973 unless $value =~ m/^\d*$/; 2385 unless $value =~ m/^\d*$/;
1974 } else { 2386 } else {
1975 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_.])" 2387 croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_.])"
1976 unless $value =~ m/^[.\w\-]*$/; 2388# unless $value =~ m/^[.\w\-]*$/;
2389 unless ( $value =~ m/^[\w-]*$/ ||
2390 ( $value =~ m/^[\w,-]*$/ &&
2391 (defined($versioned) && $versioned)
2392 &&
2393 ($keyfield eq "set_id" ||
2394 $keyfield eq "user_id") ) );
1977 } 2395 }
1978 } 2396 }
1979} 2397}
1980 2398
1981=head1 AUTHOR 2399=head1 AUTHOR
Legend:
Removed from v.3376  
changed lines
  Added in v.3377
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9