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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 192 - (download) (as text) (annotate)
Thu Sep 6 15:48:35 2001 UTC (18 years, 3 months ago) by apizer
File size: 12898 byte(s)
When sorting by student name, the sorts are now case insentitive

    1 #!/usr/local/bin/webwork-perl
    2 
    3 
    4 # file: classlist_DBglue.pl
    5 
    6 # These are the tools for accessing the classlist database which contains
    7 # all of the information for a given student. Within the record there are methods
    8 # for accessing the data in the record, such as the student's name, ID, and so forth. \
    9 # The only direct "ties"  un "untie" to the database on disk are through the two routines
   10 # read_class_list_record and save_class_list_record.
   11 
   12 # The normal key for a record is the student login id, e.g. apizer .
   13 # Special keys (e.g. >>lock_status) always begin with >> .
   14 
   15 # The directory names are defined in the header.
   16 
   17 # Define file name for databases.
   18 use strict;
   19 
   20 
   21 # define global file variables
   22 my %CLASSLIST;
   23 my %MYCLASSLIST; # used for temporary sorting by last name and by section;
   24 my %CL_Record;
   25 my $CL_Database = $Global::CL_Database;
   26 my $databaseDirectory = $Global::databaseDirectory;
   27 
   28 my $scriptDirectory = &Global::getWebworkScriptDirectory();
   29 
   30 my $CL_DbObj;            # Object for referencing the database
   31                  # how do we make this a local variable (or can we?)
   32 my $LOCK_SH = 1 ;       # shared lock
   33 my $LOCK_EX = 2 ;       # exclusive lock
   34 my $LOCK_NB = 4 ;       # non-blocking
   35 my $LOCK_UN = 8 ;       # unlock
   36 
   37 
   38 # These open and close the database containing the classList Records.
   39 #   They should only be used internally to this file.
   40 
   41 sub attachCL {  # returns 1 if succesful
   42     my $mode = $_[0] || 'reader';
   43     my ($flag);
   44     &Global::error("DB error", "attachCL doesn't know mode $mode")
   45       unless ($mode eq 'reader' || $mode eq 'writer');
   46 
   47     if ($mode eq 'reader') {$flag = 'R'}
   48     else {$flag = 'W'}
   49     &read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", $flag, $Global::standard_tie_permission);
   50 
   51     if ($flag eq 'W') {
   52       my $status = $CLASSLIST{'>>lock_status'};
   53       unless ((!defined $status) or ($status eq 'unlocked') or ((defined $Global::over_ride_CLBD_lock)
   54         and $Global::over_ride_CLBD_lock))  {
   55         &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
   56         wwerror("The Classlist Database is LOCKED", "This means the database can not be updated from the internet
   57 (e.g. students can not change their email addresses). Probably your professor is working on the database.
   58 if this problem persists, tell your peofessor. Perhaps he or she forgot to unlock the database.");
   59 
   60       }
   61 
   62     }
   63 }
   64 
   65 
   66 sub detachCL {
   67     &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
   68     1;              # Explicitly return 1 if successful, if not it has already died
   69 }
   70 
   71 sub read_CL_record {
   72     my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_;
   73     &Global::tie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission);
   74 }
   75 
   76 
   77 sub save_CL_record {
   78     my ($dbObj_ref, $hash_ref, $file_name) = @_;
   79     &Global::untie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name);
   80 }
   81 
   82 sub attachCLRecord {
   83     my($user)=@_;
   84     return 0 unless defined($user);  # can't find record if you don't tell me the record id.
   85     my($flag)=0;
   86     %CL_Record=();
   87     &attachCL();   #attaches DBM file to %CLASSLIST
   88     # unpack the line into %CL_Record
   89     if (  $flag=defined($CLASSLIST{"$user"})   ) {
   90         my $string = $CLASSLIST{"$user"};
   91         $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.
   92         my @CL_Record=split(/[\&=]/,$string);
   93 
   94         %CL_Record=@CL_Record;
   95         }
   96     &detachCL;
   97     #   The classlist record corresponding to the $user is now in %CL_Record
   98     $flag; # 1  means you got something
   99 }
  100 
  101 sub saveCLRecord {  #data is in CL_Record
  102     my($user)=@_;
  103     my ($out,@ind,@setList,%setList,@loginList,%loginList);
  104     my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString);
  105     &attachCL('writer');   #attaches DBM file to %CLASSLIST
  106 
  107 # Prepare the new record and place it into %CLASSLIST DBM file
  108     $out='';
  109     @ind=keys(%CL_Record);
  110         my $i;
  111         foreach $i (@ind) {
  112         $out=$out . $i . '=' . $CL_Record{$i} . "&" ;
  113         };
  114     chop($out);   #remove the final & from the string.
  115 
  116 
  117   $CLASSLIST{$user}=$out;
  118 
  119   if (&detachCL) {
  120       return 1; # returns 1 if successful
  121   } else {
  122     wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","","");
  123     return 0;
  124   }
  125 #   The contents of %CL_Record has now been placed in the problem set record data
  126 #   base with key given by $CL_Record
  127 }
  128 
  129 
  130 
  131 sub getClassListRecord { #returns the contents of the current record hash
  132     %CL_Record;
  133     }
  134 
  135 sub deleteClassListRecord {
  136     my ($user)=@_;
  137     my $flag = 1;
  138     $flag = $flag && &attachCL('writer');   #attaches DBM file to %CLASSLIST  # get the necessary data
  139 
  140     # erase the record itself
  141     $flag=$flag && defined($CLASSLIST{$user});
  142     delete $CLASSLIST{$user};
  143     &detachCL();
  144     }
  145 
  146 #######StudentLastName###########################
  147 sub CL_putStudentLastName {
  148     my($val,$user) = @_;
  149     $CL_Record{'stln'}=$val;
  150     }
  151 sub CL_getStudentLastName {
  152     my  ($user) = @_;
  153     return( $CL_Record{'stln'} );
  154     }
  155 
  156 sub CL_deleteStudentLastName {
  157     my  ($user) = @_;
  158     delete $CL_Record{'stln'};
  159     }
  160 
  161 #######StudentFirstName###########################
  162 sub CL_putStudentFirstName {
  163     my  ($val,$user) = @_;
  164     $CL_Record{'stfn'}=$val;
  165     }
  166 sub CL_getStudentFirstName {
  167     my  ($user) = @_;
  168     return( $CL_Record{'stfn'} );
  169     }
  170 
  171 sub CL_deleteStudentFirstName {
  172     my  ($user) = @_;
  173     delete $CL_Record{'stfn'};
  174     }
  175 
  176 #######EmailAddress########################
  177 
  178 sub CL_putStudentEmailAddress {
  179         my  ($val, $user) = @_;
  180         $CL_Record{'stea'}=$val;
  181         }
  182 sub CL_getStudentEmailAddress {
  183         my  ($user) = @_;
  184         return( $CL_Record{'stea'} );
  185         }
  186 sub CL_deleteStudentEmailAddress {
  187         my  ($user) = @_;
  188         delete $CL_Record{'stea'};
  189         }
  190 
  191 #######StudentID###########################
  192 sub CL_putStudentID {
  193     my  ($val,$user) = @_;
  194     $CL_Record{'stid'}=$val;
  195     }
  196 sub CL_getStudentID {
  197     my  ($user) = @_;
  198     return( $CL_Record{'stid'} );
  199     }
  200 
  201 sub CL_deleteStudentID {
  202     my  ($user) = @_;
  203     delete $CL_Record{'stid'};
  204     }
  205 
  206 
  207 #######StudentStatus###########################
  208 sub CL_putStudentStatus {
  209     my  ($val,$user) = @_;
  210     $CL_Record{'stst'}=$val;
  211     }
  212 sub CL_getStudentStatus {
  213     my  ($user) = @_;
  214     return( $CL_Record{'stst'} );
  215     }
  216 
  217 sub CL_deleteStudentStatus {
  218     my  ($user) = @_;
  219     delete $CL_Record{'stst'};
  220     }
  221 
  222 
  223 #######ClassSection###########################
  224 sub CL_putClassSection {
  225     my  ($val,$user) = @_;
  226     $CL_Record{'clsn'}=$val;
  227     }
  228 sub CL_getClassSection {
  229     my  ($user) = @_;
  230     return( $CL_Record{'clsn'} );
  231     }
  232 
  233 sub CL_deleteClassSection {
  234     my  ($user) = @_;
  235     delete $CL_Record{'clsn'};
  236     }
  237 
  238 #######ClassRecitation###########################
  239 sub CL_putClassRecitation {
  240     my  ($val,$user) = @_;
  241     $CL_Record{'clrc'}=$val;
  242     }
  243 sub CL_getClassRecitation {
  244     my  ($user) = @_;
  245     return( $CL_Record{'clrc'} );
  246     }
  247 
  248 sub CL_deleteClassRecitation {
  249     my  ($user) = @_;
  250     delete $CL_Record{'clrc'};
  251     }
  252 
  253 #######Comment###########################
  254 sub CL_putComment {
  255     my  ($val,$user) = @_;
  256     $CL_Record{'comt'}=$val;
  257     }
  258 sub CL_getComment {
  259     my  ($user) = @_;
  260     return( $CL_Record{'comt'} );
  261     }
  262 
  263 sub CL_deleteComment {
  264     my  ($user) = @_;
  265     delete $CL_Record{'comt'};
  266     }
  267 
  268 ############Other methods#########################
  269 
  270 ## lock and unlock CL database
  271 
  272 sub lock_CL_database {
  273   $Global::over_ride_CLBD_lock = 0;  ## reset just to be sure
  274   &attachCL('writer');
  275   $CLASSLIST{'>>lock_status'}='locked';
  276   if (&detachCL) {
  277       return 1; # returns 1 if successful
  278   } else {
  279     wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","","");
  280     return 0;
  281   }
  282 }
  283 
  284 sub unlock_CL_database {  ## we have to by pass standard routines since we want to unlock a locked database over the web
  285   $Global::over_ride_CLBD_lock = 0;  ## reset just to be sure
  286   &read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", 'W', $Global::standard_tie_permission);
  287   $CLASSLIST{'>>lock_status'}='unlocked';
  288   &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
  289 }
  290 
  291 sub get_CL_database_status {
  292   &attachCL();
  293   return $CLASSLIST{'>>lock_status'};
  294   &detachCL();
  295 }
  296 
  297 # &getAllLoginNames
  298 
  299 sub getAllLoginNames {
  300     &attachCL();
  301     my  (@lst)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
  302     &detachCL();
  303     \@lst;
  304     }
  305 
  306 sub getAllLoginNamesSortedByName {
  307 
  308     &attachCL();
  309     my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
  310     %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
  311     &detachCL();
  312 
  313     @out=sort (CL_byLastName @out);
  314     \@out;
  315 }
  316 
  317 sub getAllLoginNamesSortedBySectionThenByName {
  318 
  319     &attachCL();
  320     my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
  321     %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
  322     &detachCL();
  323 
  324     @out=sort (CL_bySectionThenByName @out);
  325     \@out;
  326 }
  327 
  328 sub getAllLoginNamesSortedByRecitationThenByName {
  329 
  330     &attachCL();
  331     my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
  332     %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
  333     &detachCL();
  334 
  335     @out=sort (CL_byRecitationThenByName @out);
  336     \@out;
  337 }
  338 
  339 
  340 sub getLoginName_StudentID_Hash {
  341 
  342   my @userNames = @{getAllLoginNames()};
  343   my ($user, %loginName_StudentID_Hash);
  344   foreach $user (@userNames) {
  345     attachCLRecord($user);
  346     $loginName_StudentID_Hash{$user} = CL_getStudentID($user);
  347   }
  348   \%loginName_StudentID_Hash;
  349 }
  350 
  351 sub getStudentID_LoginName_Hash {
  352 
  353   my %studentID_LoginName_Hash = reverse %{getLoginName_StudentID_Hash()};
  354   \%studentID_LoginName_Hash;
  355 }
  356 
  357 sub getAllSections{
  358 
  359   my @userNames = @{getAllLoginNames()};
  360   my ($user, $section,%section_Hash);
  361   foreach $user (@userNames) {
  362     attachCLRecord($user);
  363     $section= CL_getClassSection($user);
  364     $section_Hash{$section}++;
  365   }
  366 
  367   \%section_Hash;
  368 }
  369 
  370 sub getAllRecitations{
  371 
  372   my @userNames = @{getAllLoginNames()};
  373   my ($user, $recitation,%recitation_Hash);
  374   foreach $user (@userNames) {
  375     attachCLRecord($user);
  376     $recitation= CL_getClassRecitation($user);
  377     $recitation_Hash{$recitation}++;
  378   }
  379 
  380   \%recitation_Hash;
  381 }
  382 
  383 sub CL_getStudentName  {
  384         my($user) = @_;
  385         my($fname) = &CL_getStudentFirstName($user);
  386         my($lname) = &CL_getStudentLastName($user);
  387         $fname = '' unless defined $fname;
  388         $lname = '' unless defined $lname;
  389         my($out) = "$fname $lname";
  390         $out =~ s/\s\s+/ /g;     # remove any extra spaces
  391         $out;
  392         }
  393 
  394 #### this will break if the codes are changed !!!!!!!! ###############
  395 
  396 sub CL_byLastName {
  397 
  398             $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
  399             my $ln1 = $1;   # last name sorted first
  400             $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
  401             my $fn1= $1;    # then first name
  402 
  403             $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
  404             my $ln2 = $1;
  405             $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
  406             my $fn2= $1;
  407 
  408             my $t = lc($ln1) cmp lc($ln2); # compare last name
  409             $t = lc($fn1) cmp lc($fn2)  unless $t; # if last names equal, compare first names
  410             $t;
  411 }
  412 #### this will break if the codes are changed !!!!!!!! ###############
  413 sub CL_bySectionThenByName {
  414 
  415     $MYCLASSLIST{$a} =~ /clsn=([^&]*)/;
  416     my $cs1 = $1;   # class section sorted first
  417     $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
  418     my $ln1 = $1;   # then last name
  419     $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
  420     my $fn1= $1;    # then first name
  421 
  422     $MYCLASSLIST{$b} =~ /clsn=([^&]*)/;
  423     my $cs2 = $1;
  424     $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
  425     my $ln2 = $1;
  426     $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
  427     my $fn2= $1;
  428 
  429 
  430     my $t = $cs1 cmp $cs2; # compare class section
  431     $t = lc($ln1) cmp lc($ln2)  unless $t; # if class sections are equal compare last name
  432     $t = lc($fn1) cmp lc($fn2)  unless $t; # if last names equal, compare first names
  433     $t;
  434 }
  435 
  436 #### this will break if the codes are changed !!!!!!!! ###############
  437 sub CL_byRecitationThenByName {
  438 
  439     $MYCLASSLIST{$a} =~ /clrc=([^&]*)/;
  440     my $cs1 = $1;   # class recitation sorted first
  441     $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
  442     my $ln1 = $1;   # then last name
  443     $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
  444     my $fn1= $1;    # then first name
  445 
  446     $MYCLASSLIST{$b} =~ /clrc=([^&]*)/;
  447     my $cs2 = $1;
  448     $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
  449     my $ln2 = $1;
  450     $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
  451     my $fn2= $1;
  452 
  453 
  454     my $t = $cs1 cmp $cs2; # compare class recitation
  455     $t = lc($ln1) cmp lc($ln2)  unless $t; # if class recitations are equal compare last name
  456     $t = lc($fn1) cmp lc($fn2)  unless $t; # if last names equal, compare first names
  457     $t;
  458 }
  459 
  460 
  461 
  462 
  463 
  464 1;
  465 
  466 
  467 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9