#!/usr/bin/perl
# Copyright 2001-2008 Leslie Richardson
# This file is part of Open Admin for Schools.
# Open Admin for Schools is free software; you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
# scoreadd.pl
# Passed id for the gbtest record that we want to add/edit scores for.
# Flag - does update Comment - comment entry mode.
my $self = 'scoreadd.pl';
my %lex = ('Add/Edit Test Scores' => 'Add/Edit Test Scores',
'Name' => 'Name',
'Score' => 'Score',
'Comment' => 'Comment',
'Save/Update Scores' => 'Save/Update Scores',
'GB Main' => 'GB Main',
'Add Item' => 'Add Item',
'Fill Blanks' => 'Fill Blanks',
'Score Entry' => 'Score Entry',
'Max Score' => 'Max Score',
'Error in Entry Value' => 'Error in Entry Value',
'Test' => 'Test',
'Contact Programmer' => 'Contact Programmer',
'Comment Entry' => 'Comment Entry',
'Save/Update Comments' => 'Save/Update Comments',
'Maximum' => 'Maximum',
'Error' => 'Error',
);
use DBI;
use CGI;
# Set the current date
my @tim = localtime(time);
my $year = @tim[5] + 1900;
my $month = @tim[4] + 1;
my $day = @tim[3];
my $currdate = "$year-$month-$day";
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. " $@ \n";
die $lex{Error}. " $@ \n";
}
my $q = new CGI;
print $q->header;
my %arr = $q->Vars;
# Test passed as id; just id field for test record.
my $comment = $arr{comment};
delete $arr{comment};
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Lookup Test record
my $sth = $dbh->prepare("select * from gbtest where id = ?");
$sth->execute ( $arr{id} );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;; }
my @test = $sth->fetchrow;
my $subjsec = $test[1];
# Now HTML header
print "$doctype\n". $lex{'Add/Edit Test Scores'}. "
\n";
# Set Focus on first entry with javascript.
my $elementnumber;
if ( $comment ) { $elementnumber = 3; } else { $elementnumber = 4;}
print "\n";
print "$chartype\n\n";
print "
\n";
# Update records for changed scores.
if ( $arr{flag} ){ # we are updating records
updateRecs();
}
# Creates array controlling student sort order.
my @studnum = mkStudNum( $subjsec );
if ($comment){
doComment();
} else {
doScore();
}
#------------
sub mkStudNum {
#------------
my $subjsec = shift;
my (@eval, @studnum, %remove);
# Create the studnum array that controls the order that students are
# displayed in. Load the eval records first into an array, sorted by
# lastname and firstname. (@eval) Load the sort order records in order
# into an array and also into a hash (%remove)
# Any remaining array elements in eval are added to the end of
# the studnum array once done. If there _are_ no sortorder recs, then
# the final array becomes the eval records only. This has the desired
# behavior.
# Find the enrollments for this class and read them into @eval array
$sth = $dbh->prepare("select distinct eval.studnum from eval
left outer join studentall on studentall.studnum = eval.studnum
where eval.subjcode = ?
order by studentall.lastname, studentall.firstname");
$sth->execute( $subjsec );
if ($DBI::errstr) { print "$DBI::errstr"; die $DBI::errstr;}
while (my $studnum = $sth->fetchrow){
push @eval,$studnum;
}
# Load 'SortOrder' test if it exists...
$sth = $dbh->prepare("select id from gbtest where
subjsec = ? and name = 'sortorder'");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
my $sortid = $sth->fetchrow;
if ($sortid){ # We have a sortorder
$sth = $dbh->prepare("select studnum from gbscore where
testid = ? order by score");
$sth->execute( $sortid );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
while (my $sn = $sth->fetchrow){
push @studnum, $sn;
$remove{$sn} = 1;
}
# Now add on @eval elements who are not in @studnum
foreach my $en (@eval){
if (not $remove{$en}){ push @studnum, $en;}
}
return @studnum;
} else { # no sortorder
return @eval;
}
}
#-------------
sub updateRecs { # Update scores records
#-------------
delete $arr{flag}; # not needed here..
#foreach my $key (keys %arr) { print "K: $key VAL: $arr{$key} \n"; }
foreach my $key ( keys %arr ) { # Read all passed values...
if ($key eq 'id' or $key eq 'comment'){ next;}
my ( $studnum,$flag,$type ) = split /:/,$key; #Type:(S)core/(C)omment
#print "S:$studnum F:$flag V:$arr{$key} \n";
if ( not defined $flag or not $studnum or not $type ) {
print $lex{'Error in Entry Value'}. " $arr{$key} ". $lex{Test}. ": $arr{id} \n";
print $lex{'Contact Programmer'}. "! \n";
die;
}
# Look for an existing student score record...
my $sth = $dbh->prepare("select count(id) from gbscore
where studnum = ? and testid = ?");
$sth->execute( $studnum, $arr{id} );
my $count = $sth->fetchrow;
if ($count > 1) { # We have more than 1 record for score for this student/test.
print "Duplicate Records found for the testid: $arr{id} \n";
print "for student number: $studnum \n";
die;
}
if ($count == 1){ #if non zero, we have an existing record to update
if ( $type eq 'S' ) {
if ( not $arr{$key} and $arr{$key} ne '0' ) {
$sth = $dbh->prepare("delete from gbscore
where studnum = ? and testid = ?");
$sth->execute( $studnum, $arr{id} );
# print "DELETE! \n";
} else {
$sth = $dbh->prepare("update gbscore set score = ?
where studnum = ? and testid = ?");
$sth->execute( $arr{$key}, $studnum, $arr{id} );
}
} elsif ($type eq 'C') { # type eq C, set comment.
$sth = $dbh->prepare("update gbscore set comment = ?
where studnum = ? and testid = ?");
$sth->execute( $arr{$key}, $studnum, $arr{id} );
} else {
print "Error in Type for $arr{$key} for testid: $arr{id} \n";
die;
}
} elsif ($count == 0) { # count is zero; we must add a new record.
if ( not $arr{$key} and $arr{$key} ne '0') { next; } # skip if empty
if ( $type eq 'S' ) {
$sth = $dbh->prepare("insert into gbscore values (
$sql{default},?,?,?,$sql{default})");
$sth->execute( $studnum, $arr{id}, $arr{$key} );
} elsif ($type eq 'C') { # Add Comment Field.
$sth = $dbh->prepare("insert into gbscore values (
$sql{default},?,?,$sql{default},?)");
$sth->execute( $studnum, $arr{id}, $arr{$key} );
} else {
print "Error in Type for $arr{$key} for testid: $arr{id} \n";
die;
}
} else { # $count not zero or 1... error.
print "Error in Count: $count \n";
die;
}
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
} # End of foreach
} # End of updateRecs
#----------
sub doScore {
#----------
print '
'. $lex{'Score Entry'}. " - $test[2]
$test[3] ";
print $lex{'Max Score'}. ": $test[5]\n";
print "\n";
exit;
} # End of doScore
#----------
sub doComment {
#----------
print '
![](\"/images/hands.gif\")
\n";
}
print "