#!/usr/local/bin/perl

## $Id$

####################################################################
# Copyright @ 1995-1998 University of Rochester
# All Rights Reserved
####################################################################

# #############################################################
# #############################################################
#  File: FILE.pl
#  This contains the subroutines for  creating problem files,
#  recording scores, printing delimited files, etc.
# #############################################################
# #############################################################
use strict;


# Variables global to this file

my  $scoringDirectory   =   getCourseScoringDirectory();
my  $templateDirectory  =   getCourseTemplateDirectory();
my  $scriptDirectory    =   getWebworkScriptDirectory();
my  $databaseDirectory  =   getCourseDatabaseDirectory();

my  $DELIM = $Global::delim;
my  $scoreFilePrefix = $Global::scoreFilePrefix;
my  $scoring_log = $Global::scoring_log;
my  $dash = $Global::dash;
my  $DAT = $Global::dat;
my  @STATUS_DROP = @Global::statusDrop;

my  $dd = getDirDelim();




sub round_score {
    my $num = shift;
    my $rounding_dem = 10**$Global::score_decimal_digits;
    int($num*$rounding_dem + .5)/$rounding_dem;
}


sub readSetDef {
    my ($fileName) = @_;
    my $setNumber = '';
    my $shortFileName = fileFromPath($fileName);
    if ($shortFileName =~ m|^set(\w+)\.def$|) {$setNumber = $1;}
    else {
        wwerror("$0",  "The setDefinition file name must begin with   <CODE>set</CODE>
and must end with   <CODE>.def</CODE>  . Every thing in between becomes the name of the set.
For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE>
define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. The
filename, $shortFileName, you entered is not legal\n");
    }

    my ($line,$name,$value,$attemptLimit);
    open (SETFILENAME, "$fileName") or wwerror("$0",  "Can't open file $fileName\n");
    my $setHeaderFileName = '';
    my $probHeaderFileName = '';
    my @problemList=();
    my @problemValueList=();
    my @problemAttemptLimitList=();
    my ($dueDate,$openDate,$answerDate);
    my ($problemListref,$problemValueListref,$problemAttemptLimitListref);
    while (<SETFILENAME>) {
        chomp($line = $_);
        $line =~ s|(#.*)||;                             ## don't read past comments
        unless ($line =~ /\S/) {next;}                  ## skip blank lines
        $line =~ s|\s*$||;                               ## trim trailing spaces
        $line =~ m|^\s*(\w+)\s*=\s*(.*)|;
        if ($1 eq 'setNumber') {next;}
        elsif ($1 eq 'paperHeaderFile') {$setHeaderFileName = $2;}
        elsif ($1 eq 'screenHeaderFile') {$probHeaderFileName = $2;}
        elsif ($1 eq 'dueDate') {$dueDate = $2;}
        elsif ($1 eq 'openDate') {$openDate = $2;}
        elsif ($1 eq 'answerDate') {$answerDate = $2;}
        elsif ($1 eq 'problemList') {last;}
        else {wwerror("$0", "readSetDef error, can't read the line: $line");}
    }

    my $time1 = &unformatDateAndTime($openDate);
    my $time2 = &unformatDateAndTime($dueDate);
    my $time3 = &unformatDateAndTime($answerDate);
    if ($time2 < $time1 or $time3 < $time2) {
        &Global::error('File.pl: readSetDef error', "The open date: $openDate, due date: $dueDate, and answer date: $answerDate
        must be in chronologicasl order.");
    }

    $setHeaderFileName =~ s/(.*?)\s*$/$1/;   #remove trailing white space
    $probHeaderFileName =~ s/(.*?)\s*$/$1/;   #remove trailing white space

 #   print "setNumber: $setNumber\ndueDate: $dueDate\nopenDate: $openDate\nanswerDate: $answerDate\n";
    while(<SETFILENAME>) {
        chomp($line=$_);
        $line =~ s/(#.*)//;                             ## don't read past comments
        unless ($line =~ /\S/) {next;}                  ## skip blank lines

        ($name, $value, $attemptLimit) = split (/\s*,\s*/,$line);
        $name =~ s/\s*//g;
        push(@problemList, $name);
        $value = "" unless defined($value);
        $value =~ s/[^\d]*//g;
        unless ($value =~ /\d+/) {$value = 1;}
        push(@problemValueList, $value);
        $attemptLimit = "" unless defined($attemptLimit);
        $attemptLimit =~ s/[^\d-]*//g;
        unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;}

        push(@problemAttemptLimitList, $attemptLimit);
    }
    close(SETFILENAME);
    #print "problemList: @problemList\n";
    #print "problemValueList: @problemValueList\n";
    #print "problemAttemptLimitList: @problemAttemptLimitList\n";
    $problemListref = \@problemList;
    $problemValueListref = \@problemValueList;
    $problemAttemptLimitListref = \@problemAttemptLimitList;
    ($setNumber,$setHeaderFileName,$probHeaderFileName,$dueDate,$openDate,$answerDate,$problemListref,$problemValueListref,$problemAttemptLimitListref);
}

sub max  {  ## find the max element of array
    my $out = $_[0];
    my $num;
    foreach $num (@_) {
        if ((defined $num) and ($num > $out)) {$out = $num;}
    }
    $out;
}

sub min  {  ## find the max element of array
    my $out = $_[0];
    my $num;
    foreach $num (@_) {
        if ((defined $num) and ($num < $out)) {$out = $num;}
    }
    $out;
}

sub getFieldLengths {

    ## takes as a parameter the  reference to a delimited array
    ## (such as you would get by reading in a delimited file)
    ## where each element is a line from a delimited file.
    ## returns an array which holds
    ## the maximum field lengths in the file.

    my ($datFileArray_ref)=@_;
    my($i);
    my(@datArray,@fieldLength,@datFileArray, $line);
    @fieldLength=();
    @datFileArray=@$datFileArray_ref;

    foreach $line (@datFileArray)   {    ## read through file and get field lengths
        unless ($line =~ /\S/)  {next;}  ## skip blank lines
        chomp $line;
        @datArray=&getRecord($line);
        for ($i=0; $i <=$#datArray; $i++) {
            $fieldLength[$i] = 0 unless defined $fieldLength[$i];
            $fieldLength[$i]=&max(length("$datArray[$i]"),$fieldLength[$i]);
        }
    }
    return (@fieldLength);
}


sub columnArrayArrange  {

## takes as a parameter a delimited array
## (such as you would get by reading in a delimited file)
## where each element is a line from a delimited file.

# Outputs an array which adds
# extra space if necessary to the fields so that all columns line up.
# The widest field in any column will contain exactly 1 spaces at the
# end of the (non space characters of the) field. For example
# ",a very long field entry ," at one extreme and  ", ," at the other

    my @inFile=@_;
    my($i,$tempFileName,$datString,$line);
    my @outFile =();
    my(@fieldLength,@datArray);
    $i=1;

    @fieldLength=&getFieldLengths(\@inFile);
    foreach $line (@inFile)   {    ## read through file array and get field lengths
        unless ($line =~ /\S/)  {next;}    ## skip blank lines
        chomp $line;
        @datArray=&getRecord($line);
        for ($i=0; $i <=$#datArray; $i++) {
            $datArray[$i].=(" " x ($fieldLength[$i]+1-length("$datArray[$i]")));
        }
        $datString=join("${DELIM}",@datArray);
        push @outFile , "$datString\n";
    }
    @outFile;
}


sub columnPrint {

# Takes two parameters.  The first is the filename of the
# delimited input file.  The second is the name of the
# output file (these names may be the same).  The permissions
# and group of the output file will be the same as the
# input file

# Takes any delimited (with \$DELIM delimiters) file and adds
# extra space if necessary to the fields so that all columns line up.
# The widest field in any column will contain exactly 2 spaces at the
# end of the (non space characters 0f the) field. For example
# ",a very long field entry  ," at one extreme and  ",  ," at the other
#
    my($inFileName,$outFileName)=@_;
    my($line);

    my ($permission, $gid) = (stat($inFileName))[2,5];
    $permission =  ($permission & 0777);    ##get rid of file type stuff

    open(INFILE,"$inFileName") or wwerror("$0","can't open $inFileName for reading");
    my @inFile=<INFILE>;
    close(INFILE);

    &createFile($outFileName, $permission, $gid);

    my @outFile = &columnArrayArrange(@inFile);

    open(OUTFILE,">$outFileName")   or wwerror("$0","can't open $outFileName for writing");
    foreach $line (@outFile) {print OUTFILE $line;}
    close(OUTFILE);
}

sub getRecord

        #       Takes a delimited line as a parameter and returns an
        #       array.  Note that all white space is removed.  If the
        #       last field is empty, the last element of the returned
        #       array is also empty (unlike what the perl split command
        #       would return).  E.G. @lineArray=&getRecord(\$delimitedLine).
        {
    my $DELIM = $Global::delim;
        my($line) = $_[0];
        my(@lineArray);
        $line.='A';                                     # add 'A' to end of line so that
                                                        # last field is never empty
        @lineArray = split(/\s*${DELIM}\s*/,$line);
        $lineArray[$#lineArray] =~s/\s*A$//;            # remove spaces and the 'A' from last element
        $lineArray[0] =~s/^\s*//;                       # remove white space from first element
        @lineArray;
        }




sub delim2aa    {

        #       Takes a delimited file as a parameter and returns an
        #       associative array with the first field as the key.
        #       Blank lines are skipped. White space is removed

        my $fileName =$_[0];
        my(@dbArray,$key,%assocArray,$dbString);
        open(FILE, "$fileName") or wwerror("$0","can't open $fileName");
        while (<FILE>)
            {
            unless ($_ =~ /\S/)  {next;}               ## skip blank lines
            chomp;
            @dbArray=&getRecord($_);
            $key=shift(@dbArray);
            $dbString=join("${DELIM}",@dbArray);
            $assocArray{$key}=$dbString;
            }
        close(FILE);
        %assocArray;
}
sub dropStatus

    #       Takes one parameter \$status and returns 1 if \$status matches a word in the
    #       \@STATUS_DROP global array, 0 otherwise. E.G. if ($dropStatus(\$status) {...}
    #   where \$status is the entry in the status field of the class list. \@STATUS_DROP
    #   is a global array defined in webwork.ph
        {
        my($tag) = 0;
        my($status) = $_[0];
        my($statusItem);
        foreach $statusItem (@STATUS_DROP)
                {
                 if ($status =~ /^\s*$statusItem\s*$/i) {$tag = 1;}

                }
        $tag;
        }


sub beforeOpenDateMsg {
    my ($OpenDate) = @_;
    my $out = " --- <em>Before open date</em> -- ";
    $out .= "Open date is: $OpenDate <BR>";
    $out;
};
sub afterOpenDateMsg { #and before Due Date
    my ($DueDate) = @_;
    my $out = " --- <em><B>OPEN</B></em>";
    $out .= " --  Due date is: $DueDate <BR>";
    $out;
};
sub afterDueDateMsg { #and before AnswerDate
    my ($AnswerDate) = @_;
    my $out = " --- <em><B>CLOSED</B></em> --";
    $out .= " Answers available on: $AnswerDate <BR>";
    $out;
};
sub afterAnswerDateMsg {
    my $out = " --- <em><B>CLOSED</B></em> -- ";
    $out .= " answers available.<BR>";
    $out;
};


sub problemDates {
    my ($OpenDate,$DueDate,$AnswerDate) = @_;
    my $out = <<ENDproblemDatesHTML;
 <PRE>
                                  Open:   $OpenDate
                                  <B>Due:    $DueDate</B>
                                  Answer: $AnswerDate
 </PRE>
ENDproblemDatesHTML

    $out;
}

sub formatDateAndTime {
    my ($timeStamp)=@_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
    localtime($timeStamp);
    my $twelveHour;
    if($min<10){$min= "0" . $min;}

    if($hour==0){$twelveHour = 12 . ":" . $min . " AM";}
    elsif($hour<12){$twelveHour= $hour . ":" . $min . " AM";}
    elsif($hour==12){$twelveHour = $hour . ":" . $min . " PM";}
    else    {$twelveHour = ($hour-12) . ":" . $min . " PM";}

    if($year>99){$year = $year -100;}
    if($year<10){$year= "0" . $year;}

    my $returnTimeString = ($mon+1) . "/" . $mday . "/" . $year . " at " . $twelveHour;
    $returnTimeString;
}


sub unformatDateAndTime {
    my ($string) = @_;
    my $orgString =$string;
    $string =~ s|^\s+||;
    $string =~ s|\s+$||;
    $string =~ s|at| at |i; ## OK if forget to enter spaces or use wrong case
    $string =~ s|AM| AM|i;  ## OK if forget to enter spaces or use wrong case
    $string =~ s|PM| PM|i;  ## OK if forget to enter spaces or use wrong case
    $string =~ s|,| at |;   ## start translating old form of date/time to new form

    my($date,$at,$time,$AMPM) = split(/\s+/,$string);
    unless ($time =~ /:/) {
        {  ##bare block for 'case" structure
            $time =~ /(\d\d)(\d\d)/;
            my $tmp_hour = $1;
            my $tmp_min = $2;
            if ($tmp_hour eq '00') {$time = "12:$tmp_min"; $AMPM = 'AM';last;}
            if ($tmp_hour eq '12') {$time = "12:$tmp_min"; $AMPM = 'PM';last;}
            if ($tmp_hour < 12) {$time = "$tmp_hour:$tmp_min"; $AMPM = 'AM';last;}
            if ($tmp_hour < 24) {
                $tmp_hour = $tmp_hour - 12;
                $time = "$tmp_hour:$tmp_min";
                $AMPM = 'PM';
            }
        }  ##end of bare block for 'case" structure

    }

    my ($mday, $mon, $year, $wday, $yday,$sec, $pm, $min, $hour);
    $sec=0;
    $time =~ /^([0-9]+)\s*\:\s*([0-9]*)/;
    $min=$2;
    $hour = $1;
    if ( $hour < 1 or $hour > 12 or $min < 0 or $min > 59) {
        &Global::error('File.pl: unformatDateAndTime error', "Incorrect date/time format $orgString. Correct format is 9/13/02 at 12:15 PM");
    }
    $pm = 0;
    $pm = 12 if ($AMPM =~/PM/ and $hour < 12);
    $hour += $pm;
    $hour = 0 if ($AMPM =~/AM/ and $hour == 12);
    $date =~  m!([0-9]+)\s*/\s*([0-9]+)/\s*([0-9]+)! ;
    $mday =$2;
    $mon=($1-1);
    if ( $mday < 1 or $mday > 31 or $mon < 0 or $mon > 11) {
        &Global::error('File.pl: unformatDateAndTime error', "Incorrect date/time format $orgString. Correct format is 9/13/02 at 12:15 PM");
    }
    $year=$3;
    $wday="";
    $yday="";
    timelocal ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday);
}

sub texInput

    ## Similar to the TeX input command.  Takes a filename (with or without extension)
    ## which is assumed to be in the \$templateDirectory.
    ## E.G. print OUTFILE &texInput("file.tex");
    ## or   print OUTFILE &texInput("file");

        {
    my $texInFile = $_[0];
    my $texString;
    if ($texInFile eq "") {
        $texString = '';
        }   else    {
            unless ($texInFile =~ m#\.#) {$texInFile .= '.tex';}
                open(TEX_IN_FILE,"${templateDirectory}$texInFile") ||
        &Global::error("File.pl: textInput error", " Can't open ${templateDirectory}$texInFile");
                my @texInputArray = <TEX_IN_FILE>;
                close(TEX_IN_FILE);
                $texString = join('',@texInputArray);
        unless ($texString =~ /\n$/s) {$texString .= "\n";}
            }
##  print "$texString";
    $texString;
    }





# A very useful macro for making sure that all of the directories to a file have been constructed.

sub surePathToTmpFile {  # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
               # the input path must be either the full path, or the path relative to this tmp sub directory
         my $path      = shift;
         my $delim    = &getDirDelim();
         my $tmpDirectory = getCourseTempDirectory();
    # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
        $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
        $path = convertPath($path);
    # find the nodes on the given path
        my @nodes     = split("$delim",$path);
    # create new path
        $path   = convertPath("$tmpDirectory");

        while (@nodes>1 ) {
            $path = convertPath($path . shift (@nodes) ."/");
            unless (-e $path) {
            #   system("mkdir $path");
                createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) ||
                wwerror($0, "Failed to create directory $path","","","");

            }

        }
        $path = convertPath($path . shift(@nodes));

       # system(qq!echo "" > $path! );

$path;

}




sub fileFromPath {
        my $path = shift;
        my $delim =&getDirDelim();
        $path =  convertPath($path);
        $path =~  m|([^$delim]+)$|;
        $1;

}

sub directoryFromPath {
        my $path = shift;
        my $delim =&getDirDelim();
        $path = convertPath($path);
        $path =~ s|[^$delim]*$||;
    $path;
}

sub createDirectory
    {
    my ($dirName, $permission, $numgid) = @_;
    mkdir($dirName, $permission) or
      wwerror("$0: createDirectory error", " Can't do mkdir($dirName, $permission)");
    chmod($permission, $dirName) or
      wwerror("$0: createDirectory error", " Can't do chmod($permission, $dirName)");
    unless ($numgid == -1) {chown(-1,$numgid,$dirName) or
      wwerror("$0: createDirectory error", " Can't do chown(-1,$numgid,$dirName)");}
    }
use Cwd;
sub createFile {
    my ($fileName, $permission, $numgid) = @_;
#    my $decimal_per =  sprintf "%lo", $permission;
#    print "\n IN createFile: file is $fileName, permission is  $decimal_per,  gid is $numgid\n";

    open(TEMPCREATEFILE, ">$fileName") ||
      wwerror("File.pl: createFile error", " Can't open $fileName");
    my @stat = stat TEMPCREATEFILE;
    close(TEMPCREATEFILE);

    ## if the owner of the file is running this script (e.g. when the file is first created)
    ## set the permissions and group correctly
    if ($< == $stat[4]) {
#         my $oldDirectory = cwd();
#         warn " old directory is $oldDirectory<BR>\n";
#         my $newDirectory = $fileName;
#         $newDirectory =~ s|/[^/]+$||;
#         warn " new directory is $newDirectory<BR>\n";
#         $fileName =~ m|([^/]+$)|;
#         my $newFileName = $1;
#         warn "new File name = $newFileName<BR>\n";
#         chdir $newDirectory;
#         warn "changing to directory =" .cwd() ."<BR>\n";
#
        #chmod(0777,$fileName);
        my $tmp = chmod($permission,$fileName) or
          warn("File.pl: createFile error", " Can't do chmod($permission, $fileName)");
        chown(-1,$numgid,$fileName)  or
          warn("File.pl: createFile error", " Can't do chown($numgid, $fileName)");
#         #warn "foo is readable<BR>\n" if -w 'foo.gif';
#         #warn "chmod =" . chmod($permission,$newFileName) ||
#         # warn("File.pl: createFile error", " Can't do chmod($permission, $newFileName)");
#         #chdir $oldDirectory;
#         #warn "changed back to directory =" .cwd() ."<BR>\n";
    }
}

sub rmDirectoryAndFiles
                 {
                 my ($PROBDIR) =@_;
                 my @allfiles = ();
                 opendir( DIRHANDLE, "$PROBDIR") || warn qq/Can't read directory $PROBDIR $!/;
                 @allfiles = map "$PROBDIR$_", grep( !/^\.\.?$/, readdir DIRHANDLE);
                 closedir(DIRHANDLE);
        #        print "unlinking<BR>",join("<BR>", @allfiles),"<P>";
                 unlink(@allfiles);
        #        print "removing directory $PROBDIR <P>";
                 rmdir("$PROBDIR");
                 }



# this returns an array of set names sorted by due date (with all open sets first).
# It is called by a reference to a hash with keys the Set Names and values psvn's
# such as returned by &getAllProbSetNumbersHash or &getAllSetNumbersForStudentLoginHash

sub sortSetNamesByDueDate {
    my ($setNameHashref) = @_;
    my %setNameHash = %$setNameHashref;
    my ($setName,$psvn,$ddts,$timeNow);
    my %dueTimes =();

    foreach $setName (keys %setNameHash) {
        $psvn=$setNameHash{$setName};
        &attachProbSetRecord($psvn);
        $ddts=&getDueDate($psvn);
        $dueTimes{$setName} = $ddts;
    }

    my @sortedSetNames = sort

    ## Sort setnumbers by due date. Using an anonymous block so that
    ## dueTimes gets passes without making it global to FILE.pl or
    ## passing it to a sorting subroutine (can we pass this?)

        {
        $timeNow = time;
        if ( ($dueTimes{$a} <= $timeNow) and ($dueTimes{$b} <= $timeNow) )
            {
            $dueTimes{$a} <=> $dueTimes{$b}
                or
            $a cmp $b
            }
        elsif ( ($dueTimes{$a} > $timeNow) and ($dueTimes{$b} > $timeNow) )
            {
            $dueTimes{$a} <=> $dueTimes{$b}
                or
            $a cmp $b
            }
        else
            {
            $dueTimes{$b} <=> $dueTimes{$a}
            }
        }

    keys %setNameHash ;
    @sortedSetNames;
    }

sub checkClasslistFile {
    ## takes as parameters the number of fields and the full path name of
    ## the classlist file. Checks that the file iv valid, i.e. (1) all records
    ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
    ## all distinct and (3) the last fields (the loginID's) are all distinct,
    ## and (4) that studentID's and loginID's comtain only valid characters

    my($noOfFields,$fileName)=@_;
    my $msg = htmlCheckClasslistFile($noOfFields,$fileName);
    unless ($msg eq 'OK') {
        &wwerror("$0","$msg");
    }
}

sub htmlCheckClasslistFile {
    ## takes as parameters the number of fields and the full path name of
    ## the classlist file. Checks that the file iv valid, i.e. (1) all records
    ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
    ## all distinct and (3) the last fields (the loginID's) are all distinct,
    ## and (4) that studentID's and loginID's comtain only valid characters and
    ## (5) that other fields do not contain bas chacters

    my($noOfFields,$fileName)=@_;

    open (FILE, "$fileName") or
      &wwerror("$0","can't open $fileName");
    my @classList = <FILE>;
    close(FILE);

    my $msg = checkClasslistArray($noOfFields, \@classList,$fileName);
    return $msg;
}

sub checkClasslistArray {
    ## takes as parameters the number of fields and a ref to
    ## the classlist array. Checks that the file iv valid, i.e. (1) all records
    ## have the same number of fields, (2) the first fields (studentID's, usually SS#'s) are
    ## all distinct and (3) the last fields (the loginID's) are all distinct,
    ## and (4) that studentID's and loginID's comtain only valid characters and
    ## (5) that other fields do not contain bas chacters

    my($noOfFields,$classListref,$fileName)=@_;
    my($noOfDelim,$dbString,$num,$i,@classList);
    my(@keyList);
    my $msg ='';
    $noOfDelim = $noOfFields -1;

    @classList = @$classListref;

    foreach $dbString (@classList)  {
        unless ($dbString =~ /\S/)  {next;}
        chomp $dbString;
        $num=($dbString =~s/$DELIM/$DELIM/g);
        if ($num != $noOfDelim) {
            $num =$num+1;
            $msg = "\n\n The classlist file\n $fileName \n is corrupted. The record\n
            $dbString  \n contains $num  fields instead of $noOfFields fields. \nYou
            must correct this and then run this script again.
            \n\n";
            return $msg;
        }
    }
    my (@SSList, @loginList);
    @SSList=(); @loginList=();
    foreach $dbString (@classList) {
        unless ($dbString =~ /\S/)  {next;}
        chomp $dbString;
        my @classListRecord=&getRecord($dbString);
        my ($studentID, $lastName, $firstName, $status, $comment,  $section,$recitation, $email_address, $login_name)
          = @classListRecord;
      #  next if &dropStatus($status);   ## ignore students who have dropped
        unless ($studentID =~ /^[\w\-\.]+$/) {
            $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. The record
            \n$dbString  \n contains the invalid studentID: $studentID
            \n studentID's can contain only upper and lower case letters, digits, -, dot('.'), and _
            \n You must correct this and then run this script again.\n\n";
            return $msg;
        }
        unless ($login_name =~ /^[\w\-\.]+$/) {
            $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. The record
            \n$dbString  \n contains the invalid loginName: $login_name
            \n loginName's can contain only upper and lower case letters, digits, -, dot('.'), and _
            \n You must correct this and then run this script again.\n\n";
            return $msg;
        }

        ## test entries for bad characters.
		my @entries = ($lastName, $firstName, $status, $comment,  $section,$recitation, $email_address);
		my $item ='';
		foreach $item (@entries) {
			my $msg = test_entry($item);
			unless ($msg eq 'OK') {return $msg;}
		}

        push(@SSList,$studentID);
        push(@loginList,$login_name);
    }
    @SSList = sort(@SSList);
    for ($i=0; $i < @SSList-1; $i++) {
        if ($SSList[$i] eq $SSList[$i+1]) {
            $msg = "\n\n The classlist file\n$fileName\n\n is corrupted. Duplicate studentID's equal
            to $SSList[$i] in\n $fileName\nYou must correct this and then run this script again.\n\n";
            return $msg;
        }
    }
    @loginList = sort(@loginList);
    for ($i=0; $i < @loginList-1; $i++) {
        if ($loginList[$i] eq $loginList[$i+1]) {
            $msg ="\n\n The classlist file\n$fileName\n\n is corrupted. Duplicate loginNames equal
            to $loginList[$i] in\n
            $fileName\nYou must correct this and then run this script again.\n\n";
            return $msg;
        }
    }
    $msg ='OK';
    return $msg;
}

### macros for writing and reading html tables

sub array2htmlRow {
    ## The parameter is an array whose entries will beccome elements of a row
    ## in an html table.  The output is a string formated the same way Excel
    ## formats html tables: numbers aligned right, other things left.

    my @inArray = @_;
    my ($item,$align);
    my $outString ='';
    $outString = join '','<TR ALIGN="left" VALIGN="bottom">',"\n";
    foreach $item (@inArray) {
        unless ($item =~ /\S/) {$item = '&nbsp;';}
        if ($item =~/^[\d\.]+$/){$align ='RIGHT'} else {$align ='LEFT'}
        $outString .= join '','<TD ALIGN=',$align,'>',"\n";
        $outString .= join '',$item,'</TD>',"\n";
    }
    $outString .= join '','</TR>',"\n";
}

sub array2htmlRowForm {
    ## The parameter is an array whose first entry is the row number (1, 2, etc)
    ## and remaining entries will become elements of a row
    ## in an html table.

    my ($row,@inArray) = @_;
    my ($item,$size);
    my $outString ='';
    my $col =1;
    $outString = join '','<TR ALIGN=LEFT VALIGN=BOTTOM>',"\n";
    foreach $item (@inArray) {
        unless ($item =~ /\S/) {$item = ' ';}
        $size = length($item);
        $outString .= join '','<TD>',"\n";
        $outString .= join '','<INPUT TYPE="TEXT" SIZE = ', $size, ' NAME="',"row${row}col$col",'" VALUE="',"$item",'"> </TD>',"\n";

        $col++;
    }
    $outString .= join '','</TR>',"\n";
}

sub delimitedArray2htmlTable    {

    #       Takes a ref to an array whose elements are rows of a delimited file
    #       and outputs a string containing
    #       an html table version of the array suitable for viewing and editing
    #       in Excel or a browser such as Netscape/Communicator.    If the second
    #       optional parameter is 'htmlform', the output is an html form. Otherwise
    #       the output is a plain html document.
    #       Blank lines are skipped. White space is removed.

    my ($inArrayref, $type) = @_;

    ## setup html header and initial table stuff
    my $rowString;
    my $outString = "<Table border>\n";

    ## translate data from delimited format to html format
    my $row =1;
    foreach (@$inArrayref)
        {
        unless ($_ =~ /\S/)  {next;}               ## skip blank lines
        chomp;
        if ( (defined $type) and ($type eq 'htmlform')) {$rowString = &array2htmlRowForm($row, &getRecord($_));}
        else  {$rowString = &array2htmlRow(&getRecord($_));}
        $outString .= $rowString;
        $row++;
    }

    ## setup html end table
    $outString .= join '','</Table>',"\n" ;
}

sub delimitedArray2html    {

    #       Takes a ref to an array whose elements are rows of a delimited file
    #       and outputs a string containing
    #       an html version of the array suitable for viewing and editing
    #       in Excel or a browser such as Netscape/Communicator.  The $label is the name
    #       appearing at the top of the form or page.  If the third
    #       optional parameter is 'htmlform', the output is an html form. Otherwise
    #       the output is a plain html document.
    #       Blank lines are skipped. White space is removed.

    my ($inArrayref, $label, $type) = @_;

    ## setup html header and initial table stuff
    my $rowString;
    my $outString = join '','<HTML>',"\n" ,'<HEAD>',"\n", '<TITLE>';
    $outString .=  join '',$label,'</TITLE>',"\n",'</HEAD>',"\n",'<BODY>',"\n";
    $outString .=  join '','<H1><CENTER>',$label,'</CENTER></H1>',"\n";
    $outString .=  &delimitedArray2htmlTable($inArrayref, $type);

    ## setup html footer stuff
    $outString .= join '','</BODY>',"\n", '</HTML>';
}


sub delim2html    {

    #       Takes a delimited file name as input and outputs a string containing
    #       an html version of the input file suitable for viewing and editing
    #       in Excel or a browser such as Netscape/Communicator.  If the second
    #       optional parameter is 'htmlform', the output is an html form. Otherwise
    #       the output is a plain html document.
    #       Blank lines are skipped. White space is removed.

    my ($inFileName,$type) = @_;

    my $shortFileName = $inFileName;
    unless (defined($type) and $type eq 'htmlform') {$type = 'html';}
    if ($shortFileName =~ m|$dd|)  {
        $shortFileName =~ m|$dd([^$dd]*)$|;  ## extract filename from full path name
        $shortFileName = $1;
    }
    $shortFileName =~ s|\..*||;      ## remove extension
    open(INFILE, $inFileName) || wwerror("$0", "can't open $inFileName");
    my @outArray = <INFILE>;
    close(INFILE);
    my $outString = delimitedArray2html(\@outArray,$shortFileName,$type);
    $outString;
}




sub htmlPage2htmlTable {    ## Takes a string which contains a full html page
                            ## containing a single table and removes all the
                            ## header and footer material leaving only the row
                            ## entries between <table> and </table>. Also removes all the
                            ## <font ...> and </font> stuff from within the table.
                            ## The cleaned up string is returned.

    my ($inString) = @_;
    $inString =~ s|^.*<\s*table.*?>||is;    ## remove <table> and stuff before
    $inString =~ s|<\s*/table\s*>.*?$||is;  ## remove </table> and stuff after
    $inString =~ s|<\s*/*font.*?>||gis;     ## remove font stuff
    $inString =~ s|>[^>]*$|>|s;             ## remove any stuff after last >
    $inString;
}

sub htmlTable2delim {   ## Takes a string (e.g. output from htmlPage2htmlTable) which
                        ## contains the rows from an html table and returns a string
                        ## containing the table data in delimited format.

    my ($inString) = @_;
    my ($outString, $item, $rowString);
    $outString ='';
    while ($inString){
        $inString =~ s|^(.*?<\s*/tr\s*>)||is;   # get next row
        $item = $1;
        $rowString = join("${DELIM}",&htmlRow2array($item));
        $outString .= join '', $rowString, " \n";
    }
    $outString;
}

sub htmlForm2delim {    ## Takes a reference to the associtive array of inputs from
                        ## a form. The $inputs{row5col8} is the element for the 5th row
                        ## and 8 column.  It is assumed the input is a rectangular array
                        ##Returns a string containing the table data in delimited format.

    my ($inputsref) = @_;
    my %inputs = %$inputsref;
    my ($item, $index,$row,$col);
    my  $maxCol = 1;
    my  $maxRow = 1;
    my @rowColIndex = grep /^row\d+col\d+$/, keys %inputs;
    foreach $index (@rowColIndex) {
        $index =~ /^row(\d+)col(\d+)$/;
        if ($1 > $maxRow) {$maxRow = $1};
        if ($2 > $maxCol) {$maxCol = $2};
    }

    my @outArray =();
    my $rowString ='';
    my @rowArray= ();

    for $row (1..$maxRow) {
        @rowArray= ();
        for $col (1..$maxCol) {push @rowArray, $inputs{"row${row}col${col}"};}
        $rowString = join("${DELIM}",@rowArray);
        push (@outArray,$rowString);
    }
    @outArray = &columnArrayArrange(@outArray); ## line up columns
    my $outString = join('',@outArray);
    $outString;
}



sub htmlRow2array {
    ## The parameter is a string "<TR ... /TR>" containing one row
    ## in an html table.  The output is an array containing the entries
    ## contained in that row.

    my ($inString) = @_;
    $inString =~ s|^.*<\s*tr.*?>||is;       ## remove <tr> and stuff before
    $inString =~ s|<\s*/tr\s*>.*$||is;      ## remove </tr> and stuff after
    $inString =~ s|>[^>]*$|>|s;             ## remove any stuff after last >

    my @outArray =();
    my $item;
    while ($inString){
        $inString =~ s%^(.*?<)\s*/t[d|h]\s*>%%is;   # get next entry
        $item = $1;
        $item =~ m|>\s*(.*?)<|is;                   # get entry
        $item =$1;
        $item =~ s|\s*$||;                          # remove trailing spaces
        if (($item eq '&nbsp;') or ($item eq '')) {$item =' '}
        push @outArray, $item;
    }
    @outArray;
}


 ## this subroutine prints all environment variables.
 ## adapted from http://www.cgi-resources.com/Documentation/Environment_Variables/
 ## takes parameters html_top, html_bot which print html top and bottom matter if set
sub printEnvVars {

my ($top, $bot) = @_;
my ($bigcontent, @content, $content,$name,$value,%input,$tvar,$key);
      # First, if METHOD=GET  we grab the environment variable
      # containing the Query_String - otherwise we grab the
      # environment variable Content_Length.
if ($ENV{'REQUEST_METHOD'} eq "GET") {
     $bigcontent = $ENV{'QUERY_STRING'};
    } # Close if bracket
else {
    read(STDIN, $bigcontent, $ENV{'CONTENT_LENGTH'});
    } # Close else bracket
      # bigcontent now contains a long string which is broken by
      # ampersands between the various form elements.  So let's split
      # it and load it into an array
@content = split(/&/, $bigcontent);
      # But we aren't done yet. All of the spaces in the form data
      # were replaced by pluses.  Other non-alpha characters except
      # equal signs were replaced by their hex values. So now we
      # need to step through the array and translate them back into
      # their "sent" form.
foreach $content (@content) {
      # Split HTML form's "NAME" and "VALUE" at equal signs
    ($name, $value) = split(/=/, $content);
      # Replace the pluses with spaces
    $value =~ tr/+/ /;
      # Translate the hex (now preceded by percent sign) into ASCII
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      # And finish by loading input variables for use in program.
      # You call it by $input{'formvarname'} to get the literal
      # that the user typed into that field on the Form.
    $input{$name} = $value;
    } # Close bracket for foreach loop

      # Tell the server that we are going to send it to user's browser
if ($top eq 'html_top') {print "Content-type: text/html\n\n";
      # So we don't have to type backslashes everywhere before reserved
      # characters in the HTML, we use this so the PERL compiler will
      # know that what follows is literal (except for variable names)
      # But be careful - still need backslash in front of literal at
      # signs, dollar signs, etc., since PERL assumes a variable name
      # follows these characters.
    print <<ENDOFTEXT;
    <HTML><HEAD><TITLE>Environment Variable
    Test</TITLE></HEAD>
    <BODY BGCOLOR="#FFFFFF">

ENDOFTEXT
}
     # Now, simply sort and print the names and values of each of the
     # environment variables from the keyed array to browser window
foreach $key (sort keys(%ENV)) {print
"<B>$key:<\/B>$ENV{$key}<BR>";}

if ($bot eq 'html_bot') {
    print <<ENDOFTEXT;

    <P>
    </BODY>
    </HTML>
ENDOFTEXT

}
}

sub backupFile  {
    ## takes as a parameter the full filename
    ## makes upto three backups of file with x, y, or z appended to filename where x
    ## the most recent backup

    my $fileName =$_[0];
    my $orgFileName = "$fileName";
    my ($ext, $fnMinusExt,$noPeriod);
    if (! ($orgFileName =~ m|\.|)) {
        $noPeriod =1;
        $fnMinusExt = $orgFileName;
        $ext ='';
    }
    else {
        $noPeriod =0;
        $orgFileName =~ m|^(.*)\.([^\.]*)$|;
        $fnMinusExt = $1;
        $ext = $2;
    }
    my $period = '.';
    $period = '' if $noPeriod;
    if (-e "${fnMinusExt}y${period}${ext}") {
        rename("${fnMinusExt}y${period}$ext","${fnMinusExt}z${period}$ext") or
          &wwerror("$0","can't rename ${fnMinusExt}y${period}$ext");
    }

    if (-e "${fnMinusExt}x${period}$ext") {
        rename("${fnMinusExt}x${period}$ext","${fnMinusExt}y${period}$ext") or
          &wwerror("$0","can't rename ${fnMinusExt}x${period}$ext");
    }

    if (-e "${fnMinusExt}${period}$ext") {
        rename("${fnMinusExt}${period}$ext","${fnMinusExt}x${period}$ext") or
          &wwerror("$0","can't rename ${fnMinusExt}${period}$ext");
    }
}

sub stripWhiteSpace {       ## strip initial and trailing whitespace
    my $string = $_[0];
    $string =~ s/\s*$//;     # remove trailing whitespace
    $string =~ s/^\s*//;     # remove initial spaces
    $string;
}

sub test_entry{			## check for bad characters. & and = are used as delimiters
						## in databases. DELIM (usually a coma) is used in csv files
	my $entry = shift;
	my $msg = 'OK';
	if ($entry =~ /[=&$DELIM]/) {
		$msg = "      The entry: $entry  is invalid.
        An entry can not contain any of the following characters: $DELIM  &  =
        You must go back and correct this.\n";
	}
	$msg;
}

sub testNewStudentLogin {
	my $login_name = shift;
	my $newStudentID = shift;
	my $msg = 'OK';
	unless ($login_name =~ /^[\w\-\.]+$/) {
		$msg = "      The login name: $login_name  is invalid.
        Login name's can contain only upper and lower case letters, digits, -, dot('.'), and _
        you must go back and correct this.\n";
		return $msg;
	}
	my %currentLogins = %{getLoginName_StudentID_Hash()};
	if (defined $currentLogins{$login_name}){
		attachCLRecord($login_name);

		my $studentLastName	= CL_getStudentLastName($login_name);
		my $studentFirstName	= CL_getStudentFirstName($login_name);
		my $studentID		= CL_getStudentID($login_name);

		$msg = "      The login name: $login_name  is already in use.
        It is assigned to $studentFirstName $studentLastName ($studentID).
        You must go back and choose a login name which is not yet being used.\n";
		return $msg;
	}
	$msg;
}


sub testNewStudentID {
	my $studentID = shift;
	my $newLogin_name = shift;
	my $msg ='OK';
	unless ($studentID =~ /^[\w\-\.]+$/) {
		$msg = "      The student ID: $studentID  is invalid.
        student ID's can contain only upper and lower case letters, digits, -, dot('.'), and _
        you must go back and correct this.\n";
		return ($msg);
	}
	my %currentIDs = %{getStudentID_LoginName_Hash()};

	if (defined $currentIDs{$studentID}) {
		my $oldLogin = $currentIDs{$studentID};
		attachCLRecord($oldLogin);

		my $studentLastName	= CL_getStudentLastName($oldLogin);
		my $studentFirstName	= CL_getStudentFirstName($oldLogin);


		$msg = "      The student ID: $studentID  is already in use.
        It is assigned to $studentFirstName $studentLastName ($oldLogin).
        you must go back and choose a student ID which is not yet being used.\n";
		return $msg;
	}
	$msg;
}

sub getClasslistFilesAndLabels { 	## returns a two element array
									## the 0th element is a ref to an array of files
									## the 1st element is a ref to a hash of labels
	my $Course = shift;
	my $defaultClasslistFile    = getCourseClasslistFile($Course);

	## find the available files

	opendir CLASSLISTDIR, $templateDirectory or wweror($0,"Can't open directory $templateDirectory");
	my @allFiles = grep !/^\./, readdir CLASSLISTDIR;
	closedir  CLASSLISTDIR;

    ## sort the files

	my @classlistFiles = grep /\.lst$/,@allFiles;
	my @sortedNames = sort @classlistFiles;

    ## put the default classlist file first if it exists
	my $shortFileName = $defaultClasslistFile;
    if ($shortFileName =~ m|$dd|)  {
        $shortFileName =~ m|$dd([^$dd]*)$|;  ## extract filename from full path name
        $shortFileName = $1;
    }
	my @newSortedNames  = grep !/^$shortFileName$/, @sortedNames;
	if ($#newSortedNames != $#sortedNames) {
    	unshift @newSortedNames,$shortFileName;
    	@sortedNames = @newSortedNames;
	}

    ## generate labels
    my %label_hash = ();

	my ($ind,$date,$fileName,@stat);
	for $ind (@sortedNames) {
    	$fileName = "${templateDirectory}$ind";
	    if (-e $fileName) {
	        @stat = stat($fileName);
	        $date = $stat[9];
	        $date = formatDateAndTime($date);
	        $date =~ s|\s*at.*||;
	        $label_hash{$ind} = "$ind --- Last Changed $date";
	    }
	}
	(\@sortedNames,\%label_hash);
}




1;