#!/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 "
size of probSetRecord = ",scalar(@probSetRecord),"
";
# print "
hash list=
|$PROBSET{$probSetKey}|
";
# #print "probSetRecord", join("|
|\n",@probSetRecord), "
";
# }
%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