#!/usr/bin/perl
# Copyright 2001-2007 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'
);
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";
require "../../etc/admin.conf" or die "Cannot open admin.conf!";
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.
@studnum = mkStudNum($subjsec);
if ($comment){
doComment();
die;
} else {
doScore();
die;
}
#------------
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 = '$subjsec'
order by studentall.lastname, studentall.firstname");
$sth->execute;
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 = '$subjsec' and name = 'sortorder'");
$sth->execute;
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 = '$sortid' order by score");
$sth->execute;
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;}
$arr{$key} =~ s/'/''/g;
$arr{$key} =~ s/\\/\\\\/g;
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 = '$studnum' and testid = '$arr{id}'");
$sth->execute;
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;
}
# $flag no longer used....but check anyway
if ($flag != $count) { print "Update problem. Record numbers don't match. \n"; }
if ($count == 1){ #if non zero, we have an existing record to update
if ($type eq 'S'){
if ( $arr{$key} eq '') {
$sth = $dbh->prepare("delete from gbscore
where studnum = '$studnum' and testid = '$arr{id}'");
# print "DELETE! \n";
} else {
$sth = $dbh->prepare("update gbscore set score = '$arr{$key}'
where studnum = '$studnum' and testid = '$arr{id}'");
}
} elsif ($type eq 'C') { # type eq C, set comment.
$sth = $dbh->prepare("update gbscore set comment = '$arr{$key}'
where studnum = '$studnum' and testid = '$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 ($arr{$key} eq "") { next; } # skip if empty string...
if ($type eq 'S'){
$sth = $dbh->prepare("insert into gbscore values (
$sql{default},'$studnum','$arr{id}','$arr{$key}',NULL)");
} elsif ($type eq 'C') { # Add Comment Field.
$sth = $dbh->prepare("insert into gbscore values (
$sql{default},'$studnum','$arr{id}',NULL,'$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;
}
$sth->execute;
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] ". $lex{'Max Score'}. ": $test[5]\n";
print "\n";
} # End of doScore
#----------
sub doComment {
#----------
print '
![](\"/images/hands.gif\")
\n";
}
print "