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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 11 - (download) (as text) (annotate)
Mon Jun 18 15:21:51 2001 UTC (18 years, 6 months ago) by sam
File size: 41671 byte(s)
another setup script test (changed #! lines)

    1 #!/usr/local/bin/webwork-perl
    2 
    3 ## $Id$
    4 
    5 ####################################################################
    6 # Copyright @ 1995-1998 University of Rochester
    7 # All Rights Reserved
    8 ####################################################################
    9 
   10 # #############################################################
   11 # #############################################################
   12 #  File: FILE.pl
   13 #  This contains the subroutines for  creating problem files,
   14 #  recording scores, printing delimited files, etc.
   15 # #############################################################
   16 # #############################################################
   17 use strict;
   18 
   19 
   20 # Variables global to this file
   21 
   22 my  $scoringDirectory   =   getCourseScoringDirectory();
   23 my  $templateDirectory  =   getCourseTemplateDirectory();
   24 my  $scriptDirectory    =   getWebworkScriptDirectory();
   25 my  $databaseDirectory  =   getCourseDatabaseDirectory();
   26 
   27 my  $DELIM = $Global::delim;
   28 my  $scoreFilePrefix = $Global::scoreFilePrefix;
   29 my  $scoring_log = $Global::scoring_log;
   30 my  $dash = $Global::dash;
   31 my  $DAT = $Global::dat;
   32 my  @STATUS_DROP = @Global::statusDrop;
   33 
   34 my  $dd = getDirDelim();
   35 
   36 
   37 
   38 
   39 sub round_score {
   40     my $num = shift;
   41     my $rounding_dem = 10**$Global::score_decimal_digits;
   42     int($num*$rounding_dem + .5)/$rounding_dem;
   43 }
   44 
   45 
   46 sub readSetDef {
   47     my ($fileName) = @_;
   48     my $setNumber = '';
   49     my $shortFileName = fileFromPath($fileName);
   50     if ($shortFileName =~ m|^set(\w+)\.def$|) {$setNumber = $1;}
   51     else {
   52         wwerror("$0",  "The setDefinition file name must begin with   <CODE>set</CODE>
   53 and must end with   <CODE>.def</CODE>  . Every thing in between becomes the name of the set.
   54 For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE>
   55 define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. The
   56 filename, $shortFileName, you entered is not legal\n");
   57     }
   58 
   59     my ($line,$name,$value,$attemptLimit);
   60     open (SETFILENAME, "$fileName") or wwerror("$0",  "Can't open file $fileName\n");
   61     my $setHeaderFileName = '';
   62     my $probHeaderFileName = '';
   63     my @problemList=();
   64     my @problemValueList=();
   65     my @problemAttemptLimitList=();
   66     my ($dueDate,$openDate,$answerDate);
   67     my ($problemListref,$problemValueListref,$problemAttemptLimitListref);
   68     while (<SETFILENAME>) {
   69         chomp($line = $_);
   70         $line =~ s|(#.*)||;                             ## don't read past comments
   71         unless ($line =~ /\S/) {next;}                  ## skip blank lines
   72         $line =~ s|\s*$||;                               ## trim trailing spaces
   73         $line =~ m|^\s*(\w+)\s*=\s*(.*)|;
   74         if ($1 eq 'setNumber') {next;}
   75         elsif ($1 eq 'paperHeaderFile') {$setHeaderFileName = $2;}
   76         elsif ($1 eq 'screenHeaderFile') {$probHeaderFileName = $2;}
   77         elsif ($1 eq 'dueDate') {$dueDate = $2;}
   78         elsif ($1 eq 'openDate') {$openDate = $2;}
   79         elsif ($1 eq 'answerDate') {$answerDate = $2;}
   80         elsif ($1 eq 'problemList') {last;}
   81         else {wwerror("$0", "readSetDef error, can't read the line: $line");}
   82     }
   83 
   84     my $time1 = &unformatDateAndTime($openDate);
   85     my $time2 = &unformatDateAndTime($dueDate);
   86     my $time3 = &unformatDateAndTime($answerDate);
   87     if ($time2 < $time1 or $time3 < $time2) {
   88         &Global::error('File.pl: readSetDef error', "The open date: $openDate, due date: $dueDate, and answer date: $answerDate
   89         must be in chronologicasl order.");
   90     }
   91 
   92     $setHeaderFileName =~ s/(.*?)\s*$/$1/;   #remove trailing white space
   93     $probHeaderFileName =~ s/(.*?)\s*$/$1/;   #remove trailing white space
   94 
   95  #   print "setNumber: $setNumber\ndueDate: $dueDate\nopenDate: $openDate\nanswerDate: $answerDate\n";
   96     while(<SETFILENAME>) {
   97         chomp($line=$_);
   98         $line =~ s/(#.*)//;                             ## don't read past comments
   99         unless ($line =~ /\S/) {next;}                  ## skip blank lines
  100 
  101         ($name, $value, $attemptLimit) = split (/\s*,\s*/,$line);
  102         $name =~ s/\s*//g;
  103         push(@problemList, $name);
  104         $value = "" unless defined($value);
  105         $value =~ s/[^\d]*//g;
  106         unless ($value =~ /\d+/) {$value = 1;}
  107         push(@problemValueList, $value);
  108         $attemptLimit = "" unless defined($attemptLimit);
  109         $attemptLimit =~ s/[^\d-]*//g;
  110         unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;}
  111 
  112         push(@problemAttemptLimitList, $attemptLimit);
  113     }
  114     close(SETFILENAME);
  115     #print "problemList: @problemList\n";
  116     #print "problemValueList: @problemValueList\n";
  117     #print "problemAttemptLimitList: @problemAttemptLimitList\n";
  118     $problemListref = \@problemList;
  119     $problemValueListref = \@problemValueList;
  120     $problemAttemptLimitListref = \@problemAttemptLimitList;
  121     ($setNumber,$setHeaderFileName,$probHeaderFileName,$dueDate,$openDate,$answerDate,$problemListref,$problemValueListref,$problemAttemptLimitListref);
  122 }
  123 
  124 sub max  {  ## find the max element of array
  125     my $out = $_[0];
  126     my $num;
  127     foreach $num (@_) {
  128         if ((defined $num) and ($num > $out)) {$out = $num;}
  129     }
  130     $out;
  131 }
  132 
  133 sub min  {  ## find the max element of array
  134     my $out = $_[0];
  135     my $num;
  136     foreach $num (@_) {
  137         if ((defined $num) and ($num < $out)) {$out = $num;}
  138     }
  139     $out;
  140 }
  141 
  142 sub getFieldLengths {
  143 
  144     ## takes as a parameter the  reference to a delimited array
  145     ## (such as you would get by reading in a delimited file)
  146     ## where each element is a line from a delimited file.
  147     ## returns an array which holds
  148     ## the maximum field lengths in the file.
  149 
  150     my ($datFileArray_ref)=@_;
  151     my($i);
  152     my(@datArray,@fieldLength,@datFileArray, $line);
  153     @fieldLength=();
  154     @datFileArray=@$datFileArray_ref;
  155 
  156     foreach $line (@datFileArray)   {    ## read through file and get field lengths
  157         unless ($line =~ /\S/)  {next;}  ## skip blank lines
  158         chomp $line;
  159         @datArray=&getRecord($line);
  160         for ($i=0; $i <=$#datArray; $i++) {
  161             $fieldLength[$i] = 0 unless defined $fieldLength[$i];
  162             $fieldLength[$i]=&max(length("$datArray[$i]"),$fieldLength[$i]);
  163         }
  164     }
  165     return (@fieldLength);
  166 }
  167 
  168 
  169 sub columnArrayArrange  {
  170 
  171 ## takes as a parameter a delimited array
  172 ## (such as you would get by reading in a delimited file)
  173 ## where each element is a line from a delimited file.
  174 
  175 # Outputs an array which adds
  176 # extra space if necessary to the fields so that all columns line up.
  177 # The widest field in any column will contain exactly 1 spaces at the
  178 # end of the (non space characters of the) field. For example
  179 # ",a very long field entry ," at one extreme and  ", ," at the other
  180 
  181     my @inFile=@_;
  182     my($i,$tempFileName,$datString,$line);
  183     my @outFile =();
  184     my(@fieldLength,@datArray);
  185     $i=1;
  186 
  187     @fieldLength=&getFieldLengths(\@inFile);
  188     foreach $line (@inFile)   {    ## read through file array and get field lengths
  189         unless ($line =~ /\S/)  {next;}    ## skip blank lines
  190         chomp $line;
  191         @datArray=&getRecord($line);
  192         for ($i=0; $i <=$#datArray; $i++) {
  193             $datArray[$i].=(" " x ($fieldLength[$i]+1-length("$datArray[$i]")));
  194         }
  195         $datString=join("${DELIM}",@datArray);
  196         push @outFile , "$datString\n";
  197     }
  198     @outFile;
  199 }
  200 
  201 
  202 sub columnPrint {
  203 
  204 # Takes two parameters.  The first is the filename of the
  205 # delimited input file.  The second is the name of the
  206 # output file (these names may be the same).  The permissions
  207 # and group of the output file will be the same as the
  208 # input file
  209 
  210 # Takes any delimited (with \$DELIM delimiters) file and adds
  211 # extra space if necessary to the fields so that all columns line up.
  212 # The widest field in any column will contain exactly 2 spaces at the
  213 # end of the (non space characters 0f the) field. For example
  214 # ",a very long field entry  ," at one extreme and  ",  ," at the other
  215 #
  216     my($inFileName,$outFileName)=@_;
  217     my($line);
  218 
  219     my ($permission, $gid) = (stat($inFileName))[2,5];
  220     $permission =  ($permission & 0777);    ##get rid of file type stuff
  221 
  222     open(INFILE,"$inFileName") or wwerror("$0","can't open $inFileName for reading");
  223     my @inFile=<INFILE>;
  224     close(INFILE);
  225 
  226     &createFile($outFileName, $permission, $gid);
  227 
  228     my @outFile = &columnArrayArrange(@inFile);
  229 
  230     open(OUTFILE,">$outFileName")   or wwerror("$0","can't open $outFileName for writing");
  231     foreach $line (@outFile) {print OUTFILE $line;}
  232     close(OUTFILE);
  233 }
  234 
  235 sub getRecord
  236 
  237         #       Takes a delimited line as a parameter and returns an
  238         #       array.  Note that all white space is removed.  If the
  239         #       last field is empty, the last element of the returned
  240         #       array is also empty (unlike what the perl split command
  241         #       would return).  E.G. @lineArray=&getRecord(\$delimitedLine).
  242         {
  243     my $DELIM = $Global::delim;
  244         my($line) = $_[0];
  245         my(@lineArray);
  246         $line.='A';                                     # add 'A' to end of line so that
  247                                                         # last field is never empty
  248         @lineArray = split(/\s*${DELIM}\s*/,$line);
  249         $lineArray[$#lineArray] =~s/\s*A$//;            # remove spaces and the 'A' from last element
  250         $lineArray[0] =~s/^\s*//;                       # remove white space from first element
  251         @lineArray;
  252         }
  253 
  254 
  255 
  256 
  257 sub delim2aa    {
  258 
  259         #       Takes a delimited file as a parameter and returns an
  260         #       associative array with the first field as the key.
  261         #       Blank lines are skipped. White space is removed
  262 
  263         my $fileName =$_[0];
  264         my(@dbArray,$key,%assocArray,$dbString);
  265         open(FILE, "$fileName") or wwerror("$0","can't open $fileName");
  266         while (<FILE>)
  267             {
  268             unless ($_ =~ /\S/)  {next;}               ## skip blank lines
  269             chomp;
  270             @dbArray=&getRecord($_);
  271             $key=shift(@dbArray);
  272             $dbString=join("${DELIM}",@dbArray);
  273             $assocArray{$key}=$dbString;
  274             }
  275         close(FILE);
  276         %assocArray;
  277 }
  278 sub dropStatus
  279 
  280     #       Takes one parameter \$status and returns 1 if \$status matches a word in the
  281     #       \@STATUS_DROP global array, 0 otherwise. E.G. if ($dropStatus(\$status) {...}
  282     #   where \$status is the entry in the status field of the class list. \@STATUS_DROP
  283     #   is a global array defined in webwork.ph
  284         {
  285         my($tag) = 0;
  286         my($status) = $_[0];
  287         my($statusItem);
  288         foreach $statusItem (@STATUS_DROP)
  289                 {
  290                  if ($status =~ /^\s*$statusItem\s*$/i) {$tag = 1;}
  291 
  292                 }
  293         $tag;
  294         }
  295 
  296 
  297 sub beforeOpenDateMsg {
  298     my ($OpenDate) = @_;
  299     my $out = " --- <em>Before open date</em> -- ";
  300     $out .= "Open date is: $OpenDate <BR>";
  301     $out;
  302 };
  303 sub afterOpenDateMsg { #and before Due Date
  304     my ($DueDate) = @_;
  305     my $out = " --- <em><B>OPEN</B></em>";
  306     $out .= " --  Due date is: $DueDate <BR>";
  307     $out;
  308 };
  309 sub afterDueDateMsg { #and before AnswerDate
  310     my ($AnswerDate) = @_;
  311     my $out = " --- <em><B>CLOSED</B></em> --";
  312     $out .= " Answers available on: $AnswerDate <BR>";
  313     $out;
  314 };
  315 sub afterAnswerDateMsg {
  316     my $out = " --- <em><B>CLOSED</B></em> -- ";
  317     $out .= " answers available.<BR>";
  318     $out;
  319 };
  320 
  321 
  322 sub problemDates {
  323     my ($OpenDate,$DueDate,$AnswerDate) = @_;
  324     my $out = <<ENDproblemDatesHTML;
  325  <PRE>
  326                                   Open:   $OpenDate
  327                                   <B>Due:    $DueDate</B>
  328                                   Answer: $AnswerDate
  329  </PRE>
  330 ENDproblemDatesHTML
  331 
  332     $out;
  333 }
  334 
  335 sub formatDateAndTime {
  336     my ($timeStamp)=@_;
  337     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  338     localtime($timeStamp);
  339     my $twelveHour;
  340     if($min<10){$min= "0" . $min;}
  341 
  342     if($hour==0){$twelveHour = 12 . ":" . $min . " AM";}
  343     elsif($hour<12){$twelveHour= $hour . ":" . $min . " AM";}
  344     elsif($hour==12){$twelveHour = $hour . ":" . $min . " PM";}
  345     else    {$twelveHour = ($hour-12) . ":" . $min . " PM";}
  346 
  347     if($year>99){$year = $year -100;}
  348     if($year<10){$year= "0" . $year;}
  349 
  350     my $returnTimeString = ($mon+1) . "/" . $mday . "/" . $year . " at " . $twelveHour;
  351     $returnTimeString;
  352 }
  353 
  354 
  355 sub unformatDateAndTime {
  356     my ($string) = @_;
  357     my $orgString =$string;
  358     $string =~ s|^\s+||;
  359     $string =~ s|\s+$||;
  360     $string =~ s|at| at |i; ## OK if forget to enter spaces or use wrong case
  361     $string =~ s|AM| AM|i;  ## OK if forget to enter spaces or use wrong case
  362     $string =~ s|PM| PM|i;  ## OK if forget to enter spaces or use wrong case
  363     $string =~ s|,| at |;   ## start translating old form of date/time to new form
  364 
  365     my($date,$at,$time,$AMPM) = split(/\s+/,$string);
  366     unless ($time =~ /:/) {
  367         {  ##bare block for 'case" structure
  368             $time =~ /(\d\d)(\d\d)/;
  369             my $tmp_hour = $1;
  370             my $tmp_min = $2;
  371             if ($tmp_hour eq '00') {$time = "12:$tmp_min"; $AMPM = 'AM';last;}
  372             if ($tmp_hour eq '12') {$time = "12:$tmp_min"; $AMPM = 'PM';last;}
  373             if ($tmp_hour < 12) {$time = "$tmp_hour:$tmp_min"; $AMPM = 'AM';last;}
  374             if ($tmp_hour < 24) {
  375                 $tmp_hour = $tmp_hour - 12;
  376                 $time = "$tmp_hour:$tmp_min";
  377                 $AMPM = 'PM';
  378             }
  379         }  ##end of bare block for 'case" structure
  380 
  381     }
  382 
  383     my ($mday, $mon, $year, $wday, $yday,$sec, $pm, $min, $hour);
  384     $sec=0;
  385     $time =~ /^([0-9]+)\s*\:\s*([0-9]*)/;
  386     $min=$2;
  387     $hour = $1;
  388     if ( $hour < 1 or $hour > 12 or $min < 0 or $min > 59) {
  389         &Global::error('File.pl: unformatDateAndTime error', "Incorrect date/time format $orgString. Correct format is 9/13/02 at 12:15 PM");
  390     }
  391     $pm = 0;
  392     $pm = 12 if ($AMPM =~/PM/ and $hour < 12);
  393     $hour += $pm;
  394     $hour = 0 if ($AMPM =~/AM/ and $hour == 12);
  395     $date =~  m!([0-9]+)\s*/\s*([0-9]+)/\s*([0-9]+)! ;
  396     $mday =$2;
  397     $mon=($1-1);
  398     if ( $mday < 1 or $mday > 31 or $mon < 0 or $mon > 11) {
  399         &Global::error('File.pl: unformatDateAndTime error', "Incorrect date/time format $orgString. Correct format is 9/13/02 at 12:15 PM");
  400     }
  401     $year=$3;
  402     $wday="";
  403     $yday="";
  404     timelocal ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday);
  405 }
  406 
  407 sub texInput
  408 
  409     ## Similar to the TeX input command.  Takes a filename (with or without extension)
  410     ## which is assumed to be in the \$templateDirectory.
  411     ## E.G. print OUTFILE &texInput("file.tex");
  412     ## or   print OUTFILE &texInput("file");
  413 
  414         {
  415     my $texInFile = $_[0];
  416     my $texString;
  417     if ($texInFile eq "") {
  418         $texString = '';
  419         }   else    {
  420             unless ($texInFile =~ m#\.#) {$texInFile .= '.tex';}
  421                 open(TEX_IN_FILE,"${templateDirectory}$texInFile") ||
  422         &Global::error("File.pl: textInput error", " Can't open ${templateDirectory}$texInFile");
  423                 my @texInputArray = <TEX_IN_FILE>;
  424                 close(TEX_IN_FILE);
  425                 $texString = join('',@texInputArray);
  426         unless ($texString =~ /\n$/s) {$texString .= "\n";}
  427             }
  428 ##  print "$texString";
  429     $texString;
  430     }
  431 
  432 
  433 
  434 
  435 
  436 # A very useful macro for making sure that all of the directories to a file have been constructed.
  437 
  438 sub surePathToTmpFile {  # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
  439                # the input path must be either the full path, or the path relative to this tmp sub directory
  440          my $path      = shift;
  441          my $delim    = &getDirDelim();
  442          my $tmpDirectory = getCourseTempDirectory();
  443     # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
  444         $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
  445         $path = convertPath($path);
  446     # find the nodes on the given path
  447         my @nodes     = split("$delim",$path);
  448     # create new path
  449         $path   = convertPath("$tmpDirectory");
  450 
  451         while (@nodes>1 ) {
  452             $path = convertPath($path . shift (@nodes) ."/");
  453             unless (-e $path) {
  454             #   system("mkdir $path");
  455                 createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) ||
  456                 wwerror($0, "Failed to create directory $path","","","");
  457 
  458             }
  459 
  460         }
  461         $path = convertPath($path . shift(@nodes));
  462 
  463        # system(qq!echo "" > $path! );
  464 
  465 $path;
  466 
  467 }
  468 
  469 
  470 
  471 
  472 sub fileFromPath {
  473         my $path = shift;
  474         my $delim =&getDirDelim();
  475         $path =  convertPath($path);
  476         $path =~  m|([^$delim]+)$|;
  477         $1;
  478 
  479 }
  480 
  481 sub directoryFromPath {
  482         my $path = shift;
  483         my $delim =&getDirDelim();
  484         $path = convertPath($path);
  485         $path =~ s|[^$delim]*$||;
  486     $path;
  487 }
  488 
  489 sub createDirectory
  490     {
  491     my ($dirName, $permission, $numgid) = @_;
  492     mkdir($dirName, $permission) or
  493       wwerror("$0: createDirectory error", " Can't do mkdir($dirName, $permission)");
  494     chmod($permission, $dirName) or
  495       wwerror("$0: createDirectory error", " Can't do chmod($permission, $dirName)");
  496     unless ($numgid == -1) {chown(-1,$numgid,$dirName) or
  497       wwerror("$0: createDirectory error", " Can't do chown(-1,$numgid,$dirName)");}
  498     }
  499 use Cwd;
  500 sub createFile {
  501     my ($fileName, $permission, $numgid) = @_;
  502 #    my $decimal_per =  sprintf "%lo", $permission;
  503 #    print "\n IN createFile: file is $fileName, permission is  $decimal_per,  gid is $numgid\n";
  504 
  505     open(TEMPCREATEFILE, ">$fileName") ||
  506       wwerror("File.pl: createFile error", " Can't open $fileName");
  507     my @stat = stat TEMPCREATEFILE;
  508     close(TEMPCREATEFILE);
  509 
  510     ## if the owner of the file is running this script (e.g. when the file is first created)
  511     ## set the permissions and group correctly
  512     if ($< == $stat[4]) {
  513 #         my $oldDirectory = cwd();
  514 #         warn " old directory is $oldDirectory<BR>\n";
  515 #         my $newDirectory = $fileName;
  516 #         $newDirectory =~ s|/[^/]+$||;
  517 #         warn " new directory is $newDirectory<BR>\n";
  518 #         $fileName =~ m|([^/]+$)|;
  519 #         my $newFileName = $1;
  520 #         warn "new File name = $newFileName<BR>\n";
  521 #         chdir $newDirectory;
  522 #         warn "changing to directory =" .cwd() ."<BR>\n";
  523 #
  524         #chmod(0777,$fileName);
  525         my $tmp = chmod($permission,$fileName) or
  526           warn("File.pl: createFile error", " Can't do chmod($permission, $fileName)");
  527         chown(-1,$numgid,$fileName)  or
  528           warn("File.pl: createFile error", " Can't do chown($numgid, $fileName)");
  529 #         #warn "foo is readable<BR>\n" if -w 'foo.gif';
  530 #         #warn "chmod =" . chmod($permission,$newFileName) ||
  531 #         # warn("File.pl: createFile error", " Can't do chmod($permission, $newFileName)");
  532 #         #chdir $oldDirectory;
  533 #         #warn "changed back to directory =" .cwd() ."<BR>\n";
  534     }
  535 }
  536 
  537 sub rmDirectoryAndFiles
  538                  {
  539                  my ($PROBDIR) =@_;
  540                  my @allfiles = ();
  541                  opendir( DIRHANDLE, "$PROBDIR") || warn qq/Can't read directory $PROBDIR $!/;
  542                  @allfiles = map "$PROBDIR$_", grep( !/^\.\.?$/, readdir DIRHANDLE);
  543                  closedir(DIRHANDLE);
  544         #        print "unlinking<BR>",join("<BR>", @allfiles),"<P>";
  545                  unlink(@allfiles);
  546         #        print "removing directory $PROBDIR <P>";
  547                  rmdir("$PROBDIR");
  548                  }
  549 
  550 
  551 
  552 # this returns an array of set names sorted by due date (with all open sets first).
  553 # It is called by a reference to a hash with keys the Set Names and values psvn's
  554 # such as returned by &getAllProbSetNumbersHash or &getAllSetNumbersForStudentLoginHash
  555 
  556 sub sortSetNamesByDueDate {
  557     my ($setNameHashref) = @_;
  558     my %setNameHash = %$setNameHashref;
  559     my ($setName,$psvn,$ddts,$timeNow);
  560     my %dueTimes =();
  561 
  562     foreach $setName (keys %setNameHash) {
  563         $psvn=$setNameHash{$setName};
  564         &attachProbSetRecord($psvn);
  565         $ddts=&getDueDate($psvn);
  566         $dueTimes{$setName} = $ddts;
  567     }
  568 
  569     my @sortedSetNames = sort
  570 
  571     ## Sort setnumbers by due date. Using an anonymous block so that
  572     ## dueTimes gets passes without making it global to FILE.pl or
  573     ## passing it to a sorting subroutine (can we pass this?)
  574 
  575         {
  576         $timeNow = time;
  577         if ( ($dueTimes{$a} <= $timeNow) and ($dueTimes{$b} <= $timeNow) )
  578             {
  579             $dueTimes{$a} <=> $dueTimes{$b}
  580                 or
  581             $a cmp $b
  582             }
  583         elsif ( ($dueTimes{$a} > $timeNow) and ($dueTimes{$b} > $timeNow) )
  584             {
  585             $dueTimes{$a} <=> $dueTimes{$b}
  586                 or
  587             $a cmp $b
  588             }
  589         else
  590             {
  591             $dueTimes{$b} <=> $dueTimes{$a}
  592             }
  593         }
  594 
  595     keys %setNameHash ;
  596     @sortedSetNames;
  597     }
  598 
  599 sub checkClasslistFile {
  600     ## takes as parameters the number of fields and the full path name of
  601     ## the classlist file. Checks that the file iv valid, i.e. (1) all records
  602     ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
  603     ## all distinct and (3) the last fields (the loginID's) are all distinct,
  604     ## and (4) that studentID's and loginID's comtain only valid characters
  605 
  606     my($noOfFields,$fileName)=@_;
  607     my $msg = htmlCheckClasslistFile($noOfFields,$fileName);
  608     unless ($msg eq 'OK') {
  609         &wwerror("$0","$msg");
  610     }
  611 }
  612 
  613 sub htmlCheckClasslistFile {
  614     ## takes as parameters the number of fields and the full path name of
  615     ## the classlist file. Checks that the file iv valid, i.e. (1) all records
  616     ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
  617     ## all distinct and (3) the last fields (the loginID's) are all distinct,
  618     ## and (4) that studentID's and loginID's comtain only valid characters and
  619     ## (5) that other fields do not contain bas chacters
  620 
  621     my($noOfFields,$fileName)=@_;
  622 
  623     open (FILE, "$fileName") or
  624       &wwerror("$0","can't open $fileName");
  625     my @classList = <FILE>;
  626     close(FILE);
  627 
  628     my $msg = checkClasslistArray($noOfFields, \@classList,$fileName);
  629     return $msg;
  630 }
  631 
  632 sub checkClasslistArray {
  633     ## takes as parameters the number of fields and a ref to
  634     ## the classlist array. Checks that the file iv valid, i.e. (1) all records
  635     ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
  636     ## all distinct and (3) the last fields (the loginID's) are all distinct,
  637     ## and (4) that studentID's and loginID's comtain only valid characters and
  638     ## (5) that other fields do not contain bas chacters
  639 
  640     my($noOfFields,$classListref,$fileName)=@_;
  641     my($noOfDelim,$dbString,$num,$i,@classList);
  642     my(@keyList);
  643     my $msg ='';
  644     $noOfDelim = $noOfFields -1;
  645 
  646     @classList = @$classListref;
  647 
  648     foreach $dbString (@classList)  {
  649         unless ($dbString =~ /\S/)  {next;}
  650         chomp $dbString;
  651         $num=($dbString =~s/$DELIM/$DELIM/g);
  652         if ($num != $noOfDelim) {
  653             $num =$num+1;
  654             $msg = "\n\n The classlist file\n $fileName \n is corrupted. The record\n
  655             $dbString  \n contains $num  fields instead of $noOfFields fields. \nYou
  656             must correct this and then run this script again.
  657             \n\n";
  658             return $msg;
  659         }
  660     }
  661     my (@SSList, @loginList);
  662     @SSList=(); @loginList=();
  663     foreach $dbString (@classList) {
  664         unless ($dbString =~ /\S/)  {next;}
  665         chomp $dbString;
  666         my @classListRecord=&getRecord($dbString);
  667         my ($studentID, $lastName, $firstName, $status, $comment,  $section,$recitation, $email_address, $login_name)
  668           = @classListRecord;
  669       #  next if &dropStatus($status);   ## ignore students who have dropped
  670         unless ($studentID =~ /^[\w\-\.]+$/) {
  671             $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. The record
  672             \n$dbString  \n contains the invalid studentID: $studentID
  673             \n studentID's can contain only upper and lower case letters, digits, -, dot('.'), and _
  674             \n You must correct this and then run this script again.\n\n";
  675             return $msg;
  676         }
  677         unless ($login_name =~ /^[\w\-\.]+$/) {
  678             $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. The record
  679             \n$dbString  \n contains the invalid loginName: $login_name
  680             \n loginName's can contain only upper and lower case letters, digits, -, dot('.'), and _
  681             \n You must correct this and then run this script again.\n\n";
  682             return $msg;
  683         }
  684 
  685         ## test entries for bad characters.
  686     my @entries = ($lastName, $firstName, $status, $comment,  $section,$recitation, $email_address);
  687     my $item ='';
  688     foreach $item (@entries) {
  689       my $msg = test_entry($item);
  690       unless ($msg eq 'OK') {return $msg;}
  691     }
  692 
  693         push(@SSList,$studentID);
  694         push(@loginList,$login_name);
  695     }
  696     @SSList = sort(@SSList);
  697     for ($i=0; $i < @SSList-1; $i++) {
  698         if ($SSList[$i] eq $SSList[$i+1]) {
  699             $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. Duplicate studentID's equal
  700             to $SSList[$i] in\n $fileName\nYou must correct this and then run this script again.\n\n";
  701             return $msg;
  702         }
  703     }
  704     @loginList = sort(@loginList);
  705     for ($i=0; $i < @loginList-1; $i++) {
  706         if ($loginList[$i] eq $loginList[$i+1]) {
  707             $msg ="\n\n The classlist file\n$fileName\n\n is corrupted. Duplicate loginNames equal
  708             to $loginList[$i] in\n
  709             $fileName\nYou must correct this and then run this script again.\n\n";
  710             return $msg;
  711         }
  712     }
  713     $msg ='OK';
  714     return $msg;
  715 }
  716 
  717 ### macros for writing and reading html tables
  718 
  719 sub array2htmlRow {
  720     ## The parameter is an array whose entries will beccome elements of a row
  721     ## in an html table.  The output is a string formated the same way Excel
  722     ## formats html tables: numbers aligned right, other things left.
  723 
  724     my @inArray = @_;
  725     my ($item,$align);
  726     my $outString ='';
  727     $outString = join '','<TR ALIGN="left" VALIGN="bottom">',"\n";
  728     foreach $item (@inArray) {
  729         unless ($item =~ /\S/) {$item = '&nbsp;';}
  730         if ($item =~/^[\d\.]+$/){$align ='RIGHT'} else {$align ='LEFT'}
  731         $outString .= join '','<TD ALIGN=',$align,'>',"\n";
  732         $outString .= join '',$item,'</TD>',"\n";
  733     }
  734     $outString .= join '','</TR>',"\n";
  735 }
  736 
  737 sub array2htmlRowForm {
  738     ## The parameter is an array whose first entry is the row number (1, 2, etc)
  739     ## and remaining entries will become elements of a row
  740     ## in an html table.
  741 
  742     my ($row,@inArray) = @_;
  743     my ($item,$size);
  744     my $outString ='';
  745     my $col =1;
  746     $outString = join '','<TR ALIGN=LEFT VALIGN=BOTTOM>',"\n";
  747     foreach $item (@inArray) {
  748         unless ($item =~ /\S/) {$item = ' ';}
  749         $size = length($item);
  750         $outString .= join '','<TD>',"\n";
  751         $outString .= join '','<INPUT TYPE="TEXT" SIZE = ', $size, ' NAME="',"row${row}col$col",'" VALUE="',"$item",'"> </TD>',"\n";
  752 
  753         $col++;
  754     }
  755     $outString .= join '','</TR>',"\n";
  756 }
  757 
  758 sub delimitedArray2htmlTable    {
  759 
  760     #       Takes a ref to an array whose elements are rows of a delimited file
  761     #       and outputs a string containing
  762     #       an html table version of the array suitable for viewing and editing
  763     #       in Excel or a browser such as Netscape/Communicator.    If the second
  764     #       optional parameter is 'htmlform', the output is an html form. Otherwise
  765     #       the output is a plain html document.
  766     #       Blank lines are skipped. White space is removed.
  767 
  768     my ($inArrayref, $type) = @_;
  769 
  770     ## setup html header and initial table stuff
  771     my $rowString;
  772     my $outString = "<Table border>\n";
  773 
  774     ## translate data from delimited format to html format
  775     my $row =1;
  776     foreach (@$inArrayref)
  777         {
  778         unless ($_ =~ /\S/)  {next;}               ## skip blank lines
  779         chomp;
  780         if ( (defined $type) and ($type eq 'htmlform')) {$rowString = &array2htmlRowForm($row, &getRecord($_));}
  781         else  {$rowString = &array2htmlRow(&getRecord($_));}
  782         $outString .= $rowString;
  783         $row++;
  784     }
  785 
  786     ## setup html end table
  787     $outString .= join '','</Table>',"\n" ;
  788 }
  789 
  790 sub delimitedArray2html    {
  791 
  792     #       Takes a ref to an array whose elements are rows of a delimited file
  793     #       and outputs a string containing
  794     #       an html version of the array suitable for viewing and editing
  795     #       in Excel or a browser such as Netscape/Communicator.  The $label is the name
  796     #       appearing at the top of the form or page.  If the third
  797     #       optional parameter is 'htmlform', the output is an html form. Otherwise
  798     #       the output is a plain html document.
  799     #       Blank lines are skipped. White space is removed.
  800 
  801     my ($inArrayref, $label, $type) = @_;
  802 
  803     ## setup html header and initial table stuff
  804     my $rowString;
  805     my $outString = join '','<HTML>',"\n" ,'<HEAD>',"\n", '<TITLE>';
  806     $outString .=  join '',$label,'</TITLE>',"\n",'</HEAD>',"\n",'<BODY>',"\n";
  807     $outString .=  join '','<H1><CENTER>',$label,'</CENTER></H1>',"\n";
  808     $outString .=  &delimitedArray2htmlTable($inArrayref, $type);
  809 
  810     ## setup html footer stuff
  811     $outString .= join '','</BODY>',"\n", '</HTML>';
  812 }
  813 
  814 
  815 sub delim2html    {
  816 
  817     #       Takes a delimited file name as input and outputs a string containing
  818     #       an html version of the input file suitable for viewing and editing
  819     #       in Excel or a browser such as Netscape/Communicator.  If the second
  820     #       optional parameter is 'htmlform', the output is an html form. Otherwise
  821     #       the output is a plain html document.
  822     #       Blank lines are skipped. White space is removed.
  823 
  824     my ($inFileName,$type) = @_;
  825 
  826     my $shortFileName = $inFileName;
  827     unless (defined($type) and $type eq 'htmlform') {$type = 'html';}
  828     if ($shortFileName =~ m|$dd|)  {
  829         $shortFileName =~ m|$dd([^$dd]*)$|;  ## extract filename from full path name
  830         $shortFileName = $1;
  831     }
  832     $shortFileName =~ s|\..*||;      ## remove extension
  833     open(INFILE, $inFileName) || wwerror("$0", "can't open $inFileName");
  834     my @outArray = <INFILE>;
  835     close(INFILE);
  836     my $outString = delimitedArray2html(\@outArray,$shortFileName,$type);
  837     $outString;
  838 }
  839 
  840 
  841 
  842 
  843 sub htmlPage2htmlTable {    ## Takes a string which contains a full html page
  844                             ## containing a single table and removes all the
  845                             ## header and footer material leaving only the row
  846                             ## entries between <table> and </table>. Also removes all the
  847                             ## <font ...> and </font> stuff from within the table.
  848                             ## The cleaned up string is returned.
  849 
  850     my ($inString) = @_;
  851     $inString =~ s|^.*<\s*table.*?>||is;    ## remove <table> and stuff before
  852     $inString =~ s|<\s*/table\s*>.*?$||is;  ## remove </table> and stuff after
  853     $inString =~ s|<\s*/*font.*?>||gis;     ## remove font stuff
  854     $inString =~ s|>[^>]*$|>|s;             ## remove any stuff after last >
  855     $inString;
  856 }
  857 
  858 sub htmlTable2delim {   ## Takes a string (e.g. output from htmlPage2htmlTable) which
  859                         ## contains the rows from an html table and returns a string
  860                         ## containing the table data in delimited format.
  861 
  862     my ($inString) = @_;
  863     my ($outString, $item, $rowString);
  864     $outString ='';
  865     while ($inString){
  866         $inString =~ s|^(.*?<\s*/tr\s*>)||is;   # get next row
  867         $item = $1;
  868         $rowString = join("${DELIM}",&htmlRow2array($item));
  869         $outString .= join '', $rowString, " \n";
  870     }
  871     $outString;
  872 }
  873 
  874 sub htmlForm2delim {    ## Takes a reference to the associtive array of inputs from
  875                         ## a form. The $inputs{row5col8} is the element for the 5th row
  876                         ## and 8 column.  It is assumed the input is a rectangular array
  877                         ##Returns a string containing the table data in delimited format.
  878 
  879     my ($inputsref) = @_;
  880     my %inputs = %$inputsref;
  881     my ($item, $index,$row,$col);
  882     my  $maxCol = 1;
  883     my  $maxRow = 1;
  884     my @rowColIndex = grep /^row\d+col\d+$/, keys %inputs;
  885     foreach $index (@rowColIndex) {
  886         $index =~ /^row(\d+)col(\d+)$/;
  887         if ($1 > $maxRow) {$maxRow = $1};
  888         if ($2 > $maxCol) {$maxCol = $2};
  889     }
  890 
  891     my @outArray =();
  892     my $rowString ='';
  893     my @rowArray= ();
  894 
  895     for $row (1..$maxRow) {
  896         @rowArray= ();
  897         for $col (1..$maxCol) {push @rowArray, $inputs{"row${row}col${col}"};}
  898         $rowString = join("${DELIM}",@rowArray);
  899         push (@outArray,$rowString);
  900     }
  901     @outArray = &columnArrayArrange(@outArray); ## line up columns
  902     my $outString = join('',@outArray);
  903     $outString;
  904 }
  905 
  906 
  907 
  908 sub htmlRow2array {
  909     ## The parameter is a string "<TR ... /TR>" containing one row
  910     ## in an html table.  The output is an array containing the entries
  911     ## contained in that row.
  912 
  913     my ($inString) = @_;
  914     $inString =~ s|^.*<\s*tr.*?>||is;       ## remove <tr> and stuff before
  915     $inString =~ s|<\s*/tr\s*>.*$||is;      ## remove </tr> and stuff after
  916     $inString =~ s|>[^>]*$|>|s;             ## remove any stuff after last >
  917 
  918     my @outArray =();
  919     my $item;
  920     while ($inString){
  921         $inString =~ s%^(.*?<)\s*/t[d|h]\s*>%%is;   # get next entry
  922         $item = $1;
  923         $item =~ m|>\s*(.*?)<|is;                   # get entry
  924         $item =$1;
  925         $item =~ s|\s*$||;                          # remove trailing spaces
  926         if (($item eq '&nbsp;') or ($item eq '')) {$item =' '}
  927         push @outArray, $item;
  928     }
  929     @outArray;
  930 }
  931 
  932 
  933  ## this subroutine prints all environment variables.
  934  ## adapted from http://www.cgi-resources.com/Documentation/Environment_Variables/
  935  ## takes parameters html_top, html_bot which print html top and bottom matter if set
  936 sub printEnvVars {
  937 
  938 my ($top, $bot) = @_;
  939 my ($bigcontent, @content, $content,$name,$value,%input,$tvar,$key);
  940       # First, if METHOD=GET  we grab the environment variable
  941       # containing the Query_String - otherwise we grab the
  942       # environment variable Content_Length.
  943 if ($ENV{'REQUEST_METHOD'} eq "GET") {
  944      $bigcontent = $ENV{'QUERY_STRING'};
  945     } # Close if bracket
  946 else {
  947     read(STDIN, $bigcontent, $ENV{'CONTENT_LENGTH'});
  948     } # Close else bracket
  949       # bigcontent now contains a long string which is broken by
  950       # ampersands between the various form elements.  So let's split
  951       # it and load it into an array
  952 @content = split(/&/, $bigcontent);
  953       # But we aren't done yet. All of the spaces in the form data
  954       # were replaced by pluses.  Other non-alpha characters except
  955       # equal signs were replaced by their hex values. So now we
  956       # need to step through the array and translate them back into
  957       # their "sent" form.
  958 foreach $content (@content) {
  959       # Split HTML form's "NAME" and "VALUE" at equal signs
  960     ($name, $value) = split(/=/, $content);
  961       # Replace the pluses with spaces
  962     $value =~ tr/+/ /;
  963       # Translate the hex (now preceded by percent sign) into ASCII
  964     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  965       # And finish by loading input variables for use in program.
  966       # You call it by $input{'formvarname'} to get the literal
  967       # that the user typed into that field on the Form.
  968     $input{$name} = $value;
  969     } # Close bracket for foreach loop
  970 
  971       # Tell the server that we are going to send it to user's browser
  972 if ($top eq 'html_top') {print "Content-type: text/html\n\n";
  973       # So we don't have to type backslashes everywhere before reserved
  974       # characters in the HTML, we use this so the PERL compiler will
  975       # know that what follows is literal (except for variable names)
  976       # But be careful - still need backslash in front of literal at
  977       # signs, dollar signs, etc., since PERL assumes a variable name
  978       # follows these characters.
  979     print <<ENDOFTEXT;
  980     <HTML><HEAD><TITLE>Environment Variable
  981     Test</TITLE></HEAD>
  982     <BODY BGCOLOR="#FFFFFF">
  983 
  984 ENDOFTEXT
  985 }
  986      # Now, simply sort and print the names and values of each of the
  987      # environment variables from the keyed array to browser window
  988 foreach $key (sort keys(%ENV)) {print
  989 "<B>$key:<\/B>$ENV{$key}<BR>";}
  990 
  991 if ($bot eq 'html_bot') {
  992     print <<ENDOFTEXT;
  993 
  994     <P>
  995     </BODY>
  996     </HTML>
  997 ENDOFTEXT
  998 
  999 }
 1000 }
 1001 
 1002 sub backupFile  {
 1003     ## takes as a parameter the full filename
 1004     ## makes upto three backups of file with x, y, or z appended to filename where x
 1005     ## the most recent backup
 1006 
 1007     my $fileName =$_[0];
 1008     my $orgFileName = "$fileName";
 1009     my ($ext, $fnMinusExt,$noPeriod);
 1010     if (! ($orgFileName =~ m|\.|)) {
 1011         $noPeriod =1;
 1012         $fnMinusExt = $orgFileName;
 1013         $ext ='';
 1014     }
 1015     else {
 1016         $noPeriod =0;
 1017         $orgFileName =~ m|^(.*)\.([^\.]*)$|;
 1018         $fnMinusExt = $1;
 1019         $ext = $2;
 1020     }
 1021     my $period = '.';
 1022     $period = '' if $noPeriod;
 1023     if (-e "${fnMinusExt}y${period}${ext}") {
 1024         rename("${fnMinusExt}y${period}$ext","${fnMinusExt}z${period}$ext") or
 1025           &wwerror("$0","can't rename ${fnMinusExt}y${period}$ext");
 1026     }
 1027 
 1028     if (-e "${fnMinusExt}x${period}$ext") {
 1029         rename("${fnMinusExt}x${period}$ext","${fnMinusExt}y${period}$ext") or
 1030           &wwerror("$0","can't rename ${fnMinusExt}x${period}$ext");
 1031     }
 1032 
 1033     if (-e "${fnMinusExt}${period}$ext") {
 1034         rename("${fnMinusExt}${period}$ext","${fnMinusExt}x${period}$ext") or
 1035           &wwerror("$0","can't rename ${fnMinusExt}${period}$ext");
 1036     }
 1037 }
 1038 
 1039 sub stripWhiteSpace {       ## strip initial and trailing whitespace
 1040     my $string = $_[0];
 1041     $string =~ s/\s*$//;     # remove trailing whitespace
 1042     $string =~ s/^\s*//;     # remove initial spaces
 1043     $string;
 1044 }
 1045 
 1046 sub test_entry{     ## check for bad characters. & and = are used as delimiters
 1047             ## in databases. DELIM (usually a coma) is used in csv files
 1048   my $entry = shift;
 1049   my $msg = 'OK';
 1050   if ($entry =~ /[=&$DELIM]/) {
 1051     $msg = "      The entry: $entry  is invalid.
 1052         An entry can not contain any of the following characters: $DELIM  &  =
 1053         You must go back and correct this.\n";
 1054   }
 1055   $msg;
 1056 }
 1057 
 1058 sub testNewStudentLogin {
 1059   my $login_name = shift;
 1060   my $newStudentID = shift;
 1061   my $msg = 'OK';
 1062   unless ($login_name =~ /^[\w\-\.]+$/) {
 1063     $msg = "      The login name: $login_name  is invalid.
 1064         Login name's can contain only upper and lower case letters, digits, -, dot('.'), and _
 1065         you must go back and correct this.\n";
 1066     return $msg;
 1067   }
 1068   my %currentLogins = %{getLoginName_StudentID_Hash()};
 1069   if (defined $currentLogins{$login_name}){
 1070     attachCLRecord($login_name);
 1071 
 1072     my $studentLastName = CL_getStudentLastName($login_name);
 1073     my $studentFirstName  = CL_getStudentFirstName($login_name);
 1074     my $studentID   = CL_getStudentID($login_name);
 1075 
 1076     $msg = "      The login name: $login_name  is already in use.
 1077         It is assigned to $studentFirstName $studentLastName ($studentID).
 1078         You must go back and choose a login name which is not yet being used.\n";
 1079     return $msg;
 1080   }
 1081   $msg;
 1082 }
 1083 
 1084 
 1085 sub testNewStudentID {
 1086   my $studentID = shift;
 1087   my $newLogin_name = shift;
 1088   my $msg ='OK';
 1089   unless ($studentID =~ /^[\w\-\.]+$/) {
 1090     $msg = "      The student ID: $studentID  is invalid.
 1091         student ID's can contain only upper and lower case letters, digits, -, dot('.'), and _
 1092         you must go back and correct this.\n";
 1093     return ($msg);
 1094   }
 1095   my %currentIDs = %{getStudentID_LoginName_Hash()};
 1096 
 1097   if (defined $currentIDs{$studentID}) {
 1098     my $oldLogin = $currentIDs{$studentID};
 1099     attachCLRecord($oldLogin);
 1100 
 1101     my $studentLastName = CL_getStudentLastName($oldLogin);
 1102     my $studentFirstName  = CL_getStudentFirstName($oldLogin);
 1103 
 1104 
 1105     $msg = "      The student ID: $studentID  is already in use.
 1106         It is assigned to $studentFirstName $studentLastName ($oldLogin).
 1107         you must go back and choose a student ID which is not yet being used.\n";
 1108     return $msg;
 1109   }
 1110   $msg;
 1111 }
 1112 
 1113 sub getClasslistFilesAndLabels {  ## returns a two element array
 1114                   ## the 0th element is a ref to an array of files
 1115                   ## the 1st element is a ref to a hash of labels
 1116   my $Course = shift;
 1117   my $defaultClasslistFile    = getCourseClasslistFile($Course);
 1118 
 1119   ## find the available files
 1120 
 1121   opendir CLASSLISTDIR, $templateDirectory or wweror($0,"Can't open directory $templateDirectory");
 1122   my @allFiles = grep !/^\./, readdir CLASSLISTDIR;
 1123   closedir  CLASSLISTDIR;
 1124 
 1125     ## sort the files
 1126 
 1127   my @classlistFiles = grep /\.lst$/,@allFiles;
 1128   my @sortedNames = sort @classlistFiles;
 1129 
 1130     ## put the default classlist file first if it exists
 1131   my $shortFileName = $defaultClasslistFile;
 1132     if ($shortFileName =~ m|$dd|)  {
 1133         $shortFileName =~ m|$dd([^$dd]*)$|;  ## extract filename from full path name
 1134         $shortFileName = $1;
 1135     }
 1136   my @newSortedNames  = grep !/^$shortFileName$/, @sortedNames;
 1137   if ($#newSortedNames != $#sortedNames) {
 1138       unshift @newSortedNames,$shortFileName;
 1139       @sortedNames = @newSortedNames;
 1140   }
 1141 
 1142     ## generate labels
 1143     my %label_hash = ();
 1144 
 1145   my ($ind,$date,$fileName,@stat);
 1146   for $ind (@sortedNames) {
 1147       $fileName = "${templateDirectory}$ind";
 1148       if (-e $fileName) {
 1149           @stat = stat($fileName);
 1150           $date = $stat[9];
 1151           $date = formatDateAndTime($date);
 1152           $date =~ s|\s*at.*||;
 1153           $label_hash{$ind} = "$ind --- Last Changed $date";
 1154       }
 1155   }
 1156   (\@sortedNames,\%label_hash);
 1157 }
 1158 
 1159 
 1160 
 1161 
 1162 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9