Parent Directory
| 
Revision Log
modified use lib lines in cgi-scripts, scripts, courseScripts removed Global.pm updating and use lib line code from system_webwork_setup modified Global.pm to use webworkConfig (which is not in the repository!)
1 #!/usr/local/bin/webwork-perl 2 3 # ############################################################# 4 # Copyright © 1995,1996,1997,1998 University of Rochester 5 # All Rights Reserved 6 # ############################################################# 7 8 # file: DBglue7.pl 9 10 # These are the tools for accessing the database which contains 11 # all of the information for a given PIN number. Within the pinRecord there are methods 12 # for accessing the data in the record, such as the student's name, ID, the set number 13 # the problems in the set, the due dates and so forth. The only direct "ties" un "untie" 14 # to the database on disk are through the two routines read_psvn_record and 15 # save_psvn_record. 16 17 # The directory names are defined in the header. 18 19 # Define file name for databases. 20 use strict; 21 22 23 # define global file variables 24 my %PROBSET; 25 my %probSetRecord; 26 my $Database = $Global::database; 27 my $databaseDirectory = $Global::databaseDirectory; 28 29 my $scriptDirectory = &Global::getWebworkScriptDirectory(); 30 31 my $wwDbObj; # Object for referencing the database 32 my %MYPROBSET; # used for temporary sorting by last name and by section or recitation; 33 # how do we make this a local variable (or can we?) 34 my $LOCK_SH = 1 ; # shared lock 35 my $LOCK_EX = 2 ; # exclusive lock 36 my $LOCK_NB = 4 ; # non-blocking 37 my $LOCK_UN = 8 ; # unlock 38 39 40 # These open and close the database containing the pinRecords. 41 # They should only be used internally to this file. 42 43 sub attachDBMpin { # returns 1 if succesful 44 my $mode = $_[0] || 'reader'; 45 my ($flag); 46 &Global::error("DB error", "attachDBMpin doesn't know mode $mode") 47 unless ($mode eq 'reader' || $mode eq 'writer'); 48 49 if ($mode eq 'reader') {$flag = 'R'} 50 else {$flag = 'W'} 51 &read_psvn_record(\$wwDbObj, \%PROBSET, "${databaseDirectory}${Database}", $flag, $Global::standard_tie_permission); 52 } 53 54 55 sub detachDBMpin { 56 &save_psvn_record(\$wwDbObj, \%PROBSET,"${databaseDirectory}${Database}"); 57 1; # Explicitly return 1 if successful, if not it has already died 58 } 59 60 61 62 sub fetchProbSetRecord { # synonym for attachProbSetRecord 63 attachProbSetRecord(@_); 64 } 65 sub attachProbSetRecord { 66 my($probSetKey)=@_; 67 return 0 unless defined($probSetKey); # can't find record if you don't tell me the record id. 68 my($flag)=0; 69 %probSetRecord=(); 70 &attachDBMpin(); #attaches DBM file to %PROBSET 71 # unpack the line into %probSetRecord 72 if ( $flag=defined($PROBSET{"$probSetKey"}) ) { 73 my $string = $PROBSET{"$probSetKey"}; 74 $string =~ s/=$/= /; # this makes sure that the last element has a value. It may cause trouble if this value was supposed to be nil instead of a space. 75 my @probSetRecord=split(/[\&=]/,$string); 76 # if (scalar(@probSetRecord) % 2 == 1) { 77 # print "<BR>size of probSetRecord = ",scalar(@probSetRecord),"<BR>"; 78 # print "<BR>hash list= <BR>|$PROBSET{$probSetKey}|<BR><BR>"; 79 # #print "probSetRecord", join("|<BR>|\n",@probSetRecord), "<BR><BR>"; 80 # } 81 %probSetRecord=@probSetRecord; 82 } 83 &detachDBMpin; 84 # The problem set record corresponding to the $probSetKey is now in %probSetRecord 85 $flag; # 1 means you got something 86 } 87 sub saveProbSetRecord { # synonym for detachProbSetRecord 88 detachProbSetRecord(@_); 89 } 90 sub detachProbSetRecord { #data is in probSetRecord 91 my($probSetKey)=@_; 92 my ($out,@ind,@setList,%setList,@loginList,%loginList); 93 my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString); 94 &attachDBMpin('writer'); #attaches DBM file to %PROBSET 95 # &attachDBMpin; # used to replace line above when experimenting with database attachment speed. 96 # First get the old record so that we can see if either the loginID or the setNumber 97 # has changed 98 my %old_record_string = (); 99 if (defined($PROBSET{$probSetKey}) ) { 100 my $old_record_string = $PROBSET{$probSetKey}; 101 $old_record_string =~ s/=$/= /; # this makes sure that the last element has a value. It may cause trouble if this value was supposed to be nil instead of a space. 102 my @old_record_string = split(/[\&=]/,$old_record_string); 103 %old_record_string = @old_record_string; 104 } 105 106 107 $oldLoginID = defined($old_record_string{'stlg'}) ? $old_record_string{'stlg'} : ""; 108 $oldSetNumber = defined($old_record_string{'stnm'}) ? $old_record_string{'stnm'} : ""; 109 $setNumber = $probSetRecord{'stnm'}; 110 $loginID = $probSetRecord{'stlg'}; 111 # Next prepare the new record and place it into %PROBSET DBM file 112 $out=""; 113 @ind=keys(%probSetRecord); 114 my $i; 115 foreach $i (@ind) { 116 $out=$out . $i . '=' . $probSetRecord{$i} . "&" ; 117 }; 118 chop($out); #remove the final & from the string. 119 120 121 $PROBSET{$probSetKey}=$out; 122 123 ## Updating the set index and the login index only has to be done if one of the 124 ## items loginID or setNumber has changed or if they didn't exist before. 125 126 if ( defined($PROBSET{$probSetKey}) and 127 ( $loginID eq $oldLoginID) and 128 ($setNumber eq $oldSetNumber) 129 ) { 130 131 # warn "saving DB -- no changes to indices"; 132 } else { 133 ## The rest of the code updates the index files if that is necessary. 134 135 ## First delete out of date information if setNumber or loginID has changed 136 if ( defined($oldSetNumber) and defined($oldLoginID) and 137 ( $setNumber ne $oldSetNumber or $loginID ne $oldLoginID ) 138 ) { 139 ## delete out of date reference to the oldLogin in the oldSetNumber 140 141 $recordString = $PROBSET{"set<>$oldSetNumber"}; 142 $recordString = "" unless defined($recordString); 143 my @oldSetList=split(/[\&=]/,$recordString); 144 my %oldSetList=@oldSetList; 145 delete $oldSetList{"$oldLoginID"}; 146 $out = ""; 147 my $indx; 148 foreach $indx (keys %oldSetList) { 149 $out=$out . $indx . '=' . $oldSetList{$indx} . "&" ; 150 }; 151 chop($out); #remove the final & from the string. 152 if ($out eq "") { 153 delete $PROBSET {"set<>$oldSetNumber"}; 154 } else { 155 $PROBSET{"set<>$oldSetNumber"}= $out; 156 } 157 158 $recordString = $PROBSET{"login<>$oldLoginID"}; 159 $recordString = "" unless defined($recordString); 160 @loginList=split(/[\&=]/,$recordString); 161 %loginList=@loginList; 162 delete $loginList{"$oldSetNumber"}; 163 $out = ""; 164 my $i; 165 foreach $i (keys %loginList) { 166 $out=$out . $i . '=' . $loginList{$i} . "&" ; 167 }; 168 chop($out); #remove the final & from the string. 169 if ($out eq "") { 170 delete $PROBSET{"login<>$oldLoginID"}; 171 } 172 else { 173 $PROBSET{"login<>$oldLoginID"}= $out; 174 } 175 } 176 177 178 # Update index for sets: 179 # For every set, this is a list containing all the loginID's for the set and the corresponding 180 # psvn's. Each loginID and psvn can occur only once. Format loginID = psvn 181 ## Now enter new data 182 183 $recordString = $PROBSET{"set<>$setNumber"}; 184 $recordString = "" unless defined($recordString); 185 @setList=split(/[\&=]/,$recordString); 186 %setList=@setList; 187 $setList{"$loginID"}=$probSetKey; 188 @ind=keys(%setList); 189 $out = ""; 190 foreach $i (@ind) { 191 $out=$out . $i . '=' . $setList{$i} . "&" ; 192 }; 193 chop($out); #remove the final & from the string. 194 if ($out eq "") { 195 delete $PROBSET {"set<>$setNumber"}; 196 } 197 else { 198 $PROBSET{"set<>$setNumber"}= $out; 199 } 200 201 # Update index for loginID's: 202 # For every loginID, this is a list containing all sets for the loginID and the corresponding 203 # psvn's. Each setNumber and psvn can occur only once. Format setNumber = psvn 204 205 206 207 ## Now enter new data 208 # $recordString = ""; 209 $recordString = $PROBSET{"login<>$loginID"}; 210 $recordString = "" unless defined($recordString); 211 @loginList=split(/[\&=]/,$recordString); 212 %loginList=@loginList; 213 $loginList{"$setNumber"}=$probSetKey; 214 @ind=keys(%loginList); 215 $out = ""; 216 foreach $i (@ind) { 217 $out=$out . $i . '=' . $loginList{$i} . "&" ; 218 }; 219 chop($out); #remove the final & from the string. 220 if ($out eq "") { 221 delete $PROBSET{"login<>$loginID"}; 222 } 223 else { 224 $PROBSET{"login<>$loginID"}= $out; 225 } 226 my $temp_key; 227 228 229 } 230 if (&detachDBMpin) { 231 return 1; # returns 1 if successful 232 } else { 233 wwerror("$0","DBglue.pl Error at line __LINE__ while saving database","",""); 234 return 0; 235 } 236 # The contents of %probSetRecord has now been placed in the problem set record data 237 # base with key given by $probSetRecord 238 } 239 240 241 242 sub getProbSetRecord { #returns the contents of the current record hash 243 %probSetRecord; 244 } 245 246 sub deleteProbSetRecord { #also assumes that %kprobSetRecord is correctly loaded. 247 my ($probSetKey)=@_; 248 my ($out,@ind,@setList,%setList,@loginList,%loginList); 249 my ($setNumber,$loginID,$recordString); 250 my $flag = 1; 251 $flag = $flag && &attachDBMpin('writer'); #attaches DBM file to %PROBSET # get the necessary data 252 $setNumber = $probSetRecord{'stnm'}; 253 $loginID = $probSetRecord{'stlg'}; 254 # Update index for sets: 255 256 $recordString = $PROBSET{"set<>$setNumber"}; 257 @setList=split(/[\&=]/,$recordString); 258 %setList=@setList; 259 delete $setList{"$loginID"}; 260 @ind=keys(%setList); 261 $out = ""; 262 my $i; 263 foreach $i (@ind) { 264 $out=$out . $i . '=' . $setList{$i} . "&" ; 265 }; 266 chop($out); #remove the final & from the string. 267 if ($out eq "") { 268 delete( $PROBSET{"set<>$setNumber"}); 269 } else { 270 $PROBSET{"set<>$setNumber"}= $out; 271 } 272 273 $recordString = $PROBSET{"login<>$loginID"}; 274 @loginList=split(/[\&=]/,$recordString); 275 %loginList=@loginList; 276 delete $loginList{"$setNumber"}; 277 @ind=keys(%loginList); 278 $out=""; 279 foreach $i (@ind) { 280 $out=$out . $i . '=' . $loginList{$i} . '&' ; 281 }; 282 chop($out); #remove the final & from the string. 283 if ($out eq "") { 284 delete $PROBSET{"login<>$loginID"}; 285 } 286 else { 287 $PROBSET{"login<>$loginID"}= $out; 288 } 289 # erase the record itself 290 $flag=$flag && defined($PROBSET{$probSetKey}); 291 delete $PROBSET{$probSetKey}; 292 &detachDBMpin(); 293 } 294 295 296 #######StudentLogin########################### 297 sub putStudentLogin { 298 my ($val,$probSetKey) = @_; 299 $probSetRecord{"stlg"}=$val; 300 } 301 sub getStudentLogin { 302 my ($probSetKey) = @_; 303 return( $probSetRecord{"stlg"} ); 304 } 305 306 sub deleteStudentLogin { 307 my ($probSetKey) = @_; 308 delete $probSetRecord{"stlg"}; 309 } 310 311 312 #######SetNumber########################### 313 sub putSetNumber { 314 my ($val,$probSetKey) = @_; 315 $probSetRecord{"stnm"}=$val; 316 } 317 sub getSetNumber { 318 my ($probSetKey) = @_; 319 return( $probSetRecord{"stnm"} ); 320 } 321 322 sub deleteSetNumber { 323 my ($probSetKey) = @_; 324 delete $probSetRecord{"stnm"}; 325 } 326 327 #######SetHeaderFileName########################### 328 sub putSetHeaderFileName { 329 my ($val,$probSetKey) = @_; 330 $probSetRecord{"shfn"}=$val; 331 } 332 sub getSetHeaderFileName { 333 my ($probSetKey) = @_; 334 return( $probSetRecord{"shfn"} ); 335 } 336 337 sub deleteSetHeaderFileName { 338 my ($probSetKey) = @_; 339 delete $probSetRecord{"shfn"}; 340 } 341 342 #######ProbHeaderFileName########################### 343 sub putProbHeaderFileName { 344 my ($val,$probSetKey) = @_; 345 $probSetRecord{"phfn"}=$val; 346 } 347 sub getProbHeaderFileName { 348 my ($probSetKey) = @_; 349 return( $probSetRecord{"phfn"} ); 350 } 351 352 sub deleteProbHeaderFileName { 353 my ($probSetKey) = @_; 354 delete $probSetRecord{"phfn"}; 355 } 356 357 #######OpenDate########################### 358 sub putOpenDate { 359 my ($val,$probSetKey) = @_; 360 $probSetRecord{"opdt"}=$val; 361 } 362 sub getOpenDate { 363 my ($probSetKey) = @_; 364 return( $probSetRecord{"opdt"} ); 365 } 366 367 sub deleteOpenDate { 368 my ($probSetKey) = @_; 369 delete $probSetRecord{"opdt"}; 370 } 371 372 #######DueDate########################### 373 sub putDueDate { 374 my ($val,$probSetKey) = @_; 375 $probSetRecord{"dudt"}=$val; 376 } 377 sub getDueDate { 378 my ($probSetKey) = @_; 379 return( $probSetRecord{"dudt"} ); 380 } 381 382 sub deleteDueDate { 383 my ($probSetKey) = @_; 384 delete $probSetRecord{"dudt"}; 385 } 386 387 #######AnswerDate########################### 388 sub putAnswerDate { 389 my ($val,$probSetKey) = @_; 390 $probSetRecord{"andt"}=$val; 391 } 392 sub getAnswerDate { 393 my ($probSetKey) = @_; 394 return( $probSetRecord{"andt"} ); 395 } 396 397 sub deleteAnswerDate { 398 my ($probSetKey) = @_; 399 delete $probSetRecord{"andt"}; 400 } 401 402 403 404 #######ProblemFileName########################### 405 sub putProblemFileName { 406 my ($val,$probNum,$probSetKey) = @_; 407 $probSetRecord{"pfn$probNum"}=$val; 408 } 409 sub getProblemFileName { 410 my ($probNum,$probSetKey) = @_; 411 return( $probSetRecord{"pfn$probNum"} ); 412 } 413 414 sub deleteProblemFileName { 415 my ($probNum,$probSetKey) = @_; 416 delete $probSetRecord{"pfn$probNum"}; 417 } 418 419 #######ProblemStudentAnswer########################### 420 sub putProblemStudentAnswer { 421 my ($val,$probNum,$probSetKey) = @_; 422 $probSetRecord{"pan$probNum"}=$val; 423 } 424 sub getProblemStudentAnswer { 425 my ($probNum,$probSetKey) = @_; 426 return( $probSetRecord{"pan$probNum"} ); 427 } 428 429 sub deleteProblemStudentAnswer { 430 my ($probNum,$probSetKey) = @_; 431 delete $probSetRecord{"pan$probNum"}; 432 } 433 434 #######ProblemAttempted########################### 435 sub putProblemAttempted { 436 my ($val,$probNum,$probSetKey) = @_; 437 $probSetRecord{"pat$probNum"}=$val; 438 } 439 sub getProblemAttempted { 440 my ($probNum,$probSetKey) = @_; 441 return( $probSetRecord{"pat$probNum"} ); 442 } 443 444 sub deleteProblemAttempted { 445 my ($probNum,$probSetKey) = @_; 446 delete $probSetRecord{"pat$probNum"}; 447 } 448 449 450 #######ProblemStatus########################### 451 sub putProblemStatus { 452 my ($val,$probNum,$probSetKey) = @_; 453 $val = 0 unless ($val =~/\w/); 454 $probSetRecord{"pst$probNum"}=$val; 455 } 456 sub getProblemStatus { 457 my ($probNum,$probSetKey) = @_; 458 return( $probSetRecord{"pst$probNum"} ); 459 } 460 461 sub deleteProblemStatus { 462 my ($probNum,$probSetKey) = @_; 463 delete $probSetRecord{"pst$probNum"}; 464 } 465 466 #######ProblemNumOfCorrectAns########################### 467 sub putProblemNumOfCorrectAns { 468 my ($val,$probNum,$probSetKey) = @_; 469 $probSetRecord{"pca$probNum"}=$val; 470 } 471 sub getProblemNumOfCorrectAns { 472 my ($probNum,$probSetKey) = @_; 473 my $out = 0; 474 $out = $probSetRecord{"pca$probNum"} if defined($probSetRecord{"pca$probNum"}); 475 return($out); 476 } 477 478 sub deleteProblemNumOfCorrectAns { 479 my ($probNum,$probSetKey) = @_; 480 delete $probSetRecord{"pca$probNum"}; 481 } 482 483 #######ProblemNumOfIncorrectAns########################### 484 sub putProblemNumOfIncorrectAns { 485 my ($val,$probNum,$probSetKey) = @_; 486 $probSetRecord{"pia$probNum"}=$val; 487 } 488 sub getProblemNumOfIncorrectAns { 489 my ($probNum,$probSetKey) = @_; 490 my $out = 0; 491 $out = $probSetRecord{"pia$probNum"} if defined($probSetRecord{"pia$probNum"}); 492 return($out); 493 } 494 495 sub deleteProblemNumOfIncorrectAns { 496 my ($probNum,$probSetKey) = @_; 497 delete $probSetRecord{"pia$probNum"}; 498 } 499 #######ProblemMaxNumOfIncorrectAttemps########################### 500 sub putProblemMaxNumOfIncorrectAttemps { 501 my ($val,$probNum,$probSetKey) = @_; 502 $probSetRecord{"pmia$probNum"}=$val; 503 } 504 sub getProblemMaxNumOfIncorrectAttemps { 505 my ($probNum,$probSetKey) = @_; 506 my $out = $probSetRecord{"pmia$probNum"}; 507 if ( (!defined($out)) or ($out eq '') or ($out < 0) 508 ) { 509 $out = -1; 510 } else { 511 $out = int($out); 512 } 513 return($out); 514 } 515 516 sub deleteProblemMaxNumOfIncorrectAttemps { 517 my ($probNum,$probSetKey) = @_; 518 delete $probSetRecord{"pmia$probNum"}; 519 } 520 #######ProblemSeed########################### 521 sub putProblemSeed { 522 my ($val,$probNum,$probSetKey) = @_; 523 $probSetRecord{"pse$probNum"}=$val; 524 } 525 sub getProblemSeed { 526 my ($probNum,$probSetKey) = @_; 527 return( $probSetRecord{"pse$probNum"} ); 528 } 529 530 sub deleteProblemSeed { 531 my ($probNum,$probSetKey) = @_; 532 delete $probSetRecord{"pse$probNum"}; 533 } 534 535 #######ProblemValue########################### 536 sub putProblemValue { 537 my ($val,$probNum,$probSetKey) = @_; 538 $probSetRecord{"pva$probNum"}=$val; 539 } 540 sub getProblemValue { 541 my ($probNum,$probSetKey) = @_; 542 return( $probSetRecord{"pva$probNum"} ); 543 } 544 545 sub deleteProblemValue { 546 my ($probNum,$probSetKey) = @_; 547 delete $probSetRecord{"pva$probNum"}; 548 } 549 550 551 ############Other methods######################### 552 # &getAllProbSetKeys() 553 554 sub getAllProbSetKeys { 555 &attachDBMpin(); 556 my (@lst)=grep(/^[0-9]+$/ , keys %PROBSET); 557 &detachDBMpin(); 558 @lst; 559 } 560 # &getAllProbSetKeysForStudentLogin($StudentLogin) 561 562 sub getAllProbSetKeysForStudentLogin { 563 my($studentLogin)=@_; 564 my %hash = &getAllSetNumbersForStudentLoginHash($studentLogin); 565 values %hash; 566 } 567 sub getAllSetNumbersForStudentLoginHash { 568 my($studentLogin)=@_; 569 my ($recordString,@loginList,%loginList); 570 &attachDBMpin(); 571 if (defined( $PROBSET{"login<>$studentLogin"}) ) { 572 $recordString = $PROBSET{"login<>$studentLogin"}; 573 } 574 else { 575 &Global::error("getAllSetNumbersForStudentLoginHash: Can't find index for login $studentLogin"); 576 } 577 &detachDBMpin(); 578 @loginList=split(/[\&=]/,$recordString); 579 %loginList=@loginList; 580 # print "\n\n\n<p><H1>studentLogin $studentLogin</H1>\n\n"; 581 # print "\n\n\n<p><H1>recordString $recordString</H1>\n\n"; 582 # print "\n\n\n<p><H1>loginList %loginList</H1>\n\n"; 583 %loginList; # (setNumber, psvn, 2, 5678, ...) 584 } 585 586 # &getAllProbSetKeysForSet($setNumber); 587 588 sub getAllProbSetKeysForSet { 589 my ($setNumber)=@_; 590 my ($recordString,@setList,%setList); 591 &attachDBMpin(); 592 # read appropriate set index 593 if (defined( $PROBSET{"set<>$setNumber"}) ){ 594 $recordString = $PROBSET{"set<>$setNumber"}; 595 @setList = split(/[\&=]/,$recordString); 596 %setList=@setList; 597 } 598 else { 599 &Global::error("DBglue: getAllProbSetKeysForSet: Can't find index for set number $setNumber" , 600 'One reason you will see this error is if there are no existing problem sets. For example 601 you will get this error if you delete all problem sets and then return to the prof page or 602 if you login and then goto Begin Problem Set when no problem sets exist. If this is the 603 case (i.e. you have deleted all sets), you can log into the server, goto the directory 604 .../DATA/ and rename (or delete) the file webwork-database (MAKE SURE YOU ARE DELETING OR 605 RENAMING THE webwork-database FOR THE CORRECT COURSE). Then when you go to the prof page, 606 you will be able to build new problem sets.' ); 607 } 608 &detachDBMpin(); 609 610 values %setList; # (psvn, psvn, ...) 611 } 612 613 # &getLoginHashForSet($setNumber) 614 # this is a hash containing all the loginID's (keys) for the set and the corresponding 615 # psvn's (values). 616 617 sub getLoginHashForSet { 618 my ($setNumber)=@_; 619 my ($recordString,@setList,%setList); 620 &attachDBMpin(); 621 # read appropriate set index 622 if (defined( $PROBSET{"set<>$setNumber"}) ){ 623 $recordString = $PROBSET{"set<>$setNumber"}; 624 @setList = split(/[\&=]/,$recordString); 625 %setList=@setList; 626 } 627 else { 628 &Global::error("DBglue: getLoginHashForSet: Can't find index for set number $setNumber" , 629 'One reason you will see this error is if there are no existing problem sets. For example you 630 will get this error if you delete all problem sets and then return to the prof page or 631 if you login and then goto Begin Problem Set when no problem sets exist.' ); 632 } 633 &detachDBMpin(); 634 635 \%setList; 636 } 637 638 # &getPSVNHashForSet($setNumber) 639 # this is a hash containing all the psvn's (keys) for the set and the corresponding 640 # loginID's (values). 641 642 643 sub getPSVNHashForSet { 644 my ($setNumber)=@_; 645 my %PSVNHashForSet = reverse %{getLoginHashForSet($setNumber)}; 646 \%PSVNHashForSet; 647 } 648 649 # &probSetExists($setNumber); 650 651 sub probSetExists { 652 my ($setNumber)=@_; 653 &attachDBMpin(); 654 my $probSetExists = 0; 655 if (defined( $PROBSET{"set<>$setNumber"}) ){$probSetExists = 1;} 656 &detachDBMpin(); 657 658 $probSetExists; 659 } 660 661 #sub getAllProbSetKeysForSetSortedByName { 662 # my ($setNumber)=@_; 663 # my @out = &getAllProbSetKeysForSet($setNumber); 664 # &attachDBMpin(); 665 # %MYPROBSET = %PROBSET; # byLastName needs this hash to sort with 666 # &detachDBMpin(); 667 # @out=sort (byLastName @out); 668 # @out; 669 #} 670 671 #sub getAllProbSetKeysForSetSortedBySectionThenByName { 672 # my ($setNumber)=@_; 673 # my @out = &getAllProbSetKeysForSet($setNumber); 674 # &attachDBMpin(); 675 # %MYPROBSET = %PROBSET; # bySectionThenByName needs this hash to sort with 676 # &detachDBMpin(); 677 # 678 # 679 # @out=sort (bySectionThenByName @out); 680 # @out; 681 #} 682 683 #sub getAllProbSetKeysForSetSortedByRecitationThenByName { 684 # my ($setNumber)=@_; 685 # my @out = &getAllProbSetKeysForSet($setNumber); 686 # &attachDBMpin(); 687 # %MYPROBSET = %PROBSET; # byRecitationThenByName needs this hash to sort with 688 # &detachDBMpin(); 689 # 690 # 691 # @out=sort (byRecitationThenByName @out); 692 # @out; 693 #} 694 695 #sub getStudentName { 696 # my($probSetKey) = @_; 697 # my($fname) = &getStudentFirstName($probSetKey); 698 # my($lname) = &getStudentLastName($probSetKey); 699 # $fname = '' unless defined $fname; 700 # $lname = '' unless defined $lname; 701 # my($out) = "$fname $lname"; 702 # $out =~ s/\s\s+/ /g; # remove any extra spaces 703 # $out; 704 # } 705 706 sub getAllProblemsForProbSetRecord { 707 my($probSetKey) = @_; 708 my(@keyList) = sort grep ( s/pfn//, keys %probSetRecord ); 709 @keyList; 710 #Since each problem has a problem file name keyed by "pfn$probNum" 711 # We select all keys beginning with pfn and delete the pfn part. 712 # This method will break if the key names for the data base is changed. 713 714 } 715 716 #####################others ###################### 717 #sub getAllProbSetKeysSortedByName { 718 # 719 # 720 # &attachDBMpin(); 721 # %MYPROBSET = %PROBSET; 722 # &detachDBMpin(); 723 # my @keyList = grep (/^\d+$/,keys %MYPROBSET); # allow only the psvn numbers to get through 724 # @keyList = sort( byLastName @keyList); 725 # @keyList; 726 #} 727 728 729 730 731 732 733 sub getAllProbSetNumbersHash { 734 # get the entire hash array from GDBM and close the GDBM file 735 &attachDBMpin(); 736 my %MYPROBSET = %PROBSET; 737 &detachDBMpin(); 738 739 my(%setNoHash); my($setNo); my %probSetRecord; my @probSetRecord; 740 my(@keys) = grep(/^[0-9]+$/,keys %MYPROBSET); 741 my $key; 742 foreach $key (@keys) { 743 # Split the record for each psvn and place it in the hash probSetRecord 744 @probSetRecord=split(/[\&=]/, $MYPROBSET{$key}); 745 push(@probSetRecord, " ") unless @probSetRecord %2 ==0; 746 # a blank entry at the end of the string produces an odd number of elements. 747 # I hope this hack doesn't mask other errors. 748 %probSetRecord=@probSetRecord; 749 # Extract the setnumber and build a has whose key is the set number and whose 750 # value is a representative psvn (problem set version number) 751 # The psvn provides a primary key for referencing other information in the database. 752 $setNo = $probSetRecord{'stnm'}; 753 $setNoHash{$setNo}=$key unless $setNoHash{$setNo}; 754 } 755 %setNoHash; 756 } 757 #### this will break if the codes are changed !!!!!!!! ############### 758 759 #sub byLastName { 760 # $MYPROBSET{$a} =~ /stnm=([^&]*)/; 761 # my $sn1 = $1; #set number sorted first 762 # $MYPROBSET{$a} =~ /stln=([^&]*)/; 763 # my $ln1 = $1; # then last name 764 # $MYPROBSET{$a} =~ /stfn=([^&]*)/; 765 # my $fn1= $1; # then first name 766 # 767 # $MYPROBSET{$b} =~ /stnm=([^&]*)/; 768 # my $sn2 = $1; 769 # $MYPROBSET{$b} =~ /stln=([^&]*)/; 770 # my $ln2 = $1; 771 # $MYPROBSET{$b} =~ /stfn=([^&]*)/; 772 # my $fn2= $1; 773 # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) 774 # $t = $ln1 cmp $ln2 unless $t; # if set numbers are equal compare last name 775 # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 776 # $t; 777 #} 778 ##### this will break if the codes are changed !!!!!!!! ############### 779 #sub bySectionThenByName { 780 # $MYPROBSET{$a} =~ /stnm=([^&]*)/; 781 # my $sn1 = $1; #set number sorted first 782 # $MYPROBSET{$a} =~ /clsn=([^&]*)/; 783 # my $cs1 = $1; # then by class section 784 # $MYPROBSET{$a} =~ /stln=([^&]*)/; 785 # my $ln1 = $1; # then last name 786 # $MYPROBSET{$a} =~ /stfn=([^&]*)/; 787 # my $fn1= $1; # then first name 788 # 789 # $MYPROBSET{$b} =~ /stnm=([^&]*)/; 790 # my $sn2 = $1; 791 # $MYPROBSET{$b} =~ /clsn=([^&]*)/; 792 # my $cs2 = $1; # then by class section 793 # $MYPROBSET{$b} =~ /stln=([^&]*)/; 794 # my $ln2 = $1; 795 # $MYPROBSET{$b} =~ /stfn=([^&]*)/; 796 # my $fn2= $1; 797 # 798 # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) 799 # $t = $cs1 cmp $cs2 unless $t; # if set numbers are equal compare class section 800 # $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name 801 # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 802 # $t; 803 #} 804 # 805 #sub byRecitationThenByName { 806 # $MYPROBSET{$a} =~ /stnm=([^&]*)/; 807 # my $sn1 = $1; #set number sorted first 808 # $MYPROBSET{$a} =~ /clrc=([^&]*)/; 809 # my $rc1 = $1; # then by class recitation 810 # $MYPROBSET{$a} =~ /stln=([^&]*)/; 811 # my $ln1 = $1; # then last name 812 # $MYPROBSET{$a} =~ /stfn=([^&]*)/; 813 # my $fn1= $1; # then first name 814 # 815 # $MYPROBSET{$b} =~ /stnm=([^&]*)/; 816 # my $sn2 = $1; 817 # $MYPROBSET{$b} =~ /clrc=([^&]*)/; 818 # my $rc2 = $1; # then by class recitation 819 # $MYPROBSET{$b} =~ /stln=([^&]*)/; 820 # my $ln2 = $1; 821 # $MYPROBSET{$b} =~ /stfn=([^&]*)/; 822 # my $fn2= $1; 823 # 824 # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) 825 # $t = $rc1 cmp $rc2 unless $t; # if set numbers are equal compare class recitation 826 # $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name 827 # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 828 # $t; 829 #} 830 831 sub read_psvn_record { 832 my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_; 833 &Global::tie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission); 834 } 835 836 837 sub save_psvn_record { 838 my ($dbObj_ref, $hash_ref, $file_name) = @_; 839 &Global::untie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name); 840 } 841 842 843 844 #sub getLoginName_StudentID_Hash_from_WW_DB { 845 # my @keylist = getAllProbSetKeys(); 846 # my $key; 847 # my %loginName_StudentID_Hash_from_WW_DB =(); 848 # foreach $key (@keylist) { 849 # attachProbSetRecord($key); 850 # $loginName_StudentID_Hash_from_WW_DB{getStudentLogin($key)} = getStudentID($key); 851 # } 852 # \%loginName_StudentID_Hash_from_WW_DB; 853 #} 854 1; 855 856 857
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |