[system] / trunk / webwork / system / scripts / DBglue8.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/scripts/DBglue8.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 354 - (download) (as text) (annotate)
Mon Jun 10 14:37:37 2002 UTC (17 years, 6 months ago) by apizer
File size: 28587 byte(s)
fixed bug caused by undefined answer

    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: DBglue8.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     $val = protect_string($val);  ## Student answers may contain '&' or '=' which need to be trapped
  423     $probSetRecord{"pan$probNum"}=$val;
  424     }
  425 sub getProblemStudentAnswer {
  426     my  ($probNum,$probSetKey) = @_;
  427     my $val = unprotect_string($probSetRecord{"pan$probNum"}); ## reverse above trapping
  428     return($val);
  429     }
  430 
  431 sub deleteProblemStudentAnswer {
  432     my  ($probNum,$probSetKey) = @_;
  433     delete $probSetRecord{"pan$probNum"};
  434     }
  435 
  436 #######ProblemAttempted###########################
  437 sub putProblemAttempted {
  438     my  ($val,$probNum,$probSetKey) = @_;
  439     $probSetRecord{"pat$probNum"}=$val;
  440     }
  441 sub getProblemAttempted {
  442     my  ($probNum,$probSetKey) = @_;
  443     return( $probSetRecord{"pat$probNum"} );
  444     }
  445 
  446 sub deleteProblemAttempted {
  447     my  ($probNum,$probSetKey) = @_;
  448     delete $probSetRecord{"pat$probNum"};
  449     }
  450 
  451 
  452 #######ProblemStatus###########################
  453 sub putProblemStatus {
  454     my  ($val,$probNum,$probSetKey) = @_;
  455     $val = 0 unless ($val =~/\w/);
  456     $probSetRecord{"pst$probNum"}=$val;
  457     }
  458 sub getProblemStatus {
  459     my  ($probNum,$probSetKey) = @_;
  460     return( $probSetRecord{"pst$probNum"} );
  461     }
  462 
  463 sub deleteProblemStatus {
  464     my  ($probNum,$probSetKey) = @_;
  465     delete $probSetRecord{"pst$probNum"};
  466     }
  467 
  468 #######ProblemNumOfCorrectAns###########################
  469 sub putProblemNumOfCorrectAns {
  470     my  ($val,$probNum,$probSetKey) = @_;
  471     $probSetRecord{"pca$probNum"}=$val;
  472     }
  473 sub getProblemNumOfCorrectAns {
  474     my  ($probNum,$probSetKey) = @_;
  475     my  $out =  0;
  476         $out =  $probSetRecord{"pca$probNum"} if defined($probSetRecord{"pca$probNum"});
  477     return($out);
  478     }
  479 
  480 sub deleteProblemNumOfCorrectAns {
  481     my  ($probNum,$probSetKey) = @_;
  482     delete $probSetRecord{"pca$probNum"};
  483     }
  484 
  485 #######ProblemNumOfIncorrectAns###########################
  486 sub putProblemNumOfIncorrectAns {
  487     my  ($val,$probNum,$probSetKey) = @_;
  488     $probSetRecord{"pia$probNum"}=$val;
  489     }
  490 sub getProblemNumOfIncorrectAns {
  491     my  ($probNum,$probSetKey) = @_;
  492     my  $out    =   0;
  493         $out    =   $probSetRecord{"pia$probNum"} if defined($probSetRecord{"pia$probNum"});
  494     return($out);
  495     }
  496 
  497 sub deleteProblemNumOfIncorrectAns {
  498     my  ($probNum,$probSetKey) = @_;
  499     delete $probSetRecord{"pia$probNum"};
  500     }
  501 #######ProblemMaxNumOfIncorrectAttemps###########################
  502 sub putProblemMaxNumOfIncorrectAttemps {
  503     my  ($val,$probNum,$probSetKey) = @_;
  504     $probSetRecord{"pmia$probNum"}=$val;
  505     }
  506 sub getProblemMaxNumOfIncorrectAttemps {
  507     my  ($probNum,$probSetKey) = @_;
  508     my  $out =  $probSetRecord{"pmia$probNum"};
  509     if ( (!defined($out)) or ($out eq '') or ($out < 0)
  510        )    {
  511             $out = -1;
  512     }   else  {
  513             $out = int($out);
  514     }
  515     return($out);
  516     }
  517 
  518 sub deleteProblemMaxNumOfIncorrectAttemps {
  519     my  ($probNum,$probSetKey) = @_;
  520     delete $probSetRecord{"pmia$probNum"};
  521     }
  522 #######ProblemSeed###########################
  523 sub putProblemSeed {
  524     my  ($val,$probNum,$probSetKey) = @_;
  525     $probSetRecord{"pse$probNum"}=$val;
  526     }
  527 sub getProblemSeed {
  528     my  ($probNum,$probSetKey) = @_;
  529     return( $probSetRecord{"pse$probNum"} );
  530     }
  531 
  532 sub deleteProblemSeed {
  533     my  ($probNum,$probSetKey) = @_;
  534     delete $probSetRecord{"pse$probNum"};
  535     }
  536 
  537 #######ProblemValue###########################
  538 sub putProblemValue {
  539     my  ($val,$probNum,$probSetKey) = @_;
  540     $probSetRecord{"pva$probNum"}=$val;
  541     }
  542 sub getProblemValue {
  543     my  ($probNum,$probSetKey) = @_;
  544     return( $probSetRecord{"pva$probNum"} );
  545     }
  546 
  547 sub deleteProblemValue {
  548     my  ($probNum,$probSetKey) = @_;
  549     delete $probSetRecord{"pva$probNum"};
  550     }
  551 
  552 
  553 ############Other methods#########################
  554 # &getAllProbSetKeys()
  555 
  556 sub getAllProbSetKeys {
  557     &attachDBMpin();
  558     my  (@lst)=grep(/^[0-9]+$/ , keys %PROBSET);
  559     &detachDBMpin();
  560     @lst;
  561     }
  562 # &getAllProbSetKeysForStudentLogin($StudentLogin)
  563 
  564 sub getAllProbSetKeysForStudentLogin {
  565     my($studentLogin)=@_;
  566     my %hash = &getAllSetNumbersForStudentLoginHash($studentLogin);
  567     values %hash;
  568     }
  569 sub getAllSetNumbersForStudentLoginHash {
  570     my($studentLogin)=@_;
  571     my ($recordString,@loginList,%loginList);
  572     &attachDBMpin();
  573     if (defined( $PROBSET{"login<>$studentLogin"}) ) {
  574         $recordString = $PROBSET{"login<>$studentLogin"};
  575         }
  576     else {
  577         &Global::error("getAllSetNumbersForStudentLoginHash: Can't find index for login $studentLogin");
  578         }
  579     &detachDBMpin();
  580     @loginList=split(/[\&=]/,$recordString);
  581     %loginList=@loginList;
  582 #   print "\n\n\n<p><H1>studentLogin $studentLogin</H1>\n\n";
  583 #   print "\n\n\n<p><H1>recordString $recordString</H1>\n\n";
  584 #     print "\n\n\n<p><H1>loginList %loginList</H1>\n\n";
  585     %loginList;  # (setNumber, psvn, 2, 5678, ...)
  586     }
  587 
  588 # &getAllProbSetKeysForSet($setNumber);
  589 
  590 sub getAllProbSetKeysForSet {
  591     my ($setNumber)=@_;
  592     my ($recordString,@setList,%setList);
  593     &attachDBMpin();
  594 # read appropriate set index
  595     if (defined( $PROBSET{"set<>$setNumber"}) ){
  596         $recordString = $PROBSET{"set<>$setNumber"};
  597         @setList = split(/[\&=]/,$recordString);
  598         %setList=@setList;
  599         }
  600     else {
  601         &Global::error("DBglue: getAllProbSetKeysForSet: Can't find index for set number $setNumber" ,
  602 'One reason you will see this error is if there are no existing problem sets.  For example
  603 you will get this error if you delete all problem sets and then return to the prof page or
  604 if you login and then goto Begin Problem Set when no problem sets exist.  If this is the
  605 case (i.e. you have deleted all sets), you can log into the server, goto the directory
  606 .../DATA/ and rename (or delete) the file webwork-database (MAKE SURE YOU ARE DELETING OR
  607 RENAMING THE webwork-database FOR THE CORRECT COURSE). Then when you go to the prof page,
  608 you will be able to build new problem sets.' );
  609         }
  610     &detachDBMpin();
  611 
  612     values %setList;  # (psvn,  psvn, ...)
  613     }
  614 
  615 # &getLoginHashForSet($setNumber)
  616 # this is a hash containing all the loginID's (keys) for the set and the corresponding
  617 # psvn's (values).
  618 
  619 sub getLoginHashForSet {
  620     my ($setNumber)=@_;
  621     my ($recordString,@setList,%setList);
  622     &attachDBMpin();
  623 # read appropriate set index
  624     if (defined( $PROBSET{"set<>$setNumber"}) ){
  625         $recordString = $PROBSET{"set<>$setNumber"};
  626         @setList = split(/[\&=]/,$recordString);
  627         %setList=@setList;
  628         }
  629     else {
  630         &Global::error("DBglue: getLoginHashForSet: Can't find index for set number $setNumber" ,
  631           'One reason you will see this error is if there are no existing problem sets.  For example you
  632           will get this error if you delete all problem sets and then return to the prof page or
  633           if you login and then goto Begin Problem Set when no problem sets exist.' );
  634             }
  635     &detachDBMpin();
  636 
  637     \%setList;
  638     }
  639 
  640 # &getPSVNHashForSet($setNumber)
  641 # this is a hash containing all the psvn's (keys) for the set and the corresponding
  642 # loginID's (values).
  643 
  644 
  645 sub getPSVNHashForSet {
  646     my ($setNumber)=@_;
  647   my %PSVNHashForSet = reverse %{getLoginHashForSet($setNumber)};
  648   \%PSVNHashForSet;
  649 }
  650 
  651 # &probSetExists($setNumber);
  652 
  653 sub probSetExists {
  654     my ($setNumber)=@_;
  655     &attachDBMpin();
  656     my $probSetExists = 0;
  657     if (defined( $PROBSET{"set<>$setNumber"}) ){$probSetExists = 1;}
  658     &detachDBMpin();
  659 
  660     $probSetExists;
  661     }
  662 
  663 
  664 # &setsExistForStudentLogin($loginName);
  665 sub setsExistForStudentLogin {
  666     my($studentLogin)=@_;
  667     my $setsExist = 0;
  668     my ($recordString,@loginList,%loginList);
  669     &attachDBMpin();
  670     if (defined( $PROBSET{"login<>$studentLogin"}) ) {$setsExist = 1;}
  671     &detachDBMpin();
  672 
  673     $setsExist
  674 }
  675 
  676 #sub getAllProbSetKeysForSetSortedByName {
  677 #    my  ($setNumber)=@_;
  678 #    my @out = &getAllProbSetKeysForSet($setNumber);
  679 #    &attachDBMpin();
  680 #    %MYPROBSET = %PROBSET;  # byLastName needs this hash to sort with
  681 #    &detachDBMpin();
  682 #    @out=sort (byLastName @out);
  683 #    @out;
  684 #}
  685 
  686 #sub getAllProbSetKeysForSetSortedBySectionThenByName {
  687 #    my  ($setNumber)=@_;
  688 #    my @out = &getAllProbSetKeysForSet($setNumber);
  689 #    &attachDBMpin();
  690 #    %MYPROBSET = %PROBSET;  # bySectionThenByName needs this hash to sort with
  691 #    &detachDBMpin();
  692 #
  693 #
  694 #    @out=sort (bySectionThenByName @out);
  695 #    @out;
  696 #}
  697 
  698 #sub getAllProbSetKeysForSetSortedByRecitationThenByName {
  699 #    my  ($setNumber)=@_;
  700 #    my @out = &getAllProbSetKeysForSet($setNumber);
  701 #    &attachDBMpin();
  702 #    %MYPROBSET = %PROBSET;  # byRecitationThenByName needs this hash to sort with
  703 #    &detachDBMpin();
  704 #
  705 #
  706 #    @out=sort (byRecitationThenByName @out);
  707 #    @out;
  708 #}
  709 
  710 #sub getStudentName  {
  711 #        my($probSetKey) = @_;
  712 #        my($fname) = &getStudentFirstName($probSetKey);
  713 #        my($lname) = &getStudentLastName($probSetKey);
  714 #        $fname = '' unless defined $fname;
  715 #        $lname = '' unless defined $lname;
  716 #        my($out) = "$fname $lname";
  717 #        $out =~ s/\s\s+/ /g;     # remove any extra spaces
  718 #        $out;
  719 #        }
  720 
  721 sub getAllProblemsForProbSetRecord {
  722     my($probSetKey) = @_;
  723     my(@keyList) = sort grep ( s/pfn//, keys %probSetRecord );
  724     @keyList;
  725      #Since each problem has a problem file name keyed by "pfn$probNum"
  726      # We select all keys beginning with pfn and delete the pfn part.
  727      # This method will break if the key names for the data base is changed.
  728 
  729     }
  730 
  731 #####################others ######################
  732 #sub getAllProbSetKeysSortedByName {
  733 #
  734 #
  735 #    &attachDBMpin();
  736 #    %MYPROBSET = %PROBSET;
  737 #    &detachDBMpin();
  738 #    my @keyList = grep (/^\d+$/,keys %MYPROBSET); # allow only the psvn numbers to get through
  739 #    @keyList = sort( byLastName @keyList);
  740 #    @keyList;
  741 #}
  742 
  743 
  744 
  745 
  746 
  747 
  748 sub getAllProbSetNumbersHash {
  749 # get the entire hash array from GDBM and close the GDBM file
  750     &attachDBMpin();
  751     my %MYPROBSET = %PROBSET;
  752     &detachDBMpin();
  753 
  754     my(%setNoHash); my($setNo); my %probSetRecord; my @probSetRecord;
  755     my(@keys) = grep(/^[0-9]+$/,keys %MYPROBSET);
  756     my $key;
  757     foreach $key (@keys) {
  758 #   Split the record for each psvn and place it in the hash probSetRecord
  759         @probSetRecord=split(/[\&=]/, $MYPROBSET{$key});
  760         push(@probSetRecord, " ") unless @probSetRecord %2 ==0;
  761         # a blank entry at the end of the string produces an odd number of elements.
  762         # I hope this hack doesn't mask other errors.
  763         %probSetRecord=@probSetRecord;
  764 #   Extract the setnumber and build a has whose key is the set number and whose
  765 #   value is a representative psvn (problem set version number)
  766 #   The psvn provides a primary key for referencing other information in the database.
  767         $setNo = $probSetRecord{'stnm'};
  768         $setNoHash{$setNo}=$key unless $setNoHash{$setNo};
  769         }
  770     %setNoHash;
  771 }
  772 #### this will break if the codes are changed !!!!!!!! ###############
  773 
  774 #sub byLastName {
  775 #            $MYPROBSET{$a} =~ /stnm=([^&]*)/;
  776 #            my $sn1 = $1;   #set number sorted first
  777 #            $MYPROBSET{$a} =~ /stln=([^&]*)/;
  778 #            my $ln1 = $1;   # then last name
  779 #            $MYPROBSET{$a} =~ /stfn=([^&]*)/;
  780 #            my $fn1= $1;    # then first name
  781 #
  782 #            $MYPROBSET{$b} =~ /stnm=([^&]*)/;
  783 #            my $sn2 = $1;
  784 #            $MYPROBSET{$b} =~ /stln=([^&]*)/;
  785 #            my $ln2 = $1;
  786 #            $MYPROBSET{$b} =~ /stfn=([^&]*)/;
  787 #            my $fn2= $1;
  788 #            my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
  789 #            $t = $ln1 cmp $ln2  unless $t; # if set numbers are equal compare last name
  790 #            $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
  791 #            $t;
  792 #}
  793 ##### this will break if the codes are changed !!!!!!!! ###############
  794 #sub bySectionThenByName {
  795 #    $MYPROBSET{$a} =~ /stnm=([^&]*)/;
  796 #    my $sn1 = $1;   #set number sorted first
  797 #    $MYPROBSET{$a} =~ /clsn=([^&]*)/;
  798 #    my $cs1 = $1;   # then by class section
  799 #    $MYPROBSET{$a} =~ /stln=([^&]*)/;
  800 #    my $ln1 = $1;   # then last name
  801 #    $MYPROBSET{$a} =~ /stfn=([^&]*)/;
  802 #    my $fn1= $1;    # then first name
  803 #
  804 #    $MYPROBSET{$b} =~ /stnm=([^&]*)/;
  805 #    my $sn2 = $1;
  806 #    $MYPROBSET{$b} =~ /clsn=([^&]*)/;
  807 #    my $cs2 = $1;   # then by class section
  808 #    $MYPROBSET{$b} =~ /stln=([^&]*)/;
  809 #    my $ln2 = $1;
  810 #    $MYPROBSET{$b} =~ /stfn=([^&]*)/;
  811 #    my $fn2= $1;
  812 #
  813 #    my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
  814 #    $t = $cs1 cmp $cs2  unless $t; # if set numbers are equal compare class section
  815 #    $t = $ln1 cmp $ln2  unless $t; # if class sections are equal compare last name
  816 #    $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
  817 #    $t;
  818 #}
  819 #
  820 #sub byRecitationThenByName {
  821 #    $MYPROBSET{$a} =~ /stnm=([^&]*)/;
  822 #    my $sn1 = $1;   #set number sorted first
  823 #    $MYPROBSET{$a} =~ /clrc=([^&]*)/;
  824 #    my $rc1 = $1;   # then by class recitation
  825 #    $MYPROBSET{$a} =~ /stln=([^&]*)/;
  826 #    my $ln1 = $1;   # then last name
  827 #    $MYPROBSET{$a} =~ /stfn=([^&]*)/;
  828 #    my $fn1= $1;    # then first name
  829 #
  830 #    $MYPROBSET{$b} =~ /stnm=([^&]*)/;
  831 #    my $sn2 = $1;
  832 #    $MYPROBSET{$b} =~ /clrc=([^&]*)/;
  833 #    my $rc2 = $1;   # then by class recitation
  834 #    $MYPROBSET{$b} =~ /stln=([^&]*)/;
  835 #    my $ln2 = $1;
  836 #    $MYPROBSET{$b} =~ /stfn=([^&]*)/;
  837 #    my $fn2= $1;
  838 #
  839 #    my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
  840 #    $t = $rc1 cmp $rc2  unless $t; # if set numbers are equal compare class recitation
  841 #    $t = $ln1 cmp $ln2  unless $t; # if class sections are equal compare last name
  842 #    $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
  843 #    $t;
  844 #}
  845 
  846 sub read_psvn_record {
  847     my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_;
  848     &Global::tie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission);
  849 }
  850 
  851 
  852 sub save_psvn_record {
  853     my ($dbObj_ref, $hash_ref, $file_name) = @_;
  854     &Global::untie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name);
  855 }
  856 
  857 
  858 
  859 #sub getLoginName_StudentID_Hash_from_WW_DB {
  860 # my @keylist = getAllProbSetKeys();
  861 # my $key;
  862 # my %loginName_StudentID_Hash_from_WW_DB =();
  863 # foreach $key (@keylist) {
  864 #   attachProbSetRecord($key);
  865 #   $loginName_StudentID_Hash_from_WW_DB{getStudentLogin($key)} = getStudentID($key);
  866 # }
  867 # \%loginName_StudentID_Hash_from_WW_DB;
  868 #}
  869 
  870 
  871   ## When using flat databases (gdbm, db), we use '&' and '=' to
  872   ## separate values so we must replace all such occurences if they
  873   ## might possibly occur in the input string. We will
  874   ## replace then by %% and @@. First we escape any of these.
  875 
  876 sub protect_string {
  877   my $in_string = shift;
  878 
  879   $in_string =~ s/%/\\%\\/g;
  880   $in_string =~ s/@/\\@\\/g;
  881   $in_string =~ s/&/%%/g;
  882   $in_string =~ s/=/@@/g;
  883 #warn "final instring is |$in_string| \n";
  884   $in_string;
  885 }
  886 
  887   ## reverse protection process. See comments preceeding protect_string
  888 sub unprotect_string {
  889   my $in_string = shift;
  890 
  891   return unless defined $in_string;
  892   $in_string =~ s/@@/=/g;
  893   $in_string =~ s/%%/&/g;
  894   $in_string =~ s/\\@\\/@/g;
  895   $in_string =~ s/\\%\\/%/g;
  896 #warn "final instring is |$in_string| \n";
  897   $in_string;
  898 }
  899 1;
  900 
  901 
  902 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9