#!/usr/local/bin/perl


# file: classlist_DBglue.pl

# These are the tools for accessing the classlist database which contains
# all of the information for a given student. Within the record there are methods
# for accessing the data in the record, such as the student's name, ID, and so forth. \
# The only direct "ties"  un "untie" to the database on disk are through the two routines
# read_class_list_record and save_class_list_record.

# The normal key for a record is the student login id, e.g. apizer .
# Special keys (e.g. >>lock_status) always begin with >> .

# The directory names are defined in the header.

# Define file name for databases.
use strict;


# define global file variables
my %CLASSLIST;
my %MYCLASSLIST; # used for temporary sorting by last name and by section;
my %CL_Record;
my $CL_Database = $Global::CL_Database;
my $databaseDirectory = $Global::databaseDirectory;

my $scriptDirectory = &Global::getWebworkScriptDirectory();

my $CL_DbObj;            # Object for referencing the database
                 # how do we make this a local variable (or can we?)
my $LOCK_SH = 1 ;       # shared lock
my $LOCK_EX = 2 ;       # exclusive lock
my $LOCK_NB = 4 ;       # non-blocking
my $LOCK_UN = 8 ;       # unlock


# These open and close the database containing the classList Records.
#   They should only be used internally to this file.

sub attachCL {  # returns 1 if succesful
    my $mode = $_[0] || 'reader';
    my ($flag);
    &Global::error("DB error", "attachCL doesn't know mode $mode")
      unless ($mode eq 'reader' || $mode eq 'writer');

    if ($mode eq 'reader') {$flag = 'R'}
    else {$flag = 'W'}
    &read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", $flag, $Global::standard_tie_permission);

    if ($flag eq 'W') {
    	my $status = $CLASSLIST{'>>lock_status'};
    	unless ((!defined $status) or ($status eq 'unlocked') or ((defined $Global::over_ride_CLBD_lock) 
    	  and $Global::over_ride_CLBD_lock))  {
    		&save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
    		wwerror("The Classlist Database is LOCKED", "This means the database can not be updated from the internet
(e.g. students can not change their email addresses). Probably your professor is working on the database.
if this problem persists, tell your peofessor. Perhaps he or she forgot to unlock the database.");

    	}

    }
}


sub detachCL {
    &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
    1;              # Explicitly return 1 if successful, if not it has already died
}

sub read_CL_record {
    my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_;
    &Global::tie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission);
}


sub save_CL_record {
    my ($dbObj_ref, $hash_ref, $file_name) = @_;
    &Global::untie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name);
}

sub attachCLRecord {
    my($user)=@_;
    return 0 unless defined($user);  # can't find record if you don't tell me the record id.
    my($flag)=0;
    %CL_Record=();
    &attachCL();   #attaches DBM file to %CLASSLIST
    # unpack the line into %CL_Record
    if (  $flag=defined($CLASSLIST{"$user"})   ) {
        my $string = $CLASSLIST{"$user"};
        $string =~ s/=$/= /;   # this makes sure that the last element has a value.  It may cause trouble if this value was supposed to be nil instead of a space.
        my @CL_Record=split(/[\&=]/,$string);

        %CL_Record=@CL_Record;
        }
    &detachCL;
    #   The classlist record corresponding to the $user is now in %CL_Record
    $flag; # 1  means you got something
}

sub saveCLRecord {  #data is in CL_Record
    my($user)=@_;
    my ($out,@ind,@setList,%setList,@loginList,%loginList);
    my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString);
    &attachCL('writer');   #attaches DBM file to %CLASSLIST

# Prepare the new record and place it into %CLASSLIST DBM file
    $out='';
    @ind=keys(%CL_Record);
        my $i;
        foreach $i (@ind) {
        $out=$out . $i . '=' . $CL_Record{$i} . "&" ;
        };
    chop($out);   #remove the final & from the string.


	$CLASSLIST{$user}=$out;

	if (&detachCL) {
	    return 1; # returns 1 if successful
	} else {
	 	wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","","");
	 	return 0;
	}
#   The contents of %CL_Record has now been placed in the problem set record data
#   base with key given by $CL_Record
}



sub getClassListRecord { #returns the contents of the current record hash
    %CL_Record;
    }

sub deleteClassListRecord {
    my ($user)=@_;
    my $flag = 1;
    $flag = $flag && &attachCL('writer');   #attaches DBM file to %CLASSLIST  # get the necessary data

    # erase the record itself
    $flag=$flag && defined($CLASSLIST{$user});
    delete $CLASSLIST{$user};
    &detachCL();
    }

#######StudentLastName###########################
sub CL_putStudentLastName {
    my($val,$user) = @_;
    $CL_Record{'stln'}=$val;
    }
sub CL_getStudentLastName {
    my  ($user) = @_;
    return( $CL_Record{'stln'} );
    }

sub CL_deleteStudentLastName {
    my  ($user) = @_;
    delete $CL_Record{'stln'};
    }

#######StudentFirstName###########################
sub CL_putStudentFirstName {
    my  ($val,$user) = @_;
    $CL_Record{'stfn'}=$val;
    }
sub CL_getStudentFirstName {
    my  ($user) = @_;
    return( $CL_Record{'stfn'} );
    }

sub CL_deleteStudentFirstName {
    my  ($user) = @_;
    delete $CL_Record{'stfn'};
    }

#######EmailAddress########################

sub CL_putStudentEmailAddress {
        my  ($val, $user) = @_;
        $CL_Record{'stea'}=$val;
        }
sub CL_getStudentEmailAddress {
        my  ($user) = @_;
        return( $CL_Record{'stea'} );
        }
sub CL_deleteStudentEmailAddress {
        my  ($user) = @_;
        delete $CL_Record{'stea'};
        }

#######StudentID###########################
sub CL_putStudentID {
    my  ($val,$user) = @_;
    $CL_Record{'stid'}=$val;
    }
sub CL_getStudentID {
    my  ($user) = @_;
    return( $CL_Record{'stid'} );
    }

sub CL_deleteStudentID {
    my  ($user) = @_;
    delete $CL_Record{'stid'};
    }


#######StudentStatus###########################
sub CL_putStudentStatus {
    my  ($val,$user) = @_;
    $CL_Record{'stst'}=$val;
    }
sub CL_getStudentStatus {
    my  ($user) = @_;
    return( $CL_Record{'stst'} );
    }

sub CL_deleteStudentStatus {
    my  ($user) = @_;
    delete $CL_Record{'stst'};
    }


#######ClassSection###########################
sub CL_putClassSection {
    my  ($val,$user) = @_;
    $CL_Record{'clsn'}=$val;
    }
sub CL_getClassSection {
    my  ($user) = @_;
    return( $CL_Record{'clsn'} );
    }

sub CL_deleteClassSection {
    my  ($user) = @_;
    delete $CL_Record{'clsn'};
    }

#######ClassRecitation###########################
sub CL_putClassRecitation {
    my  ($val,$user) = @_;
    $CL_Record{'clrc'}=$val;
    }
sub CL_getClassRecitation {
    my  ($user) = @_;
    return( $CL_Record{'clrc'} );
    }

sub CL_deleteClassRecitation {
    my  ($user) = @_;
    delete $CL_Record{'clrc'};
    }

#######Comment###########################
sub CL_putComment {
    my  ($val,$user) = @_;
    $CL_Record{'comt'}=$val;
    }
sub CL_getComment {
    my  ($user) = @_;
    return( $CL_Record{'comt'} );
    }

sub CL_deleteComment {
    my  ($user) = @_;
    delete $CL_Record{'comt'};
    }

############Other methods#########################

## lock and unlock CL database

sub lock_CL_database {
	$Global::over_ride_CLBD_lock = 0;  ## reset just to be sure
	&attachCL('writer');
	$CLASSLIST{'>>lock_status'}='locked';
	if (&detachCL) {
	    return 1; # returns 1 if successful
	} else {
	 	wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","","");
	 	return 0;
	}
}

sub unlock_CL_database {  ## we have to by pass standard routines since we want to unlock a locked database over the web
	$Global::over_ride_CLBD_lock = 0;  ## reset just to be sure
	&read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", 'W', $Global::standard_tie_permission);
	$CLASSLIST{'>>lock_status'}='unlocked';
	&save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}");
}

sub get_CL_database_status {
	&attachCL();
	return $CLASSLIST{'>>lock_status'};
	&detachCL();
}

# &getAllLoginNames

sub getAllLoginNames {
    &attachCL();
    my  (@lst)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
    &detachCL();
    \@lst;
    }

sub getAllLoginNamesSortedByName {

    &attachCL();
    my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
    %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
    &detachCL();

    @out=sort (CL_byLastName @out);
    \@out;
}

sub getAllLoginNamesSortedBySectionThenByName {

    &attachCL();
    my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
    %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
    &detachCL();

    @out=sort (CL_bySectionThenByName @out);
    \@out;
}

sub getAllLoginNamesSortedByRecitationThenByName {

    &attachCL();
    my  (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >>
    %MYCLASSLIST = %CLASSLIST;  # CL_byLastName needs this hash to sort with
    &detachCL();

    @out=sort (CL_byRecitationThenByName @out);
    \@out;
}


sub getLoginName_StudentID_Hash {

	my @userNames = @{getAllLoginNames()};
	my ($user, %loginName_StudentID_Hash);
	foreach $user (@userNames) {
		attachCLRecord($user);
		$loginName_StudentID_Hash{$user} = CL_getStudentID($user);
	}
	\%loginName_StudentID_Hash;
}

sub getStudentID_LoginName_Hash {

	my %studentID_LoginName_Hash = reverse %{getLoginName_StudentID_Hash()};
	\%studentID_LoginName_Hash;
}

sub getAllSections{

	my @userNames = @{getAllLoginNames()};
	my ($user, $section,%section_Hash);
	foreach $user (@userNames) {
		attachCLRecord($user);
		$section= CL_getClassSection($user);
		$section_Hash{$section}++;
	}

	\%section_Hash;
}

sub getAllRecitations{

	my @userNames = @{getAllLoginNames()};
	my ($user, $recitation,%recitation_Hash);
	foreach $user (@userNames) {
		attachCLRecord($user);
		$recitation= CL_getClassRecitation($user);
		$recitation_Hash{$recitation}++;
	}

	\%recitation_Hash;
}

sub CL_getStudentName  {
        my($user) = @_;
        my($fname) = &CL_getStudentFirstName($user);
        my($lname) = &CL_getStudentLastName($user);
        $fname = '' unless defined $fname;
        $lname = '' unless defined $lname;
        my($out) = "$fname $lname";
        $out =~ s/\s\s+/ /g;     # remove any extra spaces
        $out;
        }

#### this will break if the codes are changed !!!!!!!! ###############

sub CL_byLastName {

            $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
            my $ln1 = $1;   # last name sorted first
            $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
            my $fn1= $1;    # then first name

            $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
            my $ln2 = $1;
            $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
            my $fn2= $1;

            my $t = $ln1 cmp $ln2; # compare last name
            $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
            $t;
}
#### this will break if the codes are changed !!!!!!!! ###############
sub CL_bySectionThenByName {

    $MYCLASSLIST{$a} =~ /clsn=([^&]*)/;
    my $cs1 = $1;   # class section sorted first
    $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
    my $ln1 = $1;   # then last name
    $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
    my $fn1= $1;    # then first name

    $MYCLASSLIST{$b} =~ /clsn=([^&]*)/;
    my $cs2 = $1;
    $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
    my $ln2 = $1;
    $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
    my $fn2= $1;


    my $t = $cs1 cmp $cs2; # compare class section
    $t = $ln1 cmp $ln2  unless $t; # if class sections are equal compare last name
    $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
    $t;
}

#### this will break if the codes are changed !!!!!!!! ###############
sub CL_byRecitationThenByName {

    $MYCLASSLIST{$a} =~ /clrc=([^&]*)/;
    my $cs1 = $1;   # class recitation sorted first
    $MYCLASSLIST{$a} =~ /stln=([^&]*)/;
    my $ln1 = $1;   # then last name
    $MYCLASSLIST{$a} =~ /stfn=([^&]*)/;
    my $fn1= $1;    # then first name

    $MYCLASSLIST{$b} =~ /clrc=([^&]*)/;
    my $cs2 = $1;
    $MYCLASSLIST{$b} =~ /stln=([^&]*)/;
    my $ln2 = $1;
    $MYCLASSLIST{$b} =~ /stfn=([^&]*)/;
    my $fn2= $1;


    my $t = $cs1 cmp $cs2; # compare class recitation
    $t = $ln1 cmp $ln2  unless $t; # if class recitations are equal compare last name
    $t = $fn1 cmp $fn2  unless $t; # if last names equal, compare first names
    $t;
}





1;