[system] / trunk / webwork-modperl / lib / WeBWorK / DB / WW.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WeBWorK/DB/WW.pm

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

Revision 388 Revision 389
… …
5 5
6package WeBWorK::DB::WW; 6package WeBWorK::DB::WW;
7 7
8use strict; 8use strict;
9use warnings; 9use warnings;
10use Carp;
10use WeBWorK::Set; 11use WeBWorK::Set;
11use WeBWorK::Problem; 12use WeBWorK::Problem;
12 13
13use constant LOGIN_PREFIX => "login<>"; 14use constant LOGIN_PREFIX => "login<>";
14use constant SET_PREFIX => "set<>"; 15use constant SET_PREFIX => "set<>";
16use constant MAX_PSVN_GENERATION_ATTEMPTS => 200;
15 17
16# there should be a `use' line for each database type 18# there should be a `use' line for each database type
17use WeBWorK::DB::GDBM; 19use WeBWorK::DB::GDBM;
18 20
19# new($invocant, $courseEnv) 21# new($invocant, $courseEnv)
… …
24 my $class = ref($invocant) || $invocant; 26 my $class = ref($invocant) || $invocant;
25 my $courseEnv = shift; 27 my $courseEnv = shift;
26 my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{wwdb_type}); 28 my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{wwdb_type});
27 my $self = { 29 my $self = {
28 webwork_file => $courseEnv->{dbInfo}->{wwdb_file}, 30 webwork_file => $courseEnv->{dbInfo}->{wwdb_file},
31 psvn_digits => $courseEnv->{dbInfo}->{psvn_digits},
29 }; 32 };
30 $self->{webwork_db} = $dbModule->new($self->{webwork_file}); 33 $self->{webwork_db} = $dbModule->new($self->{webwork_file});
31 bless $self, $class; 34 bless $self, $class;
32 return $self; 35 return $self;
33} 36}
… …
39 return $package; 42 return $package;
40} 43}
41 44
42# ----- 45# -----
43 46
47sub fixMyMistakes($) { # ***
48 my $self = shift;
49 my $userID = "practice1";
50 my $setID = "dummy";
51 my $PSVN = 95540;
52 $self->{webwork_db}->connect("rw");
53 delete $self->{webwork_db}->hashRef->{$PSVN};
54 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
55 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
56 my %sets = decode($setsForUser); # sets built for user $userID
57 my %users = decode($usersForSet); # users for which set $setID has been built
58 delete $sets{$setID};
59 delete $users{$userID};
60 $setsForUser = encode(%sets);
61 $usersForSet = encode(%users);
62 $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
63 $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
64 $self->{webwork_db}->disconnect;
65}
66
67# -----
68
44# getSets($userID) - returns a list of sets in the current database for the 69# getSets($userID) - returns a list of sets in the current database for the
45# specified user 70# specified user
46# $userID - the user ID (a.k.a. login name) of the user to get sets for 71# $userID - the user ID (a.k.a. login name) of the user to get sets for
47sub getSets($$) { 72sub getSets($$) {
48 my $self = shift; 73 my $self = shift;
49 my $userID = shift; 74 my $userID = shift;
50 return unless $self->{webwork_db}->connect("ro"); 75 return unless $self->{webwork_db}->connect("ro");
51 my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 76 my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
52 $self->{webwork_db}->disconnect; 77 $self->{webwork_db}->disconnect;
53 return unless defined $result; 78 return unless defined $result;
54 return keys %{decode($result)}; 79 my %record = decode($result);
80 return keys %record;
55} 81}
56 82
57# ----- 83# -----
58 84
59# getSet($userID, $setID) - returns a WeBWorK::Set object containing data 85# getSet($userID, $setID) - returns a WeBWorK::Set object containing data
… …
62# $setID - the ID (a.k.a. name) of the set to retrieve 88# $setID - the ID (a.k.a. name) of the set to retrieve
63sub getSet($$$) { 89sub getSet($$$) {
64 my $self = shift; 90 my $self = shift;
65 my $userID = shift; 91 my $userID = shift;
66 my $setID = shift; 92 my $setID = shift;
67 my $PSVN = getPSVN($userID, $setID); 93 my $PSVN = $self->getPSVN($userID, $setID);
68 return unless $PSVN; 94 return unless $PSVN;
69 return hash2set($self->fetchRcord($PSVN)); 95 return hash2set($self->fetchRecord($PSVN));
70} 96}
71 97
72# setSet($set) - if a set with the same ID for the specified user 98# setSet($set) - if a set with the same ID for the specified user
73# exists, it is replaced. If not, a new set is added. 99# exists, it is replaced. If not, a new set is added.
74# returns true on success, undef on failure. 100# returns true on success, undef on failure.
75# $set - a WeBWorK::Set object containing the set data 101# $set - a WeBWorK::Set object containing the set data
76sub setSet($$) { 102sub setSet($$) {
77 my $self = shift; 103 my $self = shift;
78 my $set = shift; 104 my $set = shift;
79 my $PSVN = getPSVN($set->login_id, $set->id); 105 my $PSVN = $self->getPSVN($set->login_id, $set->id);
80 my %record = ( 106 my %record = (
81 $PSVN ? $self->fetchRecord($PSVN) : (), 107 $PSVN ? $self->fetchRecord($PSVN) : (),
82 set2hash($set), 108 set2hash($set),
83 ); 109 );
110 $PSVN = $self->setPSVN($set->login_id, $set->id) unless ($PSVN);
84 return $self->storeRecord($PSVN, %record); 111 return $self->storeRecord($PSVN, %record);
85} 112}
86 113
87# deleteSet($userID, $setID) - removes the set with the specified userID and 114# deleteSet($userID, $setID) - removes the set with the specified userID and
115# setID. Also removes all problems in set.
88# setID. Returns true on success, undef on failure. 116# Returns true on success, undef on failure.
89# $userID - the user ID (a.k.a. login name) of the set to delete 117# $userID - the user ID (a.k.a. login name) of the set to delete
90# $setID - the ID (a.k.a. name) of the set to delete 118# $setID - the ID (a.k.a. name) of the set to delete
91sub deleteSet($$$) { 119sub deleteSet($$$) {
92 my $self = shift; 120 my $self = shift;
93 my $userID = shift; 121 my $userID = shift;
94 my $setID = shift; 122 my $setID = shift;
95 my $PSVN = getPSVN($userID, $setID); 123 my $PSVN = $self->getPSVN($userID, $setID);
96 $self->{classlist_db}->connect("rw"); 124 $self->{webwork_db}->connect("rw");
97 delete $self->{classlist_db}->hashRef->{$userID}; 125 delete $self->{webwork_db}->hashRef->{$PSVN};
98 $self->{classlist_db}->disconnect; 126 $self->{webwork_db}->disconnect;
127 $self->deletePSVN($userID, $setID);
99 return 1; 128 return 1;
100} 129}
101 130
102# ----- 131# -----
103 132
… …
119# $setID - the set ID to get problems from 148# $setID - the set ID to get problems from
120sub getProblems($$$) { 149sub getProblems($$$) {
121 my $self = shift; 150 my $self = shift;
122 my $userID = shift; 151 my $userID = shift;
123 my $setID = shift; 152 my $setID = shift;
124 my $PSVN = getPSVN($userID, $setID); 153 my $PSVN = $self->getPSVN($userID, $setID);
125 my %record = $self->fetchRecord($PSVN); 154 my %record = $self->fetchRecord($PSVN);
155 return unless %record;
126 my @result; 156 my @result;
127 my $i = 1; 157 my $i = 1;
128 while (exists $record{"pse".$i}) { 158 while (exists $record{"pse".$i}) {
129 push @result, $i++; 159 push @result, $i++;
130 } 160 }
… …
142sub getProblem($$$$) { 172sub getProblem($$$$) {
143 my $self = shift; 173 my $self = shift;
144 my $userID = shift; 174 my $userID = shift;
145 my $setID = shift; 175 my $setID = shift;
146 my $problemNumber = shift; 176 my $problemNumber = shift;
147 my $PSVN = getPSVN($userID, $setID); 177 my $PSVN = $self->getPSVN($userID, $setID);
148 return unless $PSVN; 178 return unless $PSVN;
149 return hash2problem($problemNumber, fetchRecord($PSVN)); 179 return hash2problem($problemNumber, $self->fetchRecord($PSVN));
150} 180}
151 181
152# setProblem($problem) - if a problem with the same ID for the specified user 182# setProblem($problem) - if a problem with the same ID for the specified user
153# exists, it is replaced. If not, a new problem is added. 183# exists, it is replaced. If not, a new problem is added.
154# returns true on success, undef on failure. 184# returns true on success, undef on failure.
155# $problem - a WeBWorK::Problem object containing the object data 185# $problem - a WeBWorK::Problem object containing the object data
156sub setProblem($$) { 186sub setProblem($$) {
157 my $self = shift; 187 my $self = shift;
158 my $problem = shift; 188 my $problem = shift;
159 my $PSVN = getPSVN($problem->login_id, $problem->set_id); 189 my $PSVN = $self->getPSVN($problem->login_id, $problem->set_id);
190 die "failed to add problem: set ", $problem->set_id, " does not exist."
191 unless $PSVN;
160 my %record = ( 192 my %record = (
161 $PSVN ? $self->fetchRecord($PSVN) : (), 193 $self->fetchRecord($PSVN),
162 problem2hash($problem), 194 problem2hash($problem),
163 ); 195 );
164 return $self->storeRecord($PSVN, %record); 196 return $self->storeRecord($PSVN, %record);
165} 197}
166 198
… …
172sub deleteProblem($$$$) { 204sub deleteProblem($$$$) {
173 my $self = shift; 205 my $self = shift;
174 my $userID = shift; 206 my $userID = shift;
175 my $setID = shift; 207 my $setID = shift;
176 my $n = shift; 208 my $n = shift;
177 my $PSVN = getPSVN($userID, $setID); 209 my $PSVN = $self->getPSVN($userID, $setID);
178 my %record = $self->fetchRecord($PSVN); 210 my %record = $self->fetchRecord($PSVN);
179 return unless %record; 211 return unless %record;
180 delete $record{"pfn$n"} if exists $record{"pfn$n"}; 212 delete $record{"pfn$n"} if exists $record{"pfn$n"};
181 delete $record{"pva$n"} if exists $record{"pva$n"}; 213 delete $record{"pva$n"} if exists $record{"pva$n"};
182 delete $record{"pmia$n"} if exists $record{"pmia$n"}; 214 delete $record{"pmia$n"} if exists $record{"pmia$n"};
… …
207# $setID - the set ID of the problem defaults to delete 239# $setID - the set ID of the problem defaults to delete
208# $problemNumber - the problem number of the problem defaults to delete 240# $problemNumber - the problem number of the problem defaults to delete
209 241
210# ----- 242# -----
211 243
244# getPSVNs($userID) - get a list of PSVNs for a user
245# $userID - the user
246sub getPSVNs($$) {
247 my $self = shift;
248 my $userID = shift;
249 return unless $self->{webwork_db}->connect("ro");
250 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
251 $self->{webwork_db}->disconnect;
252 return unless defined $setsForUser;
253 my %sets = decode($setsForUser);
254 return values %sets;
255}
256
257# -----
258
212# getPSVN($userID, $setID) - look up a PSVN given a user ID and set ID (PSVN 259# getPSVN($userID, $setID) - look up a PSVN given a user ID and set ID (PSVN
213# stands for Problem Set Version Number and 260# stands for Problem Set Version Number and
214# uniquely identifies a user's version of a set.) 261# uniquely identifies a user's version of a set.)
215# $userID - the user ID to lookup 262# $userID - the user ID to lookup
216# $serID - the set ID to lookup 263# $serID - the set ID to lookup
217sub getPSVN($$$) { 264sub getPSVN($$$) {
218 my $self = shift; 265 my $self = shift;
219 my $userID = shift; 266 my $userID = shift;
220 my $setID = shift; 267 my $setID = shift;
221 return unless $self->{webwork_db}->connect("ro"); 268 return unless $self->{webwork_db}->connect("ro");
222 my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 269 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
270 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
223 $self->{webwork_db}->disconnect; 271 $self->{webwork_db}->disconnect;
224 return unless $result; 272 # * if setsForUser is non-empty, then there are sets built for
273 # this user.
274 # * if usersForSet is non-empty, then this set has been built for
275 # at least one user.
276 # * if either are empty, it is guaranteed that this set has not
277 # been built for this user.
278 return unless defined $setsForUser and defined $usersForSet;
279 return unless $setsForUser and $usersForSet;
225 my %sets = decode($result); 280 my %sets = decode($setsForUser);
281 my %users = decode($usersForSet);
282 # more sanity checks: the following should never happen.
283 # if they do, run screaming for the hills.
284 if (defined $sets{$setID} and not defined $users{$userID}) {
285 die "PSVN indexes inconsistent: set exists in user index ",
286 "but user does not exist in set index.";
287 } elsif (not defined $sets{$setID} and defined $users{$userID}) {
288 die "PSVN indexes inconsistent: user exists in set index ",
289 "but set does not exist in user index.";
290 } elsif ($sets{$setID} != $users{$userID}) {
291 die "PSVN indexes inconsistent: user index and set index ",
292 "gave different PSVN values.";
293 }
226 return $sets{$setID}; 294 return $sets{$setID};
295}
296
297# setPSVN($userID, $setID) - adds a new PSVN to the PSVN indexesfor the given
298# user ID and set ID, if it doesn't exist. Returns
299# the PSVN.
300# $userID - the user ID to use
301# $serID - the set ID to use
302sub setPSVN($$$) {
303 my $self = shift;
304 my $userID = shift;
305 my $setID = shift;
306 my $PSVN = $self->getPSVN($userID, $setID);
307 unless ($PSVN) {
308 # yeah, create a new PSVN here
309 my $min_psvn = 10**($self->{psvn_digits} - 1);
310 my $max_psvn = 10**$self->{psvn_digits} - 1;
311 my $attempts = 0;
312 do {
313 if (++$attempts > MAX_PSVN_GENERATION_ATTEMPTS) {
314 die "failed to find an unused PSVN.";
315 }
316 $PSVN = int(rand($max_psvn-$min_psvn+1)) + $min_psvn;
317 } while ($self->fetchRecord($PSVN));
318 $self->{webwork_db}->connect("rw"); # open "rw" to lock
319 # get current PSVN indexes
320 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
321 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
322 my %sets = decode($setsForUser); # sets built for user $userID
323 my %users = decode($usersForSet); # users for which set $setID has been built
324 # insert new PSVN into each hash
325 $sets{$setID} = $PSVN;
326 $users{$userID} = $PSVN;
327 # re-encode the hashes
328 $setsForUser = encode(%sets);
329 $usersForSet = encode(%users);
330 # store 'em in the database
331 $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
332 $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
333 $self->{webwork_db}->disconnect;
334 };
335 return $PSVN;
336}
337
338# deletePSVN($userID, $setID) - remove an entry from the PSVN indexes.
339# $userID - the user to remove
340# $setID - the set to remove
341sub deletePSVN($$) {
342 my $self = shift;
343 my $userID = shift;
344 my $setID = shift;
345 my $PSVN = $self->getPSVN($userID, $setID);
346 return unless $PSVN;
347 $self->{webwork_db}->connect("rw"); # open "rw" to lock
348 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
349 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
350 my %sets = decode($setsForUser); # sets built for user $userID
351 my %users = decode($usersForSet); # users for which set $setID has been built
352 delete $sets{$setID};
353 delete $users{$userID};
354 $setsForUser = encode(%sets);
355 $usersForSet = encode(%users);
356 $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
357 $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
358 $self->{webwork_db}->disconnect;
359 return 1;
227} 360}
228 361
229# ----- 362# -----
230 363
231# fetchRecord($PSVN) - retrieve the record associated with the given PSVN 364# fetchRecord($PSVN) - retrieve the record associated with the given PSVN
… …
271# %hash - hash to encode 404# %hash - hash to encode
272sub encode(%) { 405sub encode(%) {
273 my %hash = @_; 406 my %hash = @_;
274 my $string; 407 my $string;
275 foreach (keys %hash) { 408 foreach (keys %hash) {
409 $hash{$_} = "" unless defined $hash{$_}; # promote undef to ""
276 $hash{$_} =~ s/(=|&)/\\$1/; # escape & and = 410 $hash{$_} =~ s/(=|&)/\\$1/; # escape & and =
277 $string .= "$_=$hash{$_}&"; 411 $string .= "$_=$hash{$_}&";
278 } 412 }
279 chop $string; # remove final '&' from string for old code :p 413 chop $string if $string; # remove final '&' from string for old code :p
280 return $string; 414 return $string;
281} 415}
282 416
283# ----- 417# -----
284 418
… …
301# set2hash($set) - unpacks a WeBWorK::Set object and returns PART of a hash 435# set2hash($set) - unpacks a WeBWorK::Set object and returns PART of a hash
302# suitable for storage in the webwork database. 436# suitable for storage in the webwork database.
303# $set - a WeBWorK::Set object. 437# $set - a WeBWorK::Set object.
304sub set2hash($) { 438sub set2hash($) {
305 my $set = shift; 439 my $set = shift;
306 my %hash; 440 return (
307 $hash{stnm} = $set->id if defined $set->id; 441 stnm => $set->id,
308 $hash{stlg} = $set->login_id if defined $set->login_id; 442 stlg => $set->login_id,
309 $hash{shfn} = $set->set_header if defined $set->set_header; 443 shfn => $set->set_header,
310 $hash{phfn} = $set->problem_header if defined $set->problem_header; 444 phfn => $set->problem_header,
311 $hash{opdt} = $set->open_date if defined $set->open_date; 445 opdt => $set->open_date,
312 $hash{dudt} = $set->due_date if defined $set->due_date; 446 dudt => $set->due_date,
313 $hash{andt} = $set->answer_date if defined $set->answer_date; 447 andt => $set->answer_date,
448 );
314} 449}
315 450
316# hash@problem($n, %hash) - places selected fields from a webwork 451# hash@problem($n, %hash) - places selected fields from a webwork
317# database record in a WeBWorK::Problem 452# database record in a WeBWorK::Problem
318# object, which is then returned. 453# object, which is then returned.
… …
331 $problem->status ( $hash{"pst$n"} ) if defined $hash{"pst$n"}; 466 $problem->status ( $hash{"pst$n"} ) if defined $hash{"pst$n"};
332 $problem->attempted ( $hash{"pat$n"} ) if defined $hash{"pat$n"}; 467 $problem->attempted ( $hash{"pat$n"} ) if defined $hash{"pat$n"};
333 $problem->last_answer ( $hash{"pan$n"} ) if defined $hash{"pan$n"}; 468 $problem->last_answer ( $hash{"pan$n"} ) if defined $hash{"pan$n"};
334 $problem->num_correct ( $hash{"pca$n"} ) if defined $hash{"pca$n"}; 469 $problem->num_correct ( $hash{"pca$n"} ) if defined $hash{"pca$n"};
335 $problem->num_incorrect ( $hash{"pia$n"} ) if defined $hash{"pia$n"}; 470 $problem->num_incorrect ( $hash{"pia$n"} ) if defined $hash{"pia$n"};
336 471 return $problem;
337} 472}
338 473
339# problem2hash($problem) - unpacks a WeBWorK::Problem object and returns PART 474# problem2hash($problem) - unpacks a WeBWorK::Problem object and returns PART
340# of a hash suitable for storage in the webwork 475# of a hash suitable for storage in the webwork
341# database. 476# database.
342# $problem - a WeBWorK::Problem object 477# $problem - a WeBWorK::Problem object
343sub problem2hash($) { 478sub problem2hash($) {
344 my $problem = shift; 479 my $problem = shift;
345 my $n = $problem->id; 480 my $n = $problem->id;
346 my %hash; 481# my %hash;
347 $hash{stnm} = $problem->set_id if defined $problem->set_id; 482# $hash{stnm} = $problem->set_id if defined $problem->set_id;
348 $hash{stlg} = $problem->login_id if defined $problem->login_id; 483# $hash{stlg} = $problem->login_id if defined $problem->login_id;
349 $hash{"pfn$n"} = $problem->source_file if defined $problem->source_file; 484# $hash{"pfn$n"} = $problem->source_file if defined $problem->source_file;
350 $hash{"pva$n"} = $problem->value if defined $problem->value; 485# $hash{"pva$n"} = $problem->value if defined $problem->value;
351 $hash{"pmia$n"}= $problem->max_attempts if defined $problem->max_attempts; 486# $hash{"pmia$n"}= $problem->max_attempts if defined $problem->max_attempts;
352 $hash{"pse$n"} = $problem->problem_seed if defined $problem->problem_seed; 487# $hash{"pse$n"} = $problem->problem_seed if defined $problem->problem_seed;
353 $hash{"pst$n"} = $problem->status if defined $problem->status; 488# $hash{"pst$n"} = $problem->status if defined $problem->status;
354 $hash{"pat$n"} = $problem->attempted if defined $problem->attempted; 489# $hash{"pat$n"} = $problem->attempted if defined $problem->attempted;
355 $hash{"pan$n"} = $problem->last_answer if defined $problem->last_answer; 490# $hash{"pan$n"} = $problem->last_answer if defined $problem->last_answer;
356 $hash{"pca$n"} = $problem->num_correct if defined $problem->num_correct; 491# $hash{"pca$n"} = $problem->num_correct if defined $problem->num_correct;
357 $hash{"pia$n"} = $problem->num_incorrect if defined $problem->num_incorrect; 492# $hash{"pia$n"} = $problem->num_incorrect if defined $problem->num_incorrect;
358 return %hash; 493# return %hash;
494 return (
495 stnm => $problem->set_id,
496 stlg => $problem->login_id,
497 "pfn$n" => $problem->source_file,
498 "pva$n" => $problem->value,
499 "pmia$n" => $problem->max_attempts,
500 "pse$n" => $problem->problem_seed,
501 "pst$n" => $problem->status,
502 "pat$n" => $problem->attempted,
503 "pan$n" => $problem->last_answer,
504 "pca$n" => $problem->num_correct,
505 "pia$n" => $problem->num_incorrect,
506
507 );
359} 508}
360 509
3611; 5101;
Legend:
Removed from v.388  
changed lines
  Added in v.389
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9