Parent Directory
| 
Revision Log
fixed a small bug in the prototype of deletePSVN(). -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::DB::WW; 7 8 =head1 NAME 9 10 WeBWorK::DB::WW - interface with the WeBWorK problem set database. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use Carp; 17 use WeBWorK::Problem; 18 use WeBWorK::Set; 19 use WeBWorK::Utils qw(dbDecode dbEncode); 20 21 use constant LOGIN_PREFIX => "login<>"; 22 use constant SET_PREFIX => "set<>"; 23 use constant MAX_PSVN_GENERATION_ATTEMPTS => 200; 24 25 # there should be a `use' line for each database type 26 use WeBWorK::DB::GDBM; 27 28 # new($invocant, $courseEnv) 29 # $invocant - implicitly set by caller 30 # $courseEnv - an instance of CourseEnvironment 31 sub new($$) { 32 my $invocant = shift; 33 my $class = ref($invocant) || $invocant; 34 my $courseEnv = shift; 35 my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{wwdb_type}); 36 my $self = { 37 webwork_file => $courseEnv->{dbInfo}->{wwdb_file}, 38 psvn_digits => $courseEnv->{dbInfo}->{psvn_digits}, 39 }; 40 $self->{webwork_db} = $dbModule->new($self->{webwork_file}); 41 bless $self, $class; 42 return $self; 43 } 44 45 sub fullyQualifiedPackageName($) { 46 my $n = shift; 47 my $package = __PACKAGE__; 48 $package =~ s/([^:]*)$/$n/; 49 return $package; 50 } 51 52 # ----- 53 54 #sub fixMyMistakes($) { # *** 55 # my $self = shift; 56 # my $userID = "practice1"; 57 # my $setID = "dummy"; 58 # my $PSVN = 95540; 59 # $self->{webwork_db}->connect("rw"); 60 # delete $self->{webwork_db}->hashRef->{$PSVN}; 61 # my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 62 # my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID}; 63 # my %sets = dbDecode($setsForUser); # sets built for user $userID 64 # my %users = dbDecode($usersForSet); # users for which set $setID has been built 65 # delete $sets{$setID}; 66 # delete $users{$userID}; 67 # $setsForUser = dbEncode(%sets); 68 # $usersForSet = dbEncode(%users); 69 # $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser; 70 # $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet; 71 # $self->{webwork_db}->disconnect; 72 #} 73 74 # ----- 75 76 # getSets($userID) - returns a list of SetIDs in the current database for the 77 # specified user 78 # $userID - the user ID (a.k.a. login name) of the user to get sets for 79 sub getSets($$) { 80 my $self = shift; 81 my $userID = shift; 82 return unless $self->{webwork_db}->connect("ro"); 83 my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 84 $self->{webwork_db}->disconnect; 85 return unless defined $result; 86 my %record = dbDecode($result); 87 return keys %record; 88 } 89 90 # ----- 91 92 # getSet($userID, $setID) - returns a WeBWorK::Set object containing data 93 # from the specified set. 94 # $userID - the user ID (a.k.a. login name) of the set to retrieve 95 # $setID - the ID (a.k.a. name) of the set to retrieve 96 sub getSet($$$) { 97 my $self = shift; 98 my $userID = shift; 99 my $setID = shift; 100 my $PSVN = $self->getPSVN($userID, $setID); 101 return unless $PSVN; 102 return hash2set($self->fetchRecord($PSVN)); 103 } 104 105 # setSet($set) - if a set with the same ID for the specified user 106 # exists, it is replaced. If not, a new set is added. 107 # returns true on success, undef on failure. 108 # $set - a WeBWorK::Set object containing the set data 109 sub setSet($$) { 110 my $self = shift; 111 my $set = shift; 112 my $PSVN = $self->getPSVN($set->login_id, $set->id); 113 my %record = ( 114 $PSVN ? $self->fetchRecord($PSVN) : (), 115 set2hash($set), 116 ); 117 $PSVN = $self->setPSVN($set->login_id, $set->id) unless ($PSVN); 118 return $self->storeRecord($PSVN, %record); 119 } 120 121 # deleteSet($userID, $setID) - removes the set with the specified userID and 122 # setID. Also removes all problems in set. 123 # Returns true on success, undef on failure. 124 # $userID - the user ID (a.k.a. login name) of the set to delete 125 # $setID - the ID (a.k.a. name) of the set to delete 126 sub deleteSet($$$) { 127 my $self = shift; 128 my $userID = shift; 129 my $setID = shift; 130 my $PSVN = $self->getPSVN($userID, $setID); 131 $self->{webwork_db}->connect("rw"); 132 delete $self->{webwork_db}->hashRef->{$PSVN}; 133 $self->{webwork_db}->disconnect; 134 $self->deletePSVN($userID, $setID); 135 return 1; 136 } 137 138 # ----- 139 140 # getSetDefaults($setID) - returns a WeBWorK::Set object containing the default 141 # values for a particular set. (See NOTE) 142 # setID - id of set to fetch 143 144 # setSetDefaults($set) - Replace set defaults with the given set. (See NOTE) 145 # $set - a WeBWorK::Set object containing set defaults 146 147 # deleteSetDefaults($setID) - Remove set defaults with the given ID. (See NOTE) 148 # $setID - the ID of the set defaults to delete 149 150 # ----- 151 152 # getProblems($userID, $setID) - returns a list of problem IDs in the 153 # specified set for the specified user. 154 # $userID - the user ID of the user to get problems for 155 # $setID - the set ID to get problems from 156 sub getProblems($$$) { 157 my $self = shift; 158 my $userID = shift; 159 my $setID = shift; 160 my $PSVN = $self->getPSVN($userID, $setID); 161 my %record = $self->fetchRecord($PSVN); 162 return unless %record; 163 my @result; 164 my $i = 1; 165 while (exists $record{"pse".$i}) { 166 push @result, $i++; 167 } 168 return @result; 169 } 170 171 # ----- 172 173 # getProblem($userID, $setID, $problemNumber) - returns a WeBWorK::Problem 174 # object containing the problem 175 # requested 176 # $userID - the user for which to retrieve the problem 177 # $setID - the set from which to retrieve the problem 178 # $problemNumber - the number of the problem to retrieve 179 sub getProblem($$$$) { 180 my $self = shift; 181 my $userID = shift; 182 my $setID = shift; 183 my $problemNumber = shift; 184 my $PSVN = $self->getPSVN($userID, $setID); 185 return unless $PSVN; 186 my $problem = hash2problem($problemNumber, $self->fetchRecord($PSVN)); 187 return $problem->source_file ? $problem : undef; 188 } 189 190 # setProblem($problem) - if a problem with the same ID for the specified user 191 # exists, it is replaced. If not, a new problem is added. 192 # returns true on success, undef on failure. 193 # $problem - a WeBWorK::Problem object containing the object data 194 sub setProblem($$) { 195 my $self = shift; 196 my $problem = shift; 197 my $PSVN = $self->getPSVN($problem->login_id, $problem->set_id); 198 die "failed to add problem: set ", $problem->set_id, " does not exist." 199 unless $PSVN; 200 my %record = ( 201 $self->fetchRecord($PSVN), 202 problem2hash($problem), 203 ); 204 return $self->storeRecord($PSVN, %record); 205 } 206 207 # deleteProblem($userID, $setID, $problemNumber) - removes a problem with the 208 # specified parameters. 209 # $userID - the user ID of the problem to delete 210 # $setID - the ID of the problem's set 211 # $problemNumber - the problem number of the problem to delete 212 sub deleteProblem($$$$) { 213 my $self = shift; 214 my $userID = shift; 215 my $setID = shift; 216 my $n = shift; 217 my $PSVN = $self->getPSVN($userID, $setID); 218 my %record = $self->fetchRecord($PSVN); 219 return unless %record; 220 delete $record{"pfn$n"} if exists $record{"pfn$n"}; 221 delete $record{"pva$n"} if exists $record{"pva$n"}; 222 delete $record{"pmia$n"} if exists $record{"pmia$n"}; 223 delete $record{"pse$n"} if exists $record{"pse$n"}; 224 delete $record{"pst$n"} if exists $record{"pst$n"}; 225 delete $record{"pat$n"} if exists $record{"pat$n"}; 226 delete $record{"pan$n"} if exists $record{"pan$n"}; 227 delete $record{"pca$n"} if exists $record{"pca$n"}; 228 delete $record{"pia$n"} if exists $record{"pia$n"}; 229 return $self->storeRecord($PSVN, %record); 230 } 231 232 # ----- 233 234 # getProblemDefaults($setID, $problemNumber) - Returns a WeBWorK::Problem object 235 # containing the default values for 236 # a particular problem. (See NOTE) 237 # $setID - set id of problem to retrieve 238 # $problemNumber - problem number of problem to retrieve 239 240 # setProblemDefaults($problem) - Replace or add problem defaults with the given 241 # problem. (See NOTE) 242 # $problem - a WeBWorK::Problem object containing problem defaults 243 244 # deleteProblemDefaults($setID, $problemNumber) - remove problem defaults with 245 # the given set and problem ID. 246 # (See NOTE) 247 # $setID - the set ID of the problem defaults to delete 248 # $problemNumber - the problem number of the problem defaults to delete 249 250 # ----- 251 252 # getPSVNs($userID) - get a list of PSVNs for a user 253 # $userID - the user 254 sub getPSVNs($$) { 255 my $self = shift; 256 my $userID = shift; 257 return unless $self->{webwork_db}->connect("ro"); 258 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 259 $self->{webwork_db}->disconnect; 260 return unless defined $setsForUser; 261 my %sets = dbDecode($setsForUser); 262 return values %sets; 263 } 264 265 # ----- 266 267 # getPSVN($userID, $setID) - look up a PSVN given a user ID and set ID (PSVN 268 # stands for Problem Set Version Number and 269 # uniquely identifies a user's version of a set.) 270 # $userID - the user ID to lookup 271 # $serID - the set ID to lookup 272 sub getPSVN($$$) { 273 my $self = shift; 274 my $userID = shift; 275 my $setID = shift; 276 return unless $self->{webwork_db}->connect("ro"); 277 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 278 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID}; 279 $self->{webwork_db}->disconnect; 280 # * if setsForUser is non-empty, then there are sets built for 281 # this user. 282 # * if usersForSet is non-empty, then this set has been built for 283 # at least one user. 284 # * if either are empty, it is guaranteed that this set has not 285 # been built for this user. 286 return unless defined $setsForUser and defined $usersForSet; 287 return unless $setsForUser and $usersForSet; 288 my %sets = dbDecode($setsForUser); 289 my %users = dbDecode($usersForSet); 290 # more sanity checks: the following should never happen. 291 # if they do, run screaming for the hills. 292 if (defined $sets{$setID} and not defined $users{$userID}) { 293 die "PSVN indexes inconsistent: set exists in user index ", 294 "but user does not exist in set index."; 295 } elsif (not defined $sets{$setID} and defined $users{$userID}) { 296 die "PSVN indexes inconsistent: user exists in set index ", 297 "but set does not exist in user index."; 298 } elsif ($sets{$setID} != $users{$userID}) { 299 die "PSVN indexes inconsistent: user index and set index ", 300 "gave different PSVN values."; 301 } 302 return $sets{$setID}; 303 } 304 305 # setPSVN($userID, $setID) - adds a new PSVN to the PSVN indexesfor the given 306 # user ID and set ID, if it doesn't exist. Returns 307 # the PSVN. 308 # $userID - the user ID to use 309 # $serID - the set ID to use 310 sub setPSVN($$$) { 311 my $self = shift; 312 my $userID = shift; 313 my $setID = shift; 314 my $PSVN = $self->getPSVN($userID, $setID); 315 unless ($PSVN) { 316 # yeah, create a new PSVN here 317 my $min_psvn = 10**($self->{psvn_digits} - 1); 318 my $max_psvn = 10**$self->{psvn_digits} - 1; 319 my $attempts = 0; 320 do { 321 if (++$attempts > MAX_PSVN_GENERATION_ATTEMPTS) { 322 die "failed to find an unused PSVN."; 323 } 324 $PSVN = int(rand($max_psvn-$min_psvn+1)) + $min_psvn; 325 } while ($self->fetchRecord($PSVN)); 326 $self->{webwork_db}->connect("rw"); # open "rw" to lock 327 # get current PSVN indexes 328 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 329 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID}; 330 my %sets = dbDecode($setsForUser); # sets built for user $userID 331 my %users = dbDecode($usersForSet); # users for which set $setID has been built 332 # insert new PSVN into each hash 333 $sets{$setID} = $PSVN; 334 $users{$userID} = $PSVN; 335 # re-encode the hashes 336 $setsForUser = dbEncode(%sets); 337 $usersForSet = dbEncode(%users); 338 # store 'em in the database 339 $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser; 340 $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet; 341 $self->{webwork_db}->disconnect; 342 }; 343 return $PSVN; 344 } 345 346 # deletePSVN($userID, $setID) - remove an entry from the PSVN indexes. 347 # $userID - the user to remove 348 # $setID - the set to remove 349 sub deletePSVN($$$) { 350 my $self = shift; 351 my $userID = shift; 352 my $setID = shift; 353 my $PSVN = $self->getPSVN($userID, $setID); 354 return unless $PSVN; 355 $self->{webwork_db}->connect("rw"); # open "rw" to lock 356 my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID}; 357 my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID}; 358 my %sets = dbDecode($setsForUser); # sets built for user $userID 359 my %users = dbDecode($usersForSet); # users for which set $setID has been built 360 delete $sets{$setID}; 361 delete $users{$userID}; 362 $setsForUser = dbEncode(%sets); 363 $usersForSet = dbEncode(%users); 364 $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser; 365 $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet; 366 $self->{webwork_db}->disconnect; 367 return 1; 368 } 369 370 # ----- 371 372 # fetchRecord($PSVN) - retrieve the record associated with the given PSVN 373 # $PSVN - problem set version number 374 sub fetchRecord($$) { 375 my $self = shift; 376 my $PSVN = shift; 377 return unless $self->{webwork_db}->connect("ro"); 378 my $result = $self->{webwork_db}->hashRef->{$PSVN}; 379 $self->{webwork_db}->disconnect; 380 return dbDecode($result); 381 } 382 383 # storeRecord($PSVN, %record) - store the given record with the PSVN as a key 384 # $PSVN - problem set version number 385 # %record - the record to insert 386 sub storeRecord($$%) { 387 my $self = shift; 388 my $PSVN = shift; 389 my %record = @_; 390 $self->{webwork_db}->connect("rw"); 391 $self->{webwork_db}->hashRef->{$PSVN} = dbEncode(%record); 392 $self->{webwork_db}->disconnect; 393 return 1; 394 } 395 396 # ----- 397 398 # hash2set(%hash) - places selected fields from a webwork database record 399 # in a WeBWorK::Set object, which is then returned. 400 # %hash - a hash representing a database record 401 sub hash2set(%) { 402 my %hash = @_; 403 my $set = WeBWorK::Set->new; 404 $set->id ( $hash{stnm} ) if defined $hash{stnm}; 405 $set->login_id ( $hash{stlg} ) if defined $hash{stlg}; 406 $set->set_header ( $hash{shfn} ) if defined $hash{shfn}; 407 $set->problem_header ( $hash{phfn} ) if defined $hash{phfn}; 408 $set->open_date ( $hash{opdt} ) if defined $hash{opdt}; 409 $set->due_date ( $hash{dudt} ) if defined $hash{dudt}; 410 $set->answer_date ( $hash{andt} ) if defined $hash{andt}; 411 return $set; 412 } 413 414 # set2hash($set) - unpacks a WeBWorK::Set object and returns PART of a hash 415 # suitable for storage in the webwork database. 416 # $set - a WeBWorK::Set object. 417 sub set2hash($) { 418 my $set = shift; 419 return ( 420 stnm => $set->id, 421 stlg => $set->login_id, 422 shfn => $set->set_header, 423 phfn => $set->problem_header, 424 opdt => $set->open_date, 425 dudt => $set->due_date, 426 andt => $set->answer_date, 427 ); 428 } 429 430 # hash@problem($n, %hash) - places selected fields from a webwork 431 # database record in a WeBWorK::Problem 432 # object, which is then returned. 433 # $n - the problem number to extract 434 # %hash - a hash representing a database record 435 sub hash2problem($%) { 436 my $n = shift; 437 my %hash = @_; 438 my $problem = WeBWorK::Problem->new(id => $n); 439 $problem->set_id ( $hash{stnm} ) if defined $hash{stnm}; 440 $problem->login_id ( $hash{stlg} ) if defined $hash{stlg}; 441 $problem->source_file ( $hash{"pfn$n"} ) if defined $hash{"pfn$n"}; 442 $problem->value ( $hash{"pva$n"} ) if defined $hash{"pva$n"}; 443 $problem->max_attempts ( $hash{"pmia$n"}) if defined $hash{"pmia$n"}; 444 $problem->problem_seed ( $hash{"pse$n"} ) if defined $hash{"pse$n"}; 445 $problem->status ( $hash{"pst$n"} ) if defined $hash{"pst$n"}; 446 $problem->attempted ( $hash{"pat$n"} ) if defined $hash{"pat$n"}; 447 $problem->last_answer ( $hash{"pan$n"} ) if defined $hash{"pan$n"}; 448 $problem->num_correct ( $hash{"pca$n"} ) if defined $hash{"pca$n"}; 449 $problem->num_incorrect ( $hash{"pia$n"} ) if defined $hash{"pia$n"}; 450 return $problem; 451 } 452 453 # problem2hash($problem) - unpacks a WeBWorK::Problem object and returns PART 454 # of a hash suitable for storage in the webwork 455 # database. 456 # $problem - a WeBWorK::Problem object 457 sub problem2hash($) { 458 my $problem = shift; 459 my $n = $problem->id; 460 # my %hash; 461 # $hash{stnm} = $problem->set_id if defined $problem->set_id; 462 # $hash{stlg} = $problem->login_id if defined $problem->login_id; 463 # $hash{"pfn$n"} = $problem->source_file if defined $problem->source_file; 464 # $hash{"pva$n"} = $problem->value if defined $problem->value; 465 # $hash{"pmia$n"}= $problem->max_attempts if defined $problem->max_attempts; 466 # $hash{"pse$n"} = $problem->problem_seed if defined $problem->problem_seed; 467 # $hash{"pst$n"} = $problem->status if defined $problem->status; 468 # $hash{"pat$n"} = $problem->attempted if defined $problem->attempted; 469 # $hash{"pan$n"} = $problem->last_answer if defined $problem->last_answer; 470 # $hash{"pca$n"} = $problem->num_correct if defined $problem->num_correct; 471 # $hash{"pia$n"} = $problem->num_incorrect if defined $problem->num_incorrect; 472 # return %hash; 473 return ( 474 stnm => $problem->set_id, 475 stlg => $problem->login_id, 476 "pfn$n" => $problem->source_file, 477 "pva$n" => $problem->value, 478 "pmia$n" => $problem->max_attempts, 479 "pse$n" => $problem->problem_seed, 480 "pst$n" => $problem->status, 481 "pat$n" => $problem->attempted, 482 "pan$n" => $problem->last_answer, 483 "pca$n" => $problem->num_correct, 484 "pia$n" => $problem->num_incorrect, 485 486 ); 487 } 488 489 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |