#!/usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# multiedit.pl - add/edit multiple item scores.
my %lex = ('Multiple Item Score Entry' => 'Multiple Item Score Entry',
'GB Main' => 'GB Main',
'Main' => 'Main',
'Max Score' => 'Max Score',
'Save / Update Scores' => 'Save / Update Scores',
'Assessment Item' => 'Assessment Item',
'Item Date' => 'Item Date',
'Continue' => 'Continue',
'Error' => 'Error',
'Multiple Test Score Entry' => 'Multiple Test Score Entry',
'Test' => 'Test',
'Select' => 'Select',
'Items with no test scores are automatically checked.' =>
'Items with no test scores are automatically checked.',
'Please Log In' => 'Please Log In',
'Student' => 'Student',
'Record(s) Updated' => 'Record(s) Updated',
);
use DBI;
use CGI;
use CGI::Session;
# 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;
my ($view,$subview) = split /:/,$arr{vw};
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;
# Get Session Information...
my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw",
undef,{Handle => $dbh}) or die CGI::Session->errstr;
my $logged_in = $session->param(logged_in);
if (not $logged_in){
print $q->header( -charset, $charset );
print $lex{'Please Log In'}. " \n";
exit;
}
my $subjsec = $session->param('subjsec');
print $q->header( -charset, $charset );
my %arr = $q->Vars;
# Now setup page header
my $title = qq{$lex{'Multiple Item Score Entry'}};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} |\n};
print qq{$lex{'GB Main'} ]\n};
print qq{
$title
\n};
# Update records for changed scores.
if ( $arr{flag} == 3 ){
updateRecs();
print qq{
};
print qq{$lex{'Record(s) Updated'}
\n};
}
# Select subjects if not already done in last loop.
if ( not $arr{flag} ){ # no flag, then print entry screen.
prEntryPage($subjsec);
exit;
}
# Lookup Test records; Only subjsec=subjsec, id = 1, flag=2
foreach $key (keys %arr){
if ($arr{$key} == 1){ # loop through the tests: $key is id of test.
$sth = $dbh->prepare("select tdate,name,score from gbtest where id = ?");
$sth->execute( $key );
if ($DBI::errstr){ print $DBI::errstr; die; }
my ($tdate,$name,$score) = $sth->fetchrow;
$name =~ s/://g; # strip colons
$test{"$tdate:$key"} = "$name:$score"; # use this to sort hash
}
}
# Creates array controlling student sort order.
my @studnum = mkStudNum($arr{subjsec});
print qq{\n};
#------------
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 e.studnum from eval e
left outer join studentall s on s.studnum = e.studnum
where e.subjcode = ? order by s.lastname, s.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 prEntryPage { # Entry Values for Test Selection
#--------------
my $subjsec = shift; # Get passed subjsec
$sth = $dbh->prepare("select description from subject where subjsec = ?");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
$subject = $sth->fetchrow;
if ( $view ne 'All' and defined $view){ # a select group is being viewed.
$grpselect = "and grp = '$view'";
}
# Get Tests for this subject
$sth = $dbh->prepare("select id, name, description from gbtest
where subjsec = ? and name != 'sortorder' $grpselect
order by tdate");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
print qq{