Parent Directory
| 
Revision Log
additional comments in source code
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/DB/Schema/WW1Hash.pm,v 1.21 2003/12/12 20:23:27 sh002i Exp $ 5 # 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 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. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::DB::Schema::WW1Hash; 18 use base qw(WeBWorK::DB::Schema); 19 20 =head1 NAME 21 22 WeBWorK::DB::Schema::WW1Hash - support access to the set_user and problem_user 23 tables with a WWDBv1 hash-style backend. 24 25 =cut 26 27 use strict; 28 use warnings; 29 use Carp; 30 use WeBWorK::DB::Utils qw(hash2string string2hash); 31 use WeBWorK::Timing; 32 33 use constant TABLES => qw(set_user problem_user); 34 use constant STYLE => "hash"; 35 36 use constant LOGIN_PREFIX => "login<>"; 37 use constant SET_PREFIX => "set<>"; 38 use constant MAX_PSVN_GENERATION_ATTEMPTS => 200; 39 40 ################################################################################ 41 # table access functions 42 ################################################################################ 43 44 =head1 ADDITIONAL METHODS 45 46 =over 47 48 =cut 49 50 sub count { 51 my ($self, @keyparts) = @_; 52 my ($matchUserID, $matchSetID) = @keyparts[0 .. 1]; 53 54 # connect 55 return unless $self->{driver}->connect("ro"); 56 57 # get a list of PSVNs that match the userID and setID given 58 my @matchingPSVNs; 59 if (defined $matchUserID and not defined $matchSetID) { 60 @matchingPSVNs = $self->getPSVNsForUser($matchUserID); 61 } elsif (defined $matchSetID and not defined $matchUserID) { 62 @matchingPSVNs = $self->getPSVNsForSet($matchSetID); 63 } elsif (defined $matchUserID and defined $matchSetID) { 64 @matchingPSVNs = $self->getPSVN($matchUserID, $matchSetID); 65 } else { 66 # we need all PSVNs, so we have to do this ourselves. 67 @matchingPSVNs = 68 grep { m/^\d+$/ } 69 keys %{ $self->{driver}->hash() }; 70 } 71 72 my $result = 0; 73 if ($self->{table} eq "set_user") { 74 $result = @matchingPSVNs; 75 } elsif ($self->{table} eq "problem_user") { 76 my $matchProblemID = $keyparts[2]; 77 foreach (@matchingPSVNs) { 78 my $string = $self->fetchString($_); 79 next unless defined $string; 80 my %hash = string2hash($string); 81 my $userID = $hash{stlg}; 82 my $setID = $hash{stnm}; 83 if (defined $matchProblemID) { 84 # we only want one 85 if (exists $hash{"pfn$matchProblemID"}) { 86 $result++; 87 } 88 } else { 89 my (undef, undef, @problemIDs) = $self->hash2IDs(%hash); 90 $result += @problemIDs; 91 } 92 } 93 } 94 95 # disconnect 96 $self->{driver}->disconnect(); 97 98 return $result; 99 } 100 101 sub list { 102 my ($self, @keyparts) = @_; 103 my ($matchUserID, $matchSetID) = @keyparts[0 .. 1]; 104 105 # connect 106 return unless $self->{driver}->connect("ro"); 107 108 # get a list of PSVNs that match the userID and setID given 109 my @matchingPSVNs; 110 if (defined $matchUserID and not defined $matchSetID) { 111 @matchingPSVNs = $self->getPSVNsForUser($matchUserID); 112 } elsif (defined $matchSetID and not defined $matchUserID) { 113 @matchingPSVNs = $self->getPSVNsForSet($matchSetID); 114 } elsif (defined $matchUserID and defined $matchSetID) { 115 @matchingPSVNs = $self->getPSVN($matchUserID, $matchSetID); 116 } else { 117 # we need all PSVNs, so we have to do this ourselves. 118 @matchingPSVNs = 119 grep { m/^\d+$/ } 120 keys %{ $self->{driver}->hash() }; 121 } 122 123 # retrieve the strings associated with those PSVNs and retrieve the 124 # desired parts of that record 125 my @result; 126 if ($self->{table} eq "set_user") { 127 foreach (@matchingPSVNs) { 128 my $string = $self->fetchString($_); 129 next unless defined $string; 130 my %hash = string2hash($string); 131 push @result, [$hash{stlg}, $hash{stnm}]; 132 } 133 } elsif ($self->{table} eq "problem_user") { 134 my $matchProblemID = $keyparts[2]; 135 foreach (@matchingPSVNs) { 136 my $string = $self->fetchString($_); 137 next unless defined $string; 138 my %hash = string2hash($string); 139 my $userID = $hash{stlg}; 140 my $setID = $hash{stnm}; 141 if (defined $matchProblemID) { 142 # we only want one 143 if (exists $hash{"pfn$matchProblemID"}) { 144 push @result, [$userID, $setID, $matchProblemID]; 145 } 146 } else { 147 my (undef, undef, @problemIDs) = $self->hash2IDs(%hash); 148 foreach my $n (@problemIDs) { 149 if (exists $hash{"pfn$n"}) { 150 push @result, [$userID, $setID, $n]; 151 } 152 } 153 } 154 } 155 } 156 157 # disconnect 158 $self->{driver}->disconnect(); 159 160 return @result; 161 } 162 163 sub exists { 164 my ($self, @keyparts) = @_; 165 my ($userID, $setID) = @keyparts[0 .. 1]; 166 167 return 0 unless $self->{driver}->connect("ro"); 168 169 # get a list of PSVNs that match the userID and setID given 170 my @matchingPSVNs; 171 if (defined $userID and not defined $setID) { 172 @matchingPSVNs = $self->getPSVNsForUser($userID); 173 } elsif (defined $setID and not defined $userID) { 174 @matchingPSVNs = $self->getPSVNsForSet($setID); 175 } elsif (defined $userID and defined $setID) { 176 @matchingPSVNs = $self->getPSVN($userID, $setID); 177 } else { 178 # we need all PSVNs, so we have to do this ourselves. 179 @matchingPSVNs = 180 grep { m/^\d+$/ } 181 keys %{ $self->{driver}->hash() }; 182 } 183 184 my $result = 0; 185 if (@matchingPSVNs) { 186 if ($self->{table} eq "set_user") { 187 # at least one set matched 188 $result = 1; 189 } elsif ($self->{table} eq "problem_user") { 190 my $problemID = $keyparts[2]; 191 if (defined $problemID) { 192 # check each set for a matching problem 193 foreach my $PSVN (@matchingPSVNs) { 194 my $string = $self->fetchString($PSVN); 195 next unless defined $string; 196 my @problemIDs = $self->string2IDs($string); 197 shift @problemIDs; # remove userID 198 shift @problemIDs; # remove setID 199 if (grep { $_ eq $problemID } @problemIDs) { 200 $result = 1; 201 last; 202 } 203 } 204 } else { 205 # we'll take ANY problem in ANY set 206 $result = 1; 207 } 208 } 209 } 210 211 $self->{driver}->disconnect(); 212 return $result; 213 } 214 215 sub add { 216 my ($self, $Record) = @_; 217 my $userID = $Record->user_id(); 218 my $setID = $Record->set_id(); 219 my $db = $self->{db}; 220 my $table = $self->{table}; 221 $table =~ m/^(.*)_user$/; 222 my $globalSchema = $db->{$1}; 223 224 return 0 unless $self->{driver}->connect("rw"); 225 226 my $PSVN = $self->getPSVN($userID, $setID); 227 228 my $result; 229 if ($self->{table} eq "set_user") { 230 $self->{driver}->disconnect(); 231 my $globalSet = $globalSchema->get($setID); 232 $self->{driver}->connect("rw"); 233 $self->copyOverrides($globalSet, $Record); 234 if (defined $PSVN) { 235 $self->{driver}->disconnect(); 236 die "($userID, $setID): UserSet exists.\n"; 237 } 238 my $PSVN = $self->setPSVN($userID, $setID); # create new psvn 239 my $string = $self->records2string($Record); # no problems 240 $self->storeString($PSVN, $string); 241 $result = 1; 242 } elsif ($self->{table} eq "problem_user") { 243 my $problemID = $Record->problem_id(); 244 $self->{driver}->disconnect(); 245 my $globalProblem = $globalSchema->get($setID, $problemID); 246 $self->{driver}->connect("rw"); 247 $self->copyOverrides($globalProblem, $Record); 248 unless (defined $PSVN) { 249 $self->{driver}->disconnect(); 250 die "($userID, $setID): UserSet not found.\n"; 251 } 252 my $string = $self->fetchString($PSVN); 253 if (defined $string) { 254 my ($Set, @Problems) = $self->string2records($string); 255 if (grep { $_->problem_id() eq $problemID } @Problems) { 256 $self->{driver}->disconnect(); 257 die "($userID, $setID, $problemID): UserProblem exists.\n" 258 } 259 push @Problems, $Record; 260 $string = $self->records2string($Set, @Problems); 261 $self->storeString($PSVN, $string); 262 $result = 1; 263 } else { 264 $result = 0; 265 } 266 } 267 268 $self->{driver}->disconnect(); 269 return $result; 270 } 271 272 sub get { 273 my ($self, @keyparts) = @_; 274 275 return ( $self->gets(\@keyparts) )[0]; 276 } 277 278 sub gets { 279 my ($self, @keypartsRefList) = @_; 280 281 my @records; 282 $self->{driver}->connect("ro"); 283 foreach my $keypartsRef (@keypartsRefList) { 284 my @keyparts = @$keypartsRef; 285 my $UserSet = $self->get1(@keyparts); 286 push @records, $UserSet; 287 } 288 $self->{driver}->disconnect(); 289 290 return @records; 291 } 292 293 =item get1(@keyparts) 294 295 Retrieves one set or problem from the database, packages it into a record 296 object, and removes values that match global defaults. Assumes that the driver 297 is already connected to the database. Used by gets(). 298 299 =cut 300 301 sub get1 { 302 my ($self, @keyparts) = @_; 303 my $db = $self->{db}; 304 my $table = $self->{table}; 305 my ($globalTable) = $table =~ m/^(.*)_user$/; 306 my $globalSchema = $db->{$globalTable}; 307 308 my $UserRecord = $self->get1NoFilter(@keyparts); 309 310 # filter values that are identical to global values 311 if (defined $UserRecord) { 312 my $GlobalRecord = $globalSchema->get1(@keyparts[1..$#keyparts]); 313 if (defined $GlobalRecord) { 314 foreach my $field ($GlobalRecord->NONKEYFIELDS) { 315 if ($UserRecord->$field eq $GlobalRecord->$field) { 316 $UserRecord->$field(undef); 317 } 318 } 319 } else { 320 warn __PACKAGE__, ": keyparts=@keyparts: $table record exists, but $globalTable record does not. returning user record unmodified. this could cause problems later."; 321 } 322 } 323 324 return $UserRecord; 325 } 326 327 =item getsNoFilter(@keypartsRefList) 328 329 Similar to gets(), but does not remove values that match global defaults. 330 331 =cut 332 333 sub getsNoFilter { 334 my ($self, @keypartsRefList) = @_; 335 336 my @records; 337 $self->{driver}->connect("ro"); 338 foreach my $keypartsRef (@keypartsRefList) { 339 my @keyparts = @$keypartsRef; 340 my $UserSet = $self->get1NoFilter(@keyparts); 341 push @records, $UserSet; 342 } 343 $self->{driver}->disconnect(); 344 345 return @records; 346 } 347 348 # helper used by get1 349 # also used by GlobalTableEmulator when it needs "real" records 350 351 =item get1NoFilter(@keyparts) 352 353 Similar to get1(), but does not remove values that match global defaults. Used 354 by getsNoFilter() and several methods in GlobalTableEmulator. 355 356 =cut 357 358 sub get1NoFilter { 359 my ($self, @keyparts) = @_; 360 361 my ($userID, $setID) = @keyparts[0 .. 1]; 362 # FIXME: move these checks up to DB 363 die "userID not specified." unless defined $userID; 364 die "setID not specified." unless defined $setID; 365 366 my $PSVN = $self->getPSVN($userID, $setID); 367 368 unless (defined $PSVN) { 369 return; 370 } 371 my $string = $self->fetchString($PSVN); 372 373 if ($self->{table} eq "set_user") { 374 my $UserSet = $self->string2set($string); 375 $UserSet->psvn($PSVN); 376 return $UserSet; 377 } elsif ($self->{table} eq "problem_user") { 378 my ($problemID) = $keyparts[2]; 379 die "problemID not specified." unless defined $problemID; 380 my $UserProblem = $self->string2problem($string, $problemID); 381 return $UserProblem; 382 } 383 } 384 385 =item getAll($userID, $setID) 386 387 Returns all problems in a given set. Only supported for the problem_user table. 388 389 =cut 390 391 sub getAll { 392 my ($self, @keyparts) = @_; 393 my $db = $self->{db}; 394 my $table = $self->{table}; 395 my ($globalTable) = $table =~ m/^(.*)_user$/; 396 my $globalSchema = $db->{$globalTable}; 397 398 croak "getAll: only supported for the problem_user table" 399 unless $table eq "problem_user"; 400 401 my @UnsortedUserProblems = $self->getAllNoFilter(@keyparts); 402 my @UnsortedGlobalProblems = $globalSchema->getAll(@keyparts[1 .. $#keyparts]); 403 404 # FIXME FIXME FIXME: Danger! This code assumes that problem IDs are NUMERIC! 405 # I don't want to fix it right now, since there is currently no way to 406 # specify a non-numeric problem ID. However, it should be fixed at some 407 # point! 408 409 my (@UserProblems, @GlobalProblems); 410 foreach my $UserProblem (@UnsortedUserProblems) { 411 @UserProblems[$UserProblem->problem_id] = $UserProblem; 412 } 413 foreach my $GlobalProblem (@UnsortedGlobalProblems) { 414 @GlobalProblems[$GlobalProblem->problem_id] = $GlobalProblem; 415 } 416 417 foreach my $problemID (0 .. $#GlobalProblems) { 418 my $GlobalProblem = $GlobalProblems[$problemID]; 419 my $UserProblem = $UserProblems[$problemID]; 420 421 next unless defined $UserProblem; 422 423 if (defined $GlobalProblem) { 424 foreach my $field ($GlobalProblem->NONKEYFIELDS) { 425 if ($UserProblem->$field eq $GlobalProblem->$field) { 426 $UserProblem->$field(undef); 427 } 428 } 429 } else { 430 warn __PACKAGE__, ": keyparts=@keyparts: $table record exists, but $globalTable record does not. returning user record unmodified. this could cause problems later."; 431 } 432 } 433 434 return @UnsortedUserProblems; 435 } 436 437 =item getAllNoFilter($userID, $setID) 438 439 Similar to getAll(), but does not remove values that match global defaults. 440 Used by getAll() and the getAll() method in GlobalTableEmulator. 441 442 =cut 443 444 sub getAllNoFilter { 445 my ($self, $userID, $setID) = @_; 446 447 croak "getAll: only supported for the problem_user table" 448 unless $self->{table} eq "problem_user"; 449 450 $self->{driver}->connect("ro"); 451 452 my $PSVN = $self->getPSVN($userID, $setID); 453 return unless defined $PSVN; 454 455 my $string = $self->fetchString($PSVN); 456 my @UserProblems = $self->string2problems($string); 457 458 $self->{driver}->disconnect; 459 460 return @UserProblems; 461 } 462 463 sub put { 464 my ($self, $Record) = @_; 465 my $userID = $Record->user_id(); 466 my $setID = $Record->set_id(); 467 my $db = $self->{db}; 468 my $table = $self->{table}; 469 $table =~ m/^(.*)_user$/; 470 my $globalSchema = $db->{$1}; 471 472 return 0 unless $self->{driver}->connect("rw"); 473 474 my $PSVN = $self->getPSVN($userID, $setID); 475 476 unless (defined $PSVN) { 477 $self->{driver}->disconnect(); 478 die "($userID, $setID): UserSet not found.\n"; 479 } 480 481 my $string = $self->fetchString($PSVN); 482 483 my $result; 484 if (defined $string) { 485 my ($Set, @Problems) = $self->string2records($string); 486 if ($self->{table} eq "set_user") { 487 $self->{driver}->disconnect(); 488 # This call makes database connections, so we 489 # have to release our control on it. 490 my $globalSet = $globalSchema->get($setID); 491 $self->{driver}->connect("rw"); 492 $self->copyOverrides($globalSet, $Record); 493 $string = $self->records2string($Record, @Problems); 494 } elsif ($self->{table} eq "problem_user") { 495 my $problemID = $Record->problem_id(); 496 $self->{driver}->disconnect(); 497 my $globalProblem = $globalSchema->get($setID, $problemID); 498 $self->{driver}->connect("rw"); 499 $self->copyOverrides($globalProblem, $Record); 500 my $found = 0; 501 foreach (@Problems) { 502 if ($_->problem_id() eq $problemID) { 503 $found = 1; 504 $_ = $Record; 505 } 506 } 507 unless ($found) { 508 $self->{driver}->disconnect(); 509 die "($userID, $setID, $problemID): UserProblem not found.\n"; 510 } 511 $string = $self->records2string($Set, @Problems); 512 } 513 $self->storeString($PSVN, $string); 514 $result = 1; 515 } else { 516 $result = 0; 517 } 518 519 $self->{driver}->disconnect(); 520 return $result; 521 } 522 523 sub delete { 524 my ($self, $userID, $setID, $problemID) = @_; 525 526 return 0 unless $self->{driver}->connect("rw"); 527 528 # get a list of PSVNs that match the userID and setID given 529 my @matchingPSVNs; 530 if (defined $userID and not defined $setID) { 531 @matchingPSVNs = $self->getPSVNsForUser($userID); 532 } elsif (defined $setID and not defined $userID) { 533 @matchingPSVNs = $self->getPSVNsForSet($setID); 534 } elsif (defined $userID and defined $setID) { 535 @matchingPSVNs = $self->getPSVN($userID, $setID); 536 } else { 537 # we need all PSVNs, so we have to do this ourselves. 538 @matchingPSVNs = 539 grep { m/^\d+$/ } 540 keys %{ $self->{driver}->hash() }; 541 } 542 543 if (@matchingPSVNs) { 544 foreach my $PSVN (@matchingPSVNs) { 545 $self->delete1($PSVN, $problemID); 546 } 547 } 548 549 $self->{driver}->disconnect(); 550 return 1; 551 } 552 553 =item delete1($PSVN, $problemID) 554 555 for the set_user table, ignore $problemID and deletes the set with the 556 matching $PSVN. for the problem_user table, deletes the problem matching 557 $problemID from the set matching $PSVN, or all problems if $problemID is not 558 defined. Assumes that the driver is already connected to the database. Used by 559 delete(). 560 561 =cut 562 563 sub delete1 { 564 my ($self, $PSVN, $problemID) = @_; 565 566 my $string = $self->fetchString($PSVN); 567 return 0 unless defined $string; 568 my ($userID, $setID) = $self->string2IDs($string); 569 570 my $result = 1; 571 if ($self->{table} eq "set_user") { 572 $self->deletePSVN($userID, $setID); 573 $self->deleteString($PSVN); 574 $result = 1; 575 } elsif ($self->{table} eq "problem_user") { 576 my ($Set, @Problems) = $self->string2records($string); 577 my $length = @Problems; 578 if (defined $problemID) { 579 @Problems = grep { not $_->problem_id() eq $problemID } @Problems; 580 } else { 581 @Problems = (); # delete all problems 582 } 583 if ($length != @Problems) { 584 # removed one, store the new version 585 $string = $self->records2string($Set, @Problems); 586 $self->storeString($PSVN, $string); 587 } 588 $result = 1; 589 } 590 591 return $result; 592 } 593 594 =back 595 596 =cut 597 598 ################################################################################ 599 # add/put override copy helper 600 ################################################################################ 601 602 sub copyOverrides { 603 my ($self, $globalRecord, $userRecord) = @_; 604 605 # This could happen if a Null schema is being used. 606 unless (defined $globalRecord and defined $userRecord) { 607 return $userRecord; 608 } 609 610 foreach my $field ($globalRecord->FIELDS) { 611 unless (defined $userRecord->$field) { 612 $userRecord->$field($globalRecord->$field); 613 } 614 } 615 616 return $userRecord; # The edit happens in place, so this is unneccesary. 617 # Nevertheless, it is common courtesy. 618 } 619 620 ################################################################################ 621 # string <-> data conversion functions 622 ################################################################################ 623 624 sub string2IDs { 625 my ($self, $string) = @_; 626 return $self->hash2IDs(string2hash($string)); 627 } 628 629 sub string2set { 630 my ($self, $string) = @_; 631 return $self->hash2set(string2hash($string)); 632 } 633 634 sub string2problem { 635 my ($self, $string, $problemID) = @_; 636 return $self->hash2problem($problemID, string2hash($string)); 637 } 638 639 sub string2problems { 640 my ($self, $string) = @_; 641 my %hash = string2hash($string); 642 my @Problems; 643 foreach my $problemID (grep { s/^pfn// } keys %hash) { 644 push @Problems, $self->hash2problem($problemID, %hash); 645 } 646 return @Problems; 647 } 648 649 sub string2records { 650 my ($self, $string) = @_; 651 my %hash = string2hash($string); 652 my @Records = $self->hash2set(%hash); 653 if (wantarray) { 654 foreach my $problemID (grep { s/^pfn// } keys %hash) { 655 push @Records, $self->hash2problem($problemID, %hash); 656 } 657 } 658 return @Records; 659 } 660 661 sub records2string { 662 my ($self, $Set, @Problems) = @_; 663 my @hashArray = $self->set2hash($Set); 664 foreach my $Problem (@Problems) { 665 push @hashArray, $self->problem2hash($Problem); 666 } 667 my %hash = @hashArray; 668 return hash2string(%hash); 669 } 670 671 ################################################################################ 672 # table multiplexing functions 673 # both the set_user and problem_user tables are stored in one hash, keyed by 674 # PSVN. we need to be able to split a hash value into two records, and combine 675 # two records into a single hash value. 676 ################################################################################ 677 678 sub hash2IDs { 679 my ($self, %hash) = @_; 680 my $userID = $hash{stlg}; 681 my $setID = $hash{stnm}; 682 my @problemIDs = grep { s/^pfn// } keys %hash; 683 return $userID, $setID, @problemIDs; 684 } 685 686 sub hash2set { 687 my ($self, %hash) = @_; 688 return $self->{db}->{set_user}->{record}->new( 689 user_id => $hash{stlg}, 690 set_id => $hash{stnm}, 691 set_header => $hash{shfn}, 692 problem_header => $hash{phfn}, 693 open_date => $hash{opdt}, 694 due_date => $hash{dudt}, 695 answer_date => $hash{andt}, 696 ); 697 } 698 699 sub hash2problem { 700 my ($self, $n, %hash) = @_; 701 return $self->{db}->{problem_user}->{record}->new( 702 user_id => $hash{"stlg"}, 703 set_id => $hash{"stnm"}, 704 problem_id => $n, 705 source_file => $hash{"pfn$n"}, 706 value => $hash{"pva$n"}, 707 max_attempts => $hash{"pmia$n"}, 708 problem_seed => $hash{"pse$n"}, 709 status => $hash{"pst$n"}, 710 attempted => $hash{"pat$n"}, 711 last_answer => $hash{"pan$n"}, 712 num_correct => $hash{"pca$n"}, 713 num_incorrect => $hash{"pia$n"}, 714 ); 715 } 716 717 sub set2hash { 718 my ($self, $Set) = @_; 719 return ( 720 stlg => $Set->user_id, 721 stnm => $Set->set_id, 722 shfn => $Set->set_header, 723 phfn => $Set->problem_header, 724 opdt => $Set->open_date, 725 dudt => $Set->due_date, 726 andt => $Set->answer_date, 727 ); 728 } 729 730 sub problem2hash { 731 my ($self, $Problem) = @_; 732 my $n = $Problem->problem_id; 733 return ( 734 "stlg" => $Problem->user_id, 735 "stnm" => $Problem->set_id, 736 "pfn$n" => $Problem->source_file, 737 "pva$n" => $Problem->value, 738 "pmia$n" => $Problem->max_attempts, 739 "pse$n" => $Problem->problem_seed, 740 "pst$n" => $Problem->status, 741 "pat$n" => $Problem->attempted, 742 "pan$n" => $Problem->last_answer, 743 "pca$n" => $Problem->num_correct, 744 "pia$n" => $Problem->num_incorrect, 745 ); 746 } 747 748 ################################################################################ 749 # PSVN and index functions 750 # the PSVN pseudo-table and the set and user indexes are not visible to the 751 # API, but we need to be able to update them to remain compatible with WWDBv1. 752 ################################################################################ 753 754 # retrieves a list of existing PSVNs from the user PSVN index 755 sub getPSVNsForUser { 756 my ($self, $userID) = @_; 757 my $setsForUser = $self->fetchString(LOGIN_PREFIX.$userID); 758 return unless defined $setsForUser; 759 my %sets = string2hash($setsForUser); 760 return values %sets; 761 } 762 763 # retrieves a list of existing PSVNs from the set PSVN index 764 sub getPSVNsForSet { 765 my ($self, $setID) = @_; 766 my $usersForSet = $self->fetchString(SET_PREFIX.$setID); 767 return unless defined $usersForSet; 768 my %users = string2hash($usersForSet); 769 return values %users; 770 } 771 772 # retrieves an existing PSVN from the PSVN indexes 773 sub getPSVN { 774 my ($self, $userID, $setID) = @_; 775 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID}; 776 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID}; 777 # * if setsForUser is non-empty, then there are sets built for this 778 # user. 779 # * if usersForSet is non-empty, then this set has been built for at 780 # least one user. 781 # * if either are empty, it is guaranteed that this set has not been 782 # built for this user. 783 return unless defined $setsForUser and defined $usersForSet; #shut up, shut up, shut up! 784 return unless $setsForUser and $usersForSet; 785 my %sets = string2hash($setsForUser); 786 my %users = string2hash($usersForSet); 787 return unless exists $sets{$setID} and exists $users{$userID}; 788 # more sanity checks: the following should never happen. 789 # if they do, run screaming for the hills. 790 if (defined $sets{$setID} and not defined $users{$userID}) { 791 die "PSVN indexes inconsistent: set exists in user index ", 792 "but user does not exist in set index."; 793 } elsif (not defined $sets{$setID} and defined $users{$userID}) { 794 die "PSVN indexes inconsistent: user exists in set index ", 795 "but set does not exist in user index."; 796 } elsif ($sets{$setID} != $users{$userID}) { 797 die "PSVN indexes inconsistent: user index and set index ", 798 "gave different PSVN values."; 799 } 800 return $sets{$setID}; 801 } 802 803 # generates a new PSVN, updates the PSVN indexes, returns the PSVN 804 # if there is already a PSVN for this pair, reuse it 805 sub setPSVN { 806 my ($self, $userID, $setID) = @_; 807 my $PSVN = $self->getPSVN($userID, $setID); 808 unless ($PSVN) { 809 # yeah, create a new PSVN here 810 my $min_psvn = 10**($self->{params}->{psvnLength} - 1); 811 my $max_psvn = 10**$self->{params}->{psvnLength} - 1; 812 my $attempts = 0; 813 do { 814 if (++$attempts > MAX_PSVN_GENERATION_ATTEMPTS) { 815 die "failed to find an unused PSVN within ", 816 MAX_PSVN_GENERATION_ATTEMPTS, " attempts."; 817 } 818 $PSVN = int(rand($max_psvn-$min_psvn+1)) + $min_psvn; 819 } while ($self->fetchString($PSVN)); 820 # get current PSVN indexes 821 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID}; 822 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID}; 823 my %sets = string2hash($setsForUser); # sets built for user $userID 824 my %users = string2hash($usersForSet); # users for which set $setID has been built 825 # insert new PSVN into each hash 826 $sets{$setID} = $PSVN; 827 $users{$userID} = $PSVN; 828 # re-encode the hashes 829 $setsForUser = hash2string(%sets); 830 $usersForSet = hash2string(%users); 831 # store 'em in the database 832 $self->{driver}->hash()->{LOGIN_PREFIX.$userID} = $setsForUser; 833 $self->{driver}->hash()->{SET_PREFIX.$setID} = $usersForSet; 834 }; 835 return $PSVN; 836 } 837 838 # remove an existing PSVN from the PSVN indexes 839 sub deletePSVN { 840 my ($self, $userID, $setID) = @_; 841 my $PSVN = $self->getPSVN($userID, $setID); 842 return unless $PSVN; 843 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID}; 844 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID}; 845 my %sets = string2hash($setsForUser); # sets built for user $userID 846 my %users = string2hash($usersForSet); # users for which set $setID has been built 847 delete $sets{$setID}; 848 delete $users{$userID}; 849 $setsForUser = hash2string(%sets); 850 $usersForSet = hash2string(%users); 851 if ($setsForUser) { 852 $self->{driver}->hash()->{LOGIN_PREFIX.$userID} = $setsForUser; 853 } else { 854 delete $self->{driver}->hash()->{LOGIN_PREFIX.$userID}; 855 } 856 if ($usersForSet) { 857 $self->{driver}->hash()->{SET_PREFIX.$setID} = $usersForSet; 858 } else { 859 delete $self->{driver}->hash()->{SET_PREFIX.$setID}; 860 } 861 return 1; 862 } 863 864 ################################################################################ 865 # hash string interface 866 ################################################################################ 867 868 sub fetchString { 869 my ($self, $PSVN) = @_; 870 my $string = $self->{driver}->hash()->{$PSVN}; 871 return $string; 872 } 873 874 875 sub storeString { 876 my ($self, $PSVN, $string) = @_; 877 $self->{driver}->hash()->{$PSVN} = $string; 878 } 879 880 sub deleteString { 881 my ($self, $PSVN) = @_; 882 delete $self->{driver}->hash()->{$PSVN}; 883 } 884 885 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |