[system] / trunk / webwork / system / cgi / cgi-scripts / profImportClasslistDatabase.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/cgi/cgi-scripts/profImportClasslistDatabase.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (download) (as text) (annotate)
Thu Jun 14 17:08:51 2001 UTC (11 years, 11 months ago) by sam
File size: 14967 byte(s)
initial import

    1 #!/usr/bin/perl
    2 
    3 ## This file is profExportClasslistDatabase.pl
    4 ##
    5 
    6 ####################################################################
    7 # Copyright @ 1995-2000 University of Rochester
    8 # All Rights Reserved
    9 ####################################################################
   10 
   11 use lib '/ww/webwork/development/'; # mainWeBWorKDirectory;
   12 use CGI qw(:standard);
   13 use Global;
   14 use Auth;
   15 use strict;
   16 use GDBM_File;
   17 
   18 my $cgi = new CGI;
   19 my %inputs = $cgi->Vars();
   20 
   21 # get information from CGI inputs  (see also below for additional information)
   22 
   23 my $Course      = $inputs{'course'};
   24 my $User      = $inputs{'user'};
   25 my $Session_key   = $inputs{'key'};
   26 
   27 # verify that information has been received
   28   unless($Course && $User && $Session_key) {
   29     &wwerror("$0","The script did not receive the proper input data.","","");
   30     }
   31 
   32 # establish environment for this script
   33 
   34 &Global::getCourseEnvironment($Course);
   35 
   36 
   37 my $scriptsDirectory    = getWebworkScriptDirectory;
   38 my $databaseDirectory   = getCourseDatabaseDirectory;
   39 my $templateDirectory   = getCourseTemplateDirectory;
   40 my $cgiURL          = getWebworkCgiURL;
   41 my $CL_Database       = $Global::CL_Database;
   42 my $path_to_CL_DB     = "${databaseDirectory}$CL_Database";
   43 # File names
   44 
   45 require "${scriptsDirectory}$Global::HTMLglue_pl";
   46 require "${scriptsDirectory}$Global::DBglue_pl";
   47 require "${scriptsDirectory}$Global::classlist_DBglue_pl";
   48 require "${scriptsDirectory}$Global::FILE_pl";;
   49 my $DELIM = $Global::delim;
   50 
   51 # log access
   52   &Global::log_info('', query_string);
   53 
   54 my $passwordFile = &Global::getCoursePasswordFile($Course);
   55 my $permissionsFile = &Global::getCoursePermissionsFile($Course);
   56 my $permissions = &get_permissions($inputs{'user'}, $permissionsFile);
   57 my $keyFile = &Global::getCourseKeyFile($Course);
   58 
   59 #verify session key
   60 &verify_key($inputs{'user'}, $inputs{'key'}, $keyFile, $Course);
   61 
   62 # verify permissions are correct
   63 if ($permissions != $Global::instructor_permissions ) {
   64   print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n";
   65   print &html_NO_PERMISSION;
   66   exit(0);
   67 }
   68 # get the rest of the information from the submitted form
   69 
   70 my $classlistFilename   = $inputs{'classList'};
   71 my $update_firstName    = $inputs{'update_firstName'};
   72 my $update_lastName     = $inputs{'update_lastName'};
   73 my $update_status     = $inputs{'update_status'};
   74 my $update_comment      = $inputs{'update_comment'};
   75 my $update_section      = $inputs{'update_section'};
   76 my $update_recitation   = $inputs{'update_recitation'};
   77 my $update_email_address  = $inputs{'update_email_address'};
   78 my $update_drop       = $inputs{'update_drop'};  ## either 'drop', 'leave', or 'remove'
   79 
   80 $update_firstName   = 0 unless defined  $update_firstName;
   81 $update_lastName    = 0 unless defined  $update_lastName;
   82 $update_status      = 0 unless defined  $update_status;
   83 $update_comment     = 0 unless defined  $update_comment;
   84 $update_section     = 0 unless defined  $update_section;
   85 $update_recitation    = 0 unless defined  $update_recitation;
   86 $update_email_address = 0 unless defined  $update_email_address;
   87 
   88 my $CL_status = get_CL_database_status();
   89 wwerror('Classlist Database is unlocked', 'You must go back and lock the classlist database
   90   before you can export it to an ascii file.') unless $CL_status eq 'locked';
   91 
   92 wwerror('No classlist file selected', 'You must go back and select a classlist file.')
   93   unless $classlistFilename =~ /\w/;
   94 
   95 my $msg1 = updateClasslistDB($classlistFilename);
   96 
   97 my $msg2 = initial_passwords();
   98 
   99 my $msg3 = "$msg1" . "$msg2";
  100 
  101 uploadSuccess("$msg3");
  102 
  103 exit;  ## end of main script
  104 
  105 sub updateClasslistDB { ## builds the classlist DB and returns a message
  106 
  107   my ($classlistFilename) = @_;
  108 
  109   #get data from class list.
  110   my $fileName="${templateDirectory}$classlistFilename";  ## e.g. fileName=m161.lst
  111 
  112   my $message = "\nGetting classlist file from: $fileName <BR>\n";
  113   checkClasslistFile($Global::noOfFieldsInClasslist,$fileName);
  114   open(FILE, "$fileName") || wwerror($0, "Can't open $fileName");
  115   my @classList=<FILE>;
  116   close(FILE);
  117 
  118   ###################################
  119   #  Before updating the database we back it up
  120   ###################################
  121   if ( -e "$path_to_CL_DB" ) {
  122     $message .= "Backing up current classlist database to: ${path_to_CL_DB}_bak1 <BR>\n";
  123     &backup($path_to_CL_DB);
  124   }
  125 
  126   my %loginName_StudentID_Hash = %{getLoginName_StudentID_Hash()};
  127   my %studentID_LoginName_Hash =%{getStudentID_LoginName_Hash()};
  128 
  129   my $WW_DB_exists = 0;
  130   $WW_DB_exists = 1 if ( -e "${databaseDirectory}$Global::database" );
  131 
  132   my %loginName_StudentID_Hash_from_WW_DB =();
  133   my %studentID_LoginName_Hash_from_WW_DB =();
  134 
  135   if ($WW_DB_exists) {
  136     %loginName_StudentID_Hash_from_WW_DB =%{getLoginName_StudentID_Hash_from_WW_DB()};
  137     %studentID_LoginName_Hash_from_WW_DB = reverse %loginName_StudentID_Hash_from_WW_DB;
  138   }
  139 
  140   my $errors ='';
  141   my %new_good_classlist_students =();    ## students in new classlist without conflicts
  142   my %new_bad_classlist_students =();   ## students in new classlist with conflicts
  143 
  144 
  145   foreach (@classList)     {          ## read through classlist and create
  146                         ## class list database
  147     unless ($_ =~ /\S/)  {next;}      ## skip blank lines
  148     chomp;
  149     my @classListRecord=&getRecord($_);
  150     my ($studentID, $lastName, $firstName, $status, $comment,  $section, $recitation, $email_address, $login_name)
  151         =  @classListRecord;
  152 
  153     ## First we get a list of any conflicts with current students
  154     if ((defined $loginName_StudentID_Hash{$login_name})
  155       and ($loginName_StudentID_Hash{$login_name} ne $studentID)) {
  156       $errors .= "$firstName $lastName, $login_name, $studentID <BR>\n ";
  157       $new_bad_classlist_students{$login_name} =1;
  158       next;
  159     }
  160 
  161     if ((defined $studentID_LoginName_Hash{$studentID})
  162       and ($studentID_LoginName_Hash{$studentID} ne $login_name)) {
  163       $errors .= "$firstName $lastName, $login_name, $studentID <BR>\n ";
  164       $new_bad_classlist_students{$login_name} =1;
  165       next;
  166     }
  167 
  168     if (($WW_DB_exists) and (defined $loginName_StudentID_Hash_from_WW_DB{$login_name})
  169       and ($loginName_StudentID_Hash_from_WW_DB{$login_name} ne $studentID)) {
  170       $errors .= "$firstName $lastName, $login_name, $studentID <BR>\n ";
  171       $new_bad_classlist_students{$login_name} =1;
  172       next;
  173     }
  174 
  175     if (($WW_DB_exists) and (defined $studentID_LoginName_Hash_from_WW_DB{$studentID})
  176       and ($studentID_LoginName_Hash_from_WW_DB{$studentID} ne $login_name)) {
  177       $errors .= "$firstName $lastName, $login_name, $studentID <BR>\n ";
  178       $new_bad_classlist_students{$login_name} =1;
  179       next;
  180     }
  181 
  182     ## OK, the student record has no conflicts
  183 
  184     $new_good_classlist_students{$login_name} =1;
  185 
  186     ## Handle students already in classlist DB
  187     if (defined $loginName_StudentID_Hash{$login_name}) {
  188       &attachCLRecord($login_name);
  189       &CL_putStudentLastName     ($lastName, $login_name)       if $update_firstName;
  190       &CL_putStudentFirstName    ($firstName, $login_name)      if $update_lastName;
  191       &CL_putStudentStatus       ($status, $login_name)         if $update_status;
  192       &CL_putComment             ($comment, $login_name)        if $update_comment;
  193       &CL_putClassSection        ($section,$login_name)         if $update_section;
  194       &CL_putClassRecitation     ($recitation,$login_name)      if $update_recitation;
  195       &CL_putStudentEmailAddress ($email_address, $login_name)  if $update_email_address;
  196       $Global::over_ride_CLBD_lock = 1;
  197       &saveCLRecord($login_name);
  198       $Global::over_ride_CLBD_lock = 0;
  199 
  200       if  (($WW_DB_exists) and (defined $loginName_StudentID_Hash_from_WW_DB{$login_name})) {
  201         my %setNumberHash=&getAllSetNumbersForStudentLoginHash($login_name);
  202         my @PSVNs = values %setNumberHash;
  203         my $psvn;
  204         foreach $psvn (@PSVNs) {
  205           attachProbSetRecord($psvn);
  206           putStudentLastName(   $lastName ,$psvn)   if $update_lastName;
  207           putStudentFirstName(  $firstName  ,$psvn)   if $update_firstName;
  208           putStudentStatus(   $status     ,$psvn)   if $update_status;
  209           putClassSection(    $section  ,$psvn)   if $update_section;
  210           putClassRecitation(   $recitation ,$psvn)   if $update_recitation;
  211           putStudentEmailAddress( $email_address,$psvn) if $update_email_address;
  212           detachProbSetRecord($psvn);
  213         }
  214       }
  215     }
  216     else {        ## Handle new students
  217       &CL_putStudentID           ($studentID, $login_name);
  218       &CL_putStudentLastName     ($lastName, $login_name);
  219       &CL_putStudentFirstName    ($firstName, $login_name);
  220       &CL_putStudentStatus       ($status, $login_name);
  221       &CL_putComment             ($comment, $login_name);
  222       &CL_putClassSection        ($section,$login_name);
  223       &CL_putClassRecitation     ($recitation,$login_name);
  224       &CL_putStudentEmailAddress ($email_address, $login_name);
  225       $Global::over_ride_CLBD_lock = 1;
  226       &saveCLRecord($login_name);
  227       $Global::over_ride_CLBD_lock = 0;
  228 
  229       if  (($WW_DB_exists) and (defined $loginName_StudentID_Hash_from_WW_DB{$login_name})) {
  230         my %setNumberHash=&getAllSetNumbersForStudentLoginHash($login_name);
  231         my @PSVNs = values %setNumberHash;
  232         my $psvn;
  233         foreach $psvn (@PSVNs) {
  234           attachProbSetRecord($psvn);
  235           putStudentLastName(   $lastName ,$psvn);
  236           putStudentFirstName(  $firstName,$psvn);
  237           putStudentStatus(   $status ,$psvn);
  238           putClassSection(    $section  ,$psvn);
  239           putClassRecitation(   $recitation ,$psvn);
  240           putStudentEmailAddress( $email_address  ,$psvn);
  241           detachProbSetRecord($psvn);
  242         }
  243       }
  244     }
  245 
  246   }
  247 
  248   ## Now we take care of students who are in the current classlist database but are not in
  249   ## the classlist file.
  250 
  251   my %drop_list =();
  252   my $login_name;
  253   %loginName_StudentID_Hash = %{getLoginName_StudentID_Hash()};
  254   foreach $login_name (keys %loginName_StudentID_Hash) {
  255     $drop_list{$login_name} = 1 unless (
  256       (defined ($new_good_classlist_students{$login_name})) or (defined ($new_bad_classlist_students{$login_name}))
  257     );
  258   }
  259   if  ($update_drop eq 'drop')  {
  260     my $status = 'D';
  261     $status = $Global::statusDrop[0] if defined $Global::statusDrop[0];
  262     foreach $login_name (keys %drop_list) {
  263       &attachCLRecord($login_name);
  264       &CL_putStudentStatus($status, $login_name);
  265       $Global::over_ride_CLBD_lock = 1;
  266       &saveCLRecord($login_name);
  267       $Global::over_ride_CLBD_lock = 0;
  268     }
  269   }
  270   elsif ($update_drop eq 'remove') {
  271     foreach $login_name (keys %drop_list) {
  272       $Global::over_ride_CLBD_lock = 1;
  273       deleteClassListRecord($login_name);
  274       $Global::over_ride_CLBD_lock = 0;
  275     }
  276   }
  277   else {  ## if this case $update_drop eq 'leave' and we do nothing
  278   }
  279 
  280   unlock_CL_database();
  281   if ($errors) {
  282     $message .= '<BR>The following students HAVE NOT BEEN ENTERED IN THE CLASSLIST DATABASE
  283     because of a conflict with entries in the WeBWorK problem set database or the classlist database.
  284     These students have a studentID or a loginName that conflicts with a current student.
  285     Enter this information again from the Add Student(s) Page to get a more detailed error message
  286     and instructions on how to correct the problem.<BR><BR>';
  287     $message .= "\n $errors<BR>";
  288   }
  289   $message;
  290 }
  291 
  292 sub initial_passwords {
  293   my %studentsinclass=();
  294   my @classListRecord=();
  295   my $msg ='';
  296 
  297   # Check that the files exist:
  298   #    The permissions file must exist and have both read and write privilages.
  299   #    The password file must exist and have both read and write privilages.
  300 
  301 
  302   unless ( -r $passwordFile and -w $passwordFile) {
  303     wwerror ($0, "Permissions set incorrectly on $passwordFile or its directory.
  304        Cannot access file to both read and write.");
  305   }
  306 
  307   unless ( -r $permissionsFile and -w $permissionsFile) {
  308     wwerror ($0, "Permissions set incorrectly on $permissionsFile or its directory.
  309        Cannot access file to both read and write.");
  310   }
  311 
  312   my $login_name;
  313 
  314   my @classList = @{getAllLoginNames()};
  315 
  316   $msg .= "\n<BR><BR> Modifying the password file :\n   $passwordFile <BR>\n ";
  317 
  318   foreach $login_name (@classList)   {      ## read through classlist database and create
  319                           ## passwords for all active students
  320                           ## except if passwords already exist for student
  321     attachCLRecord($login_name);
  322 
  323     my $status    = CL_getStudentStatus($login_name);
  324     my $studentID = CL_getStudentID($login_name);
  325 
  326     $studentsinclass{$login_name}++ unless(&dropStatus($status));
  327 
  328     if(&dropStatus($status)) {
  329       $msg .= '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'."$login_name not added because status is $status <BR>\n ";
  330     }
  331     elsif (&get_password($login_name, $passwordFile)) {
  332       $msg .= '&nbsp;&nbsp;&nbsp;'."$login_name not added because password already exists <BR>\n ";
  333     }
  334     else {
  335       &new_password($login_name, $studentID, $passwordFile);
  336       &put_permissions(0,$login_name,$permissionsFile);
  337       $msg .= "added: $login_name, $studentID <BR>\n ";
  338     }
  339   }
  340 
  341   my @pwStudents = &get_keys_from_db($passwordFile);
  342   my ($ans,$student);
  343 
  344 
  345   $msg .= "\n<BR<BR><BR> The following login's (if any) in the password and permissions databases are either\n ";
  346   $msg .= "(1) not listed  in the new class list database file \n";
  347   $msg .= "or (2) have DROP status in the new class list database file.\n";
  348   $msg .= "They will all be removed from the password and permissions databases.<BR><BR>\n ";
  349 
  350   foreach $student (@pwStudents) {
  351     next if defined($studentsinclass{$student});
  352 
  353     &delete_password($student,$passwordFile);
  354     &delete_permissions($student,$permissionsFile);
  355     $msg .= "$student<BR>\n ";
  356   }
  357 
  358 # ## if the owner of the password file is running this script (e.g. when the password file is first created)
  359 # ## set the permissions correctly
  360 #
  361 # open (PASSWORDFILE, "$passwordFile") or wwerror($0, "Can't open $passwordFile");
  362 # my @stat = stat PASSWORDFILE;
  363 # close PASSWORDFILE;
  364 #
  365 # if ($< == $stat[4]) {
  366 #
  367 #   chmod($Global::password_permission, $passwordFile) or
  368 #                wwerror($0, "Can't do chmod($Global::password_permission, $passwordFile)");
  369 #   chown(-1,$Global::numericalGroupID,$passwordFile)  or
  370 #                wwerror($0, "Can't do chown(-1,$Global::numericalGroupID,$passwordFile)");
  371 # }
  372 #
  373 # open (PERMISSIONSFILE, "$permissionsFile") or wwerror($0, "Can't open $permissionsFile");
  374 # @stat = stat PERMISSIONSFILE;
  375 # close PERMISSIONSFILE;
  376 #
  377 # if ($< == $stat[4]) {
  378 #
  379 #   chmod($Global::permissions_permission, $permissionsFile) or
  380 #               wwerror($0, "Can't do chmod($Global::permissions_permission, $permissionsFile)");
  381 #   chown(-1,$Global::numericalGroupID,$permissionsFile)  or
  382 #               wwerror($0, "Can't do chown(-1,$Global::numericalGroupID,$permissionsFile)");
  383 # }
  384 $msg;
  385 }
  386 
  387 
  388 sub uploadSuccess {
  389   my ($msg) = @_;
  390   print"content-type: text/html\n\n<H2>Success, the classlist database has been updated. </H2>\n";
  391   print $msg;
  392   print &htmlBOTTOM("profImportClasslistDatabase.pl", \%inputs);
  393 }
  394 
  395 sub backup  {
  396   ## takes as a parameter the full path name
  397   ## makes upto two backups of the file with _bak1, or _bak2
  398   ## appended to filename where _bak1 is the most recent backup
  399   use File::Copy;
  400   my $fileName =$_[0];
  401 
  402   if (-e "${fileName}_bak1") {
  403     rename("${fileName}_bak1","${fileName}_bak2") or
  404       &wwerror("$0","can't rename ${fileName}_bak1");
  405   }
  406 
  407   if (-e "${fileName}") {
  408     copy("${fileName}","${fileName}_bak1") or
  409       &wwerror("$0","can't copy ${fileName}");
  410   }
  411 }
  412 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9