#!/usr/local/bin/perl

# #############################################################
# Copyright © 1995,1996,1997,1998 University of Rochester
# All Rights Reserved
# #############################################################

# file: DBglue7.pl

# These are the tools for accessing the  database which contains
# all of the information for a given PIN number. Within the pinRecord there are methods
# for accessing the data in the record, such as the student's name, ID, the set number
# the problems in the set, the due dates and so forth. The only direct "ties"  un "untie"
# to the database on disk are through the two routines  read_psvn_record and
# save_psvn_record.

# The directory names are defined in the header.

# Define file name for databases.
use strict;


# define global file variables
my %PROBSET;
my %probSetRecord;
my $Database = $Global::database;
my $databaseDirectory = $Global::databaseDirectory;

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

my $wwDbObj;            # Object for referencing the database
my %MYPROBSET;   # used for temporary sorting by last name and by section or recitation;
                 # 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 pinRecords.
#   They should only be used internally to this file.

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

    if ($mode eq 'reader') {$flag = 'R'}
    else {$flag = 'W'}
    &read_psvn_record(\$wwDbObj, \%PROBSET, "${databaseDirectory}${Database}", $flag, $Global::standard_tie_permission);
}


sub detachDBMpin {
    &save_psvn_record(\$wwDbObj, \%PROBSET,"${databaseDirectory}${Database}");
    1;              # Explicitly return 1 if successful, if not it has already died
}



sub fetchProbSetRecord {  # synonym for attachProbSetRecord
    attachProbSetRecord(@_);
    }
sub attachProbSetRecord {
    my($probSetKey)=@_;
    return 0 unless defined($probSetKey);  # can't find record if you don't tell me the record id.
    my($flag)=0;
    %probSetRecord=();
    &attachDBMpin();   #attaches DBM file to %PROBSET
    # unpack the line into %probSetRecord
    if (  $flag=defined($PROBSET{"$probSetKey"})   ) {
        my $string = $PROBSET{"$probSetKey"};
        $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 @probSetRecord=split(/[\&=]/,$string);
#        if (scalar(@probSetRecord) % 2 == 1) {
#           print "<BR>size of probSetRecord = ",scalar(@probSetRecord),"<BR>";
#           print "<BR>hash list= <BR>|$PROBSET{$probSetKey}|<BR><BR>";
#           #print "probSetRecord", join("|<BR>|\n",@probSetRecord), "<BR><BR>";
#       }
        %probSetRecord=@probSetRecord;
        }
    &detachDBMpin;
    #   The problem set record corresponding to the $probSetKey is now in %probSetRecord
    $flag; # 1  means you got something
    }
sub saveProbSetRecord { # synonym for detachProbSetRecord
    detachProbSetRecord(@_);
    }
sub detachProbSetRecord {  #data is in probSetRecord
    my($probSetKey)=@_;
    my ($out,@ind,@setList,%setList,@loginList,%loginList);
    my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString);
    &attachDBMpin('writer');   #attaches DBM file to %PROBSET
#   &attachDBMpin;   # used to replace line above when experimenting with database attachment speed.
# First get the old record so that we can see if either the loginID or the setNumber
# has changed
    my %old_record_string = ();
    if (defined($PROBSET{$probSetKey}) ) {
	    my $old_record_string = $PROBSET{$probSetKey};
        $old_record_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 @old_record_string = split(/[\&=]/,$old_record_string);
	    %old_record_string = @old_record_string;
	}


    $oldLoginID   = defined($old_record_string{'stlg'}) ? $old_record_string{'stlg'} : "";
    $oldSetNumber = defined($old_record_string{'stnm'}) ? $old_record_string{'stnm'} : "";
    $setNumber = $probSetRecord{'stnm'};
    $loginID = $probSetRecord{'stlg'};
# Next prepare the new record and place it into %PROBSET DBM file
    $out="";
    @ind=keys(%probSetRecord);
        my $i;
        foreach $i (@ind) {
        $out=$out . $i . '=' . $probSetRecord{$i} . "&" ;
        };
    chop($out);   #remove the final & from the string.


	$PROBSET{$probSetKey}=$out;

## Updating the set index and the login index only has to be done if one of the
## items loginID or setNumber has changed or if they didn't exist before.

	if (     defined($PROBSET{$probSetKey}) and
		     ( $loginID eq $oldLoginID)   and
		     ($setNumber eq $oldSetNumber)
	    ) {

		# warn "saving DB -- no changes to indices";
	} else {
		## The rest of the code updates the index files if that is necessary.

		## First delete out of date information if setNumber or loginID has changed
		if  ( defined($oldSetNumber) and defined($oldLoginID) and
			    (   $setNumber ne $oldSetNumber  or $loginID   ne $oldLoginID  )
			     )  {
		## delete out of date reference to the oldLogin in the oldSetNumber

	        $recordString = $PROBSET{"set<>$oldSetNumber"};
	        $recordString = "" unless defined($recordString);
	        my @oldSetList=split(/[\&=]/,$recordString);
	        my %oldSetList=@oldSetList;
            delete $oldSetList{"$oldLoginID"};
            $out = "";
            my $indx;
	        foreach $indx (keys %oldSetList) {
	            $out=$out . $indx . '=' . $oldSetList{$indx} . "&" ;
	            };
	        chop($out);   #remove the final & from the string.
	        if ($out eq "") {
	           delete $PROBSET {"set<>$oldSetNumber"};
	        } else {
	            $PROBSET{"set<>$oldSetNumber"}= $out;
	        }

	            $recordString = $PROBSET{"login<>$oldLoginID"};
	            $recordString = "" unless defined($recordString);
	            @loginList=split(/[\&=]/,$recordString);
	            %loginList=@loginList;
	            delete $loginList{"$oldSetNumber"};
	            $out = "";
	            my $i;
	            foreach $i (keys %loginList) {
	                $out=$out . $i . '=' . $loginList{$i} . "&" ;
	                };
	            chop($out);   #remove the final & from the string.
	            if ($out eq "") {
	                delete  $PROBSET{"login<>$oldLoginID"};
	            }
	            else {
	                $PROBSET{"login<>$oldLoginID"}= $out;
	            }
		    }


		#   Update index for sets:
		#       For every set, this is a list containing all the loginID's for the set and the corresponding
		#       psvn's. Each loginID and psvn can occur only once. Format loginID = psvn
		      ##      Now enter new data

		        $recordString = $PROBSET{"set<>$setNumber"};
		        $recordString = "" unless defined($recordString);
		        @setList=split(/[\&=]/,$recordString);
		        %setList=@setList;
		  	    $setList{"$loginID"}=$probSetKey;
		        @ind=keys(%setList);
		        $out = "";
		        foreach $i (@ind) {
		            $out=$out . $i . '=' . $setList{$i} . "&" ;
		            };
		        chop($out);   #remove the final & from the string.
		        if ($out eq "") {
		           delete $PROBSET {"set<>$setNumber"};
		           }
		        else {
		            $PROBSET{"set<>$setNumber"}= $out;
		            }

		#       Update index for loginID's:
		#       For every loginID, this is a list containing all sets for the loginID and the corresponding
		#       psvn's. Each setNumber and psvn can occur only once. Format setNumber = psvn



		##      Now enter new data
		 #       $recordString = "";
		        $recordString = $PROBSET{"login<>$loginID"};
		        $recordString = "" unless defined($recordString);
		        @loginList=split(/[\&=]/,$recordString);
		        %loginList=@loginList;
		        $loginList{"$setNumber"}=$probSetKey;
		        @ind=keys(%loginList);
		        $out = "";
		        foreach $i (@ind) {
		            $out=$out . $i . '=' . $loginList{$i} . "&" ;
		            };
		        chop($out);   #remove the final & from the string.
		        if ($out eq "") {
		            delete  $PROBSET{"login<>$loginID"};
		            }
		        else {
		            $PROBSET{"login<>$loginID"}= $out;
		            }
		          my $temp_key;


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



sub getProbSetRecord { #returns the contents of the current record hash
    %probSetRecord;
    }

sub deleteProbSetRecord { #also assumes that %kprobSetRecord is correctly loaded.
    my ($probSetKey)=@_;
    my ($out,@ind,@setList,%setList,@loginList,%loginList);
    my ($setNumber,$loginID,$recordString);
    my $flag = 1;
    $flag = $flag && &attachDBMpin('writer');   #attaches DBM file to %PROBSET  # get the necessary data
    $setNumber = $probSetRecord{'stnm'};
    $loginID = $probSetRecord{'stlg'};
    #   Update index for sets:

    $recordString = $PROBSET{"set<>$setNumber"};
    @setList=split(/[\&=]/,$recordString);
    %setList=@setList;
    delete  $setList{"$loginID"};
    @ind=keys(%setList);
    $out = "";
    my $i;
    foreach $i (@ind) {
        $out=$out . $i . '=' . $setList{$i} . "&" ;
        };
    chop($out);   #remove the final & from the string.
    if ($out eq "") {
        delete( $PROBSET{"set<>$setNumber"});
    }   else {
        $PROBSET{"set<>$setNumber"}= $out;
    }

    $recordString = $PROBSET{"login<>$loginID"};
    @loginList=split(/[\&=]/,$recordString);
    %loginList=@loginList;
    delete $loginList{"$setNumber"};
    @ind=keys(%loginList);
    $out="";
    foreach $i (@ind) {
        $out=$out . $i . '=' . $loginList{$i} . '&' ;
        };
    chop($out);   #remove the final & from the string.
    if ($out eq "") {
        delete $PROBSET{"login<>$loginID"};
        }
    else {
        $PROBSET{"login<>$loginID"}= $out;
        }
    # erase the record itself
    $flag=$flag && defined($PROBSET{$probSetKey});
    delete $PROBSET{$probSetKey};
    &detachDBMpin();
    }


#######StudentLogin###########################
sub putStudentLogin {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"stlg"}=$val;
    }
sub getStudentLogin {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"stlg"} );
    }

sub deleteStudentLogin {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"stlg"};
    }


#######SetNumber###########################
sub putSetNumber {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"stnm"}=$val;
    }
sub getSetNumber {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"stnm"} );
    }

sub deleteSetNumber {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"stnm"};
    }

#######SetHeaderFileName###########################
sub putSetHeaderFileName {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"shfn"}=$val;
    }
sub getSetHeaderFileName {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"shfn"} );
    }

sub deleteSetHeaderFileName {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"shfn"};
    }

#######ProbHeaderFileName###########################
sub putProbHeaderFileName {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"phfn"}=$val;
    }
sub getProbHeaderFileName {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"phfn"} );
    }

sub deleteProbHeaderFileName {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"phfn"};
    }

#######OpenDate###########################
sub putOpenDate {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"opdt"}=$val;
    }
sub getOpenDate {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"opdt"} );
    }

sub deleteOpenDate {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"opdt"};
    }

#######DueDate###########################
sub putDueDate {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"dudt"}=$val;
    }
sub getDueDate {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"dudt"} );
    }

sub deleteDueDate {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"dudt"};
    }

#######AnswerDate###########################
sub putAnswerDate {
    my  ($val,$probSetKey) = @_;
    $probSetRecord{"andt"}=$val;
    }
sub getAnswerDate {
    my  ($probSetKey) = @_;
    return( $probSetRecord{"andt"} );
    }

sub deleteAnswerDate {
    my  ($probSetKey) = @_;
    delete $probSetRecord{"andt"};
    }



#######ProblemFileName###########################
sub putProblemFileName {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pfn$probNum"}=$val;
    }
sub getProblemFileName {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pfn$probNum"} );
    }

sub deleteProblemFileName {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pfn$probNum"};
}

#######ProblemStudentAnswer###########################
sub putProblemStudentAnswer {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pan$probNum"}=$val;
    }
sub getProblemStudentAnswer {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pan$probNum"} );
    }

sub deleteProblemStudentAnswer {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pan$probNum"};
    }

#######ProblemAttempted###########################
sub putProblemAttempted {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pat$probNum"}=$val;
    }
sub getProblemAttempted {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pat$probNum"} );
    }

sub deleteProblemAttempted {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pat$probNum"};
    }


#######ProblemStatus###########################
sub putProblemStatus {
    my  ($val,$probNum,$probSetKey) = @_;
    $val = 0 unless ($val =~/\w/);
    $probSetRecord{"pst$probNum"}=$val;
    }
sub getProblemStatus {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pst$probNum"} );
    }

sub deleteProblemStatus {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pst$probNum"};
    }

#######ProblemNumOfCorrectAns###########################
sub putProblemNumOfCorrectAns {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pca$probNum"}=$val;
    }
sub getProblemNumOfCorrectAns {
    my  ($probNum,$probSetKey) = @_;
    my  $out =  0;
        $out =  $probSetRecord{"pca$probNum"} if defined($probSetRecord{"pca$probNum"});
    return($out);
    }

sub deleteProblemNumOfCorrectAns {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pca$probNum"};
    }

#######ProblemNumOfIncorrectAns###########################
sub putProblemNumOfIncorrectAns {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pia$probNum"}=$val;
    }
sub getProblemNumOfIncorrectAns {
    my  ($probNum,$probSetKey) = @_;
    my  $out    =   0;
        $out    =   $probSetRecord{"pia$probNum"} if defined($probSetRecord{"pia$probNum"});
    return($out);
    }

sub deleteProblemNumOfIncorrectAns {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pia$probNum"};
    }
#######ProblemMaxNumOfIncorrectAttemps###########################
sub putProblemMaxNumOfIncorrectAttemps {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pmia$probNum"}=$val;
    }
sub getProblemMaxNumOfIncorrectAttemps {
    my  ($probNum,$probSetKey) = @_;
    my  $out =  $probSetRecord{"pmia$probNum"};
    if ( (!defined($out)) or ($out eq '') or ($out < 0)
       )    {
            $out = -1;
    }   else  {
            $out = int($out);
    }
    return($out);
    }

sub deleteProblemMaxNumOfIncorrectAttemps {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pmia$probNum"};
    }
#######ProblemSeed###########################
sub putProblemSeed {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pse$probNum"}=$val;
    }
sub getProblemSeed {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pse$probNum"} );
    }

sub deleteProblemSeed {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pse$probNum"};
    }

#######ProblemValue###########################
sub putProblemValue {
    my  ($val,$probNum,$probSetKey) = @_;
    $probSetRecord{"pva$probNum"}=$val;
    }
sub getProblemValue {
    my  ($probNum,$probSetKey) = @_;
    return( $probSetRecord{"pva$probNum"} );
    }

sub deleteProblemValue {
    my  ($probNum,$probSetKey) = @_;
    delete $probSetRecord{"pva$probNum"};
    }


############Other methods#########################
# &getAllProbSetKeys()

sub getAllProbSetKeys {
    &attachDBMpin();
    my  (@lst)=grep(/^[0-9]+$/ , keys %PROBSET);
    &detachDBMpin();
    @lst;
    }
# &getAllProbSetKeysForStudentLogin($StudentLogin)

sub getAllProbSetKeysForStudentLogin {
    my($studentLogin)=@_;
    my %hash = &getAllSetNumbersForStudentLoginHash($studentLogin);
    values %hash;
    }
sub getAllSetNumbersForStudentLoginHash {
    my($studentLogin)=@_;
    my ($recordString,@loginList,%loginList);
    &attachDBMpin();
    if (defined( $PROBSET{"login<>$studentLogin"}) ) {
        $recordString = $PROBSET{"login<>$studentLogin"};
        }
    else {
        &Global::error("getAllSetNumbersForStudentLoginHash: Can't find index for login $studentLogin");
        }
    &detachDBMpin();
    @loginList=split(/[\&=]/,$recordString);
    %loginList=@loginList;
#   print "\n\n\n<p><H1>studentLogin $studentLogin</H1>\n\n";
#   print "\n\n\n<p><H1>recordString $recordString</H1>\n\n";
#     print "\n\n\n<p><H1>loginList %loginList</H1>\n\n";
    %loginList;  # (setNumber, psvn, 2, 5678, ...)
    }

# &getAllProbSetKeysForSet($setNumber);

sub getAllProbSetKeysForSet {
    my ($setNumber)=@_;
    my ($recordString,@setList,%setList);
    &attachDBMpin();
# read appropriate set index
    if (defined( $PROBSET{"set<>$setNumber"}) ){
        $recordString = $PROBSET{"set<>$setNumber"};
        @setList = split(/[\&=]/,$recordString);
        %setList=@setList;
        }
    else {
        &Global::error("DBglue: getAllProbSetKeysForSet: Can't find index for set number $setNumber" ,
'One reason you will see this error is if there are no existing problem sets.  For example
you will get this error if you delete all problem sets and then return to the prof page or
if you login and then goto Begin Problem Set when no problem sets exist.  If this is the
case (i.e. you have deleted all sets), you can log into the server, goto the directory
.../DATA/ and rename (or delete) the file webwork-database (MAKE SURE YOU ARE DELETING OR
RENAMING THE webwork-database FOR THE CORRECT COURSE). Then when you go to the prof page,
you will be able to build new problem sets.' );
        }
    &detachDBMpin();

    values %setList;  # (psvn,  psvn, ...)
    }

# &getLoginHashForSet($setNumber)
# this is a hash containing all the loginID's (keys) for the set and the corresponding
# psvn's (values).

sub getLoginHashForSet {
    my ($setNumber)=@_;
    my ($recordString,@setList,%setList);
    &attachDBMpin();
# read appropriate set index
    if (defined( $PROBSET{"set<>$setNumber"}) ){
        $recordString = $PROBSET{"set<>$setNumber"};
        @setList = split(/[\&=]/,$recordString);
        %setList=@setList;
        }
    else {
        &Global::error("DBglue: getLoginHashForSet: Can't find index for set number $setNumber" ,
          'One reason you will see this error is if there are no existing problem sets.  For example you
          will get this error if you delete all problem sets and then return to the prof page or
          if you login and then goto Begin Problem Set when no problem sets exist.' );
            }
    &detachDBMpin();

    \%setList;
    }

# &getPSVNHashForSet($setNumber)
# this is a hash containing all the psvn's (keys) for the set and the corresponding
# loginID's (values).


sub getPSVNHashForSet {
    my ($setNumber)=@_;
	my %PSVNHashForSet = reverse %{getLoginHashForSet($setNumber)};
	\%PSVNHashForSet;
}

# &probSetExists($setNumber);

sub probSetExists {
    my ($setNumber)=@_;
    &attachDBMpin();
    my $probSetExists = 0;
    if (defined( $PROBSET{"set<>$setNumber"}) ){$probSetExists = 1;}
    &detachDBMpin();

    $probSetExists;
    }

#sub getAllProbSetKeysForSetSortedByName {
#    my  ($setNumber)=@_;
#    my @out = &getAllProbSetKeysForSet($setNumber);
#    &attachDBMpin();
#    %MYPROBSET = %PROBSET;  # byLastName needs this hash to sort with
#    &detachDBMpin();
#    @out=sort (byLastName @out);
#    @out;
#}

#sub getAllProbSetKeysForSetSortedBySectionThenByName {
#    my  ($setNumber)=@_;
#    my @out = &getAllProbSetKeysForSet($setNumber);
#    &attachDBMpin();
#    %MYPROBSET = %PROBSET;  # bySectionThenByName needs this hash to sort with
#    &detachDBMpin();
#
#
#    @out=sort (bySectionThenByName @out);
#    @out;
#}

#sub getAllProbSetKeysForSetSortedByRecitationThenByName {
#    my  ($setNumber)=@_;
#    my @out = &getAllProbSetKeysForSet($setNumber);
#    &attachDBMpin();
#    %MYPROBSET = %PROBSET;  # byRecitationThenByName needs this hash to sort with
#    &detachDBMpin();
#
#
#    @out=sort (byRecitationThenByName @out);
#    @out;
#}

#sub getStudentName  {
#        my($probSetKey) = @_;
#        my($fname) = &getStudentFirstName($probSetKey);
#        my($lname) = &getStudentLastName($probSetKey);
#        $fname = '' unless defined $fname;
#        $lname = '' unless defined $lname;
#        my($out) = "$fname $lname";
#        $out =~ s/\s\s+/ /g;     # remove any extra spaces
#        $out;
#        }

sub getAllProblemsForProbSetRecord {
    my($probSetKey) = @_;
    my(@keyList) = sort grep ( s/pfn//, keys %probSetRecord );
    @keyList;
     #Since each problem has a problem file name keyed by "pfn$probNum"
     # We select all keys beginning with pfn and delete the pfn part.
     # This method will break if the key names for the data base is changed.

    }

#####################others ######################
#sub getAllProbSetKeysSortedByName {
#
#
#    &attachDBMpin();
#    %MYPROBSET = %PROBSET;
#    &detachDBMpin();
#    my @keyList = grep (/^\d+$/,keys %MYPROBSET); # allow only the psvn numbers to get through
#    @keyList = sort( byLastName @keyList);
#    @keyList;
#}






sub getAllProbSetNumbersHash {
# get the entire hash array from GDBM and close the GDBM file
    &attachDBMpin();
    my %MYPROBSET = %PROBSET;
    &detachDBMpin();

    my(%setNoHash); my($setNo); my %probSetRecord; my @probSetRecord;
    my(@keys) = grep(/^[0-9]+$/,keys %MYPROBSET);
    my $key;
    foreach $key (@keys) {
#   Split the record for each psvn and place it in the hash probSetRecord
        @probSetRecord=split(/[\&=]/, $MYPROBSET{$key});
        push(@probSetRecord, " ") unless @probSetRecord %2 ==0;
        # a blank entry at the end of the string produces an odd number of elements.
        # I hope this hack doesn't mask other errors.
        %probSetRecord=@probSetRecord;
#   Extract the setnumber and build a has whose key is the set number and whose
#   value is a representative psvn (problem set version number)
#   The psvn provides a primary key for referencing other information in the database.
        $setNo = $probSetRecord{'stnm'};
        $setNoHash{$setNo}=$key unless $setNoHash{$setNo};
        }
    %setNoHash;
}
#### this will break if the codes are changed !!!!!!!! ###############

#sub byLastName {
#            $MYPROBSET{$a} =~ /stnm=([^&]*)/;
#            my $sn1 = $1;   #set number sorted first
#            $MYPROBSET{$a} =~ /stln=([^&]*)/;
#            my $ln1 = $1;   # then last name
#            $MYPROBSET{$a} =~ /stfn=([^&]*)/;
#            my $fn1= $1;    # then first name
#
#            $MYPROBSET{$b} =~ /stnm=([^&]*)/;
#            my $sn2 = $1;
#            $MYPROBSET{$b} =~ /stln=([^&]*)/;
#            my $ln2 = $1;
#            $MYPROBSET{$b} =~ /stfn=([^&]*)/;
#            my $fn2= $1;
#            my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
#            $t = $ln1 cmp $ln2  unless $t; # if set numbers 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 bySectionThenByName {
#    $MYPROBSET{$a} =~ /stnm=([^&]*)/;
#    my $sn1 = $1;   #set number sorted first
#    $MYPROBSET{$a} =~ /clsn=([^&]*)/;
#    my $cs1 = $1;   # then by class section
#    $MYPROBSET{$a} =~ /stln=([^&]*)/;
#    my $ln1 = $1;   # then last name
#    $MYPROBSET{$a} =~ /stfn=([^&]*)/;
#    my $fn1= $1;    # then first name
#
#    $MYPROBSET{$b} =~ /stnm=([^&]*)/;
#    my $sn2 = $1;
#    $MYPROBSET{$b} =~ /clsn=([^&]*)/;
#    my $cs2 = $1;   # then by class section
#    $MYPROBSET{$b} =~ /stln=([^&]*)/;
#    my $ln2 = $1;
#    $MYPROBSET{$b} =~ /stfn=([^&]*)/;
#    my $fn2= $1;
#
#    my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
#    $t = $cs1 cmp $cs2  unless $t; # if set numbers are equal 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;
#}
#
#sub byRecitationThenByName {
#    $MYPROBSET{$a} =~ /stnm=([^&]*)/;
#    my $sn1 = $1;   #set number sorted first
#    $MYPROBSET{$a} =~ /clrc=([^&]*)/;
#    my $rc1 = $1;   # then by class recitation
#    $MYPROBSET{$a} =~ /stln=([^&]*)/;
#    my $ln1 = $1;   # then last name
#    $MYPROBSET{$a} =~ /stfn=([^&]*)/;
#    my $fn1= $1;    # then first name
#
#    $MYPROBSET{$b} =~ /stnm=([^&]*)/;
#    my $sn2 = $1;
#    $MYPROBSET{$b} =~ /clrc=([^&]*)/;
#    my $rc2 = $1;   # then by class recitation
#    $MYPROBSET{$b} =~ /stln=([^&]*)/;
#    my $ln2 = $1;
#    $MYPROBSET{$b} =~ /stfn=([^&]*)/;
#    my $fn2= $1;
#
#    my $t = $sn1 cmp $sn2;   #compare set numbers (which might be names)
#    $t = $rc1 cmp $rc2  unless $t; # if set numbers are equal compare class recitation
#    $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;
#}

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


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



#sub getLoginName_StudentID_Hash_from_WW_DB {
#	my @keylist = getAllProbSetKeys();
#	my $key;
#	my %loginName_StudentID_Hash_from_WW_DB =();
#	foreach $key (@keylist) {
#		attachProbSetRecord($key);
#		$loginName_StudentID_Hash_from_WW_DB{getStudentLogin($key)} = getStudentID($key);
#	}
#	\%loginName_StudentID_Hash_from_WW_DB;
#}
1;



