Parent Directory
| 
Revision Log
Finished debugging. This might be somewhere near working order. The API won't change from now on, so go ahead and start using it. -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::DB::WW; 7 8 use strict; 9 use warnings; 10 use Carp; 11 use WeBWorK::Set; 12 use WeBWorK::Problem; 13 14 use constant LOGIN_PREFIX => "login<>"; 15 use constant SET_PREFIX => "set<>"; 16 use constant MAX_PSVN_GENERATION_ATTEMPTS => 200; 17 18 # there should be a `use' line for each database type 19 use WeBWorK::DB::GDBM; 20 21 # new($invocant, $courseEnv) 22 # $invocant - implicitly set by caller 23 # $courseEnv - an instance of CourseEnvironment 24 sub new($$) { 25 my $invocant = shift; 26 my $class = ref($invocant) || $invocant; 27 my $courseEnv = shift; 28 my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{wwdb_type}); 29 my $self = { 30 webwork_file => $courseEnv->{dbInfo}->{wwdb_file}, 31 psvn_digits => $courseEnv->{dbInfo}->{psvn_digits}, 32 }; 33 $self->{webwork_db} = $dbModule->new($self->{webwork_file}); 34 bless $self, $class; 35 return $self; 36 } 37 38 sub fullyQualifiedPackageName($) { 39 my $n = shift; 40 my $package = __PACKAGE__; 41 $package =~ s/([^:]*)$/$n/; 42 return $package; 43 } 44 45 # ----- 46 47 sub 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 69 # getSets($userID) - returns a list of sets in the current database for the 70 # specified user 71 # $userID - the user ID (a.k.a. login name) of the user to get sets for 72 sub getSets($$) { 73 my $self = shift; 74 my $userID = shift; 75 return unless $self->{webwork_db}->connect("ro"); 76 my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 77 $self->{webwork_db}->disconnect; 78 return unless defined $result; 79 my %record = decode($result); 80 return keys %record; 81 } 82 83 # ----- 84 85 # getSet($userID, $setID) - returns a WeBWorK::Set object containing data 86 # from the specified set. 87 # $userID - the user ID (a.k.a. login name) of the set to retrieve 88 # $setID - the ID (a.k.a. name) of the set to retrieve 89 sub getSet($$$) { 90 my $self = shift; 91 my $userID = shift; 92 my $setID = shift; 93 my $PSVN = $self->getPSVN($userID, $setID); 94 return unless $PSVN; 95 return hash2set($self->fetchRecord($PSVN)); 96 } 97 98 # setSet($set) - if a set with the same ID for the specified user 99 # exists, it is replaced. If not, a new set is added. 100 # returns true on success, undef on failure. 101 # $set - a WeBWorK::Set object containing the set data 102 sub setSet($$) { 103 my $self = shift; 104 my $set = shift; 105 my $PSVN = $self->getPSVN($set->login_id, $set->id); 106 my %record = ( 107 $PSVN ? $self->fetchRecord($PSVN) : (), 108 set2hash($set), 109 ); 110 $PSVN = $self->setPSVN($set->login_id, $set->id) unless ($PSVN); 111 return $self->storeRecord($PSVN, %record); 112 } 113 114 # deleteSet($userID, $setID) - removes the set with the specified userID and 115 # setID. Also removes all problems in set. 116 # Returns true on success, undef on failure. 117 # $userID - the user ID (a.k.a. login name) of the set to delete 118 # $setID - the ID (a.k.a. name) of the set to delete 119 sub deleteSet($$$) { 120 my $self = shift; 121 my $userID = shift; 122 my $setID = shift; 123 my $PSVN = $self->getPSVN($userID, $setID); 124 $self->{webwork_db}->connect("rw"); 125 delete $self->{webwork_db}->hashRef->{$PSVN}; 126 $self->{webwork_db}->disconnect; 127 $self->deletePSVN($userID, $setID); 128 return 1; 129 } 130 131 # ----- 132 133 # getSetDefaults($setID) - returns a WeBWorK::Set object containing the default 134 # values for a particular set. (See NOTE) 135 # setID - id of set to fetch 136 137 # setSetDefaults($set) - Replace set defaults with the given set. (See NOTE) 138 # $set - a WeBWorK::Set object containing set defaults 139 140 # deleteSetDefaults($setID) - Remove set defaults with the given ID. (See NOTE) 141 # $setID - the ID of the set defaults to delete 142 143 # ----- 144 145 # getProblems($userID, $setID) - returns a list of problem IDs in the 146 # specified set for the specified user. 147 # $userID - the user ID of the user to get problems for 148 # $setID - the set ID to get problems from 149 sub getProblems($$$) { 150 my $self = shift; 151 my $userID = shift; 152 my $setID = shift; 153 my $PSVN = $self->getPSVN($userID, $setID); 154 my %record = $self->fetchRecord($PSVN); 155 return unless %record; 156 my @result; 157 my $i = 1; 158 while (exists $record{"pse".$i}) { 159 push @result, $i++; 160 } 161 return @result; 162 } 163 164 # ----- 165 166 # getProblem($userID, $setID, $problemNumber) - returns a WeBWorK::Problem 167 # object containing the problem 168 # requested 169 # $userID - the user for which to retrieve the problem 170 # $setID - the set from which to retrieve the problem 171 # $problemNumber - the number of the problem to retrieve 172 sub getProblem($$$$) { 173 my $self = shift; 174 my $userID = shift; 175 my $setID = shift; 176 my $problemNumber = shift; 177 my $PSVN = $self->getPSVN($userID, $setID); 178 return unless $PSVN; 179 return hash2problem($problemNumber, $self->fetchRecord($PSVN)); 180 } 181 182 # setProblem($problem) - if a problem with the same ID for the specified user 183 # exists, it is replaced. If not, a new problem is added. 184 # returns true on success, undef on failure. 185 # $problem - a WeBWorK::Problem object containing the object data 186 sub setProblem($$) { 187 my $self = shift; 188 my $problem = shift; 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; 192 my %record = ( 193 $self->fetchRecord($PSVN), 194 problem2hash($problem), 195 ); 196 return $self->storeRecord($PSVN, %record); 197 } 198 199 # deleteProblem($userID, $setID, $problemNumber) - removes a problem with the 200 # specified parameters. 201 # $userID - the user ID of the problem to delete 202 # $setID - the ID of the problem's set 203 # $problemNumber - the problem number of the problem to delete 204 sub deleteProblem($$$$) { 205 my $self = shift; 206 my $userID = shift; 207 my $setID = shift; 208 my $n = shift; 209 my $PSVN = $self->getPSVN($userID, $setID); 210 my %record = $self->fetchRecord($PSVN); 211 return unless %record; 212 delete $record{"pfn$n"} if exists $record{"pfn$n"}; 213 delete $record{"pva$n"} if exists $record{"pva$n"}; 214 delete $record{"pmia$n"} if exists $record{"pmia$n"}; 215 delete $record{"pse$n"} if exists $record{"pse$n"}; 216 delete $record{"pst$n"} if exists $record{"pst$n"}; 217 delete $record{"pat$n"} if exists $record{"pat$n"}; 218 delete $record{"pan$n"} if exists $record{"pan$n"}; 219 delete $record{"pca$n"} if exists $record{"pca$n"}; 220 delete $record{"pia$n"} if exists $record{"pia$n"}; 221 return $self->storeRecord($PSVN, %record); 222 } 223 224 # ----- 225 226 # getProblemDefaults($setID, $problemNumber) - Returns a WeBWorK::Problem object 227 # containing the default values for 228 # a particular problem. (See NOTE) 229 # $setID - set id of problem to retrieve 230 # $problemNumber - problem number of problem to retrieve 231 232 # setProblemDefaults($problem) - Replace or add problem defaults with the given 233 # problem. (See NOTE) 234 # $problem - a WeBWorK::Problem object containing problem defaults 235 236 # deleteProblemDefaults($setID, $problemNumber) - remove problem defaults with 237 # the given set and problem ID. 238 # (See NOTE) 239 # $setID - the set ID of the problem defaults to delete 240 # $problemNumber - the problem number of the problem defaults to delete 241 242 # ----- 243 244 # getPSVNs($userID) - get a list of PSVNs for a user 245 # $userID - the user 246 sub 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 259 # getPSVN($userID, $setID) - look up a PSVN given a user ID and set ID (PSVN 260 # stands for Problem Set Version Number and 261 # uniquely identifies a user's version of a set.) 262 # $userID - the user ID to lookup 263 # $serID - the set ID to lookup 264 sub getPSVN($$$) { 265 my $self = shift; 266 my $userID = shift; 267 my $setID = shift; 268 return unless $self->{webwork_db}->connect("ro"); 269 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 270 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID}; 271 $self->{webwork_db}->disconnect; 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; 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 } 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 302 sub 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 341 sub 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; 360 } 361 362 # ----- 363 364 # fetchRecord($PSVN) - retrieve the record associated with the given PSVN 365 # $PSVN - problem set version number 366 sub fetchRecord($$) { 367 my $self = shift; 368 my $PSVN = shift; 369 return unless $self->{webwork_db}->connect("ro"); 370 my $result = $self->{webwork_db}->hashRef->{$PSVN}; 371 $self->{webwork_db}->disconnect; 372 return decode($result); 373 } 374 375 # storeRecord($PSVN, %record) - store the given record with the PSVN as a key 376 # $PSVN - problem set version number 377 # %record - the record to insert 378 sub storeRecord($$%) { 379 my $self = shift; 380 my $PSVN = shift; 381 my %record = @_; 382 $self->{webwork_db}->connect("rw"); 383 $self->{webwork_db}->hashRef->{$PSVN} = encode(%record); 384 $self->{webwork_db}->disconnect; 385 return 1; 386 } 387 388 # ----- 389 390 # decode($string) - decodes a quasi-URL-encoded hash from a hash-based 391 # webwork database. unescapes \& and \= in VALUES ONLY. 392 # $string - string to decode 393 sub decode($) { 394 my $string = shift; 395 return unless defined $string and $string; 396 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 397 $hash{$_} =~ s/\\(.)/$1/ foreach (keys %hash); # unescape anything 398 return %hash; 399 } 400 401 # encode(%hash) - encodes a hash as a quasi-URL-encoded string for insertion 402 # into a hash-based webwork database. Escapes & and = in 403 # VALUES ONLY. 404 # %hash - hash to encode 405 sub encode(%) { 406 my %hash = @_; 407 my $string; 408 foreach (keys %hash) { 409 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 410 $hash{$_} =~ s/(=|&)/\\$1/; # escape & and = 411 $string .= "$_=$hash{$_}&"; 412 } 413 chop $string if $string; # remove final '&' from string for old code :p 414 return $string; 415 } 416 417 # ----- 418 419 # hash2set(%hash) - places selected fields from a webwork database record 420 # in a WeBWorK::Set object, which is then returned. 421 # %hash - a hash representing a database record 422 sub hash2set(%) { 423 my %hash = @_; 424 my $set = WeBWorK::Set->new; 425 $set->id ( $hash{stnm} ) if defined $hash{stnm}; 426 $set->login_id ( $hash{stlg} ) if defined $hash{stlg}; 427 $set->set_header ( $hash{shfn} ) if defined $hash{shfn}; 428 $set->problem_header ( $hash{phfn} ) if defined $hash{phfn}; 429 $set->open_date ( $hash{opdt} ) if defined $hash{opdt}; 430 $set->due_date ( $hash{dudt} ) if defined $hash{dudt}; 431 $set->answer_date ( $hash{andt} ) if defined $hash{andt}; 432 return $set; 433 } 434 435 # set2hash($set) - unpacks a WeBWorK::Set object and returns PART of a hash 436 # suitable for storage in the webwork database. 437 # $set - a WeBWorK::Set object. 438 sub set2hash($) { 439 my $set = shift; 440 return ( 441 stnm => $set->id, 442 stlg => $set->login_id, 443 shfn => $set->set_header, 444 phfn => $set->problem_header, 445 opdt => $set->open_date, 446 dudt => $set->due_date, 447 andt => $set->answer_date, 448 ); 449 } 450 451 # hash@problem($n, %hash) - places selected fields from a webwork 452 # database record in a WeBWorK::Problem 453 # object, which is then returned. 454 # $n - the problem number to extract 455 # %hash - a hash representing a database record 456 sub hash2problem($%) { 457 my $n = shift; 458 my %hash = @_; 459 my $problem = WeBWorK::Problem->new(id => $n); 460 $problem->set_id ( $hash{stnm} ) if defined $hash{stnm}; 461 $problem->login_id ( $hash{stlg} ) if defined $hash{stlg}; 462 $problem->source_file ( $hash{"pfn$n"} ) if defined $hash{"pfn$n"}; 463 $problem->value ( $hash{"pva$n"} ) if defined $hash{"pva$n"}; 464 $problem->max_attempts ( $hash{"pmia$n"}) if defined $hash{"pmia$n"}; 465 $problem->problem_seed ( $hash{"pse$n"} ) if defined $hash{"pse$n"}; 466 $problem->status ( $hash{"pst$n"} ) if defined $hash{"pst$n"}; 467 $problem->attempted ( $hash{"pat$n"} ) if defined $hash{"pat$n"}; 468 $problem->last_answer ( $hash{"pan$n"} ) if defined $hash{"pan$n"}; 469 $problem->num_correct ( $hash{"pca$n"} ) if defined $hash{"pca$n"}; 470 $problem->num_incorrect ( $hash{"pia$n"} ) if defined $hash{"pia$n"}; 471 return $problem; 472 } 473 474 # problem2hash($problem) - unpacks a WeBWorK::Problem object and returns PART 475 # of a hash suitable for storage in the webwork 476 # database. 477 # $problem - a WeBWorK::Problem object 478 sub problem2hash($) { 479 my $problem = shift; 480 my $n = $problem->id; 481 # my %hash; 482 # $hash{stnm} = $problem->set_id if defined $problem->set_id; 483 # $hash{stlg} = $problem->login_id if defined $problem->login_id; 484 # $hash{"pfn$n"} = $problem->source_file if defined $problem->source_file; 485 # $hash{"pva$n"} = $problem->value if defined $problem->value; 486 # $hash{"pmia$n"}= $problem->max_attempts if defined $problem->max_attempts; 487 # $hash{"pse$n"} = $problem->problem_seed if defined $problem->problem_seed; 488 # $hash{"pst$n"} = $problem->status if defined $problem->status; 489 # $hash{"pat$n"} = $problem->attempted if defined $problem->attempted; 490 # $hash{"pan$n"} = $problem->last_answer if defined $problem->last_answer; 491 # $hash{"pca$n"} = $problem->num_correct if defined $problem->num_correct; 492 # $hash{"pia$n"} = $problem->num_incorrect if defined $problem->num_incorrect; 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 ); 508 } 509 510 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |