# Functions:
# calcStudentAverage(studnum, subjsec, decimal)
# prStudentSubject(studnum, subjsec)
#---------------------
sub calcStudentAverage {
#---------------------
use Number::Format qw{round};
# Passed: studnum, subjsec (Student Number, and Subject-section, and
# decimal accuracy of returned student average)
# (Also required for efficiency... $weight{$id}, $groupweight{$grp}, $maxscore{$id}
#my $specchar = '*'; # normally defined in the script environment.
if ( not defined $specchar ){ print "Special Excused Character not defined in gbook.conf!
\n"; }
my ($studnum, $subjsec, $decimal) = @_;
if (not $decimal){ $decimal = 0; }; #default to 0.
my ($totalweight, $totalscore); # running totals.
# Get test info and test score (of that item) at same time.
my $sth = $dbh->prepare("select s.id, s.testid, s.score,
t.grp, t.weight, t.score from gbscore as s, gbtest as t
where s.testid = t.id and t.name != 'sortorder' and
s.studnum = ? and t.subjsec = ? order by t.grp");
$sth->execute( $studnum, $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $currgrp = -1;
my $oldgrp;
my $first = 1;
my %groupscore; # stores results for group weighting.
while (my ($id, $testid, $score, $grp, $weight, $maxscore) = $sth->fetchrow) {
$oldgrp = $currgrp;
$currgrp = $grp;
if ($currgrp ne $oldgrp and not $first) {
# setup group values for the current group
if ($totalweight) {
$groupscore{$oldgrp} = $totalscore / $totalweight;
}
#else { $groupscore{$oldgrp} = '0'; } # BUG!!!
$totalscore = 0;
$totalweight = 0;
}
if ($first) { $first = 0; }
$score =~ s/\s//g; # strip spaces.
# we don't include tests with no score or specchar in average.
if ($score eq $specchar or $score eq '' or not defined $score){ next; }
if ($score =~ /\d/) { # digit, update total score; text... treat as 0.
$totalscore += ($score / $maxscore) * $weight;
$totalweight += $weight;
} else { # if some text... treat as zero and don't update score.
$totalweight += $weight;
}
# print "TS: $totalscore TW:$totalweight GP:$grp
\n";
} # End of Scores Loop
# Get Last group, if any;
if ($totalweight) {
$groupscore{$currgrp} = $totalscore / $totalweight;
}
$totalscore = 0;
$totalweight = 0;
# Load the group weights from the current subject;
$sth = $dbh->prepare("select markscheme from subject where subjsec = ?");
$sth->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $markscheme = $sth->fetchrow;
# build a %groupweight hash from values in markscheme.
my @fields = split (/[\n|\r]/, $markscheme);
my %groupweight;
foreach my $fld (@fields) {
if ($fld) {
# print "F:$fld
\n";
my ($grp, $percent) = split '=', $fld;
$groupweight{$grp} = $percent;
}
}
# Add up the group scores and weight them for overall average
foreach my $grp (keys %groupscore) {
$totalscore += $groupscore{$grp} * $groupweight{$grp};
#print "GS: $groupscore{$grp} GW:$groupweight{$grp}
\n";
$totalweight += $groupweight{$grp};
}
my $fmtstring = '%3.'.$decimal.'f';
# print "Stud: $studnum Total Score: $totalscore Total Weight: $totalweight
\n";
if ( $totalweight ) {
if ( $decimal > 3 or $decimal < 0 ) { $decimal = 1; }
return round( 100 * $totalscore / $totalweight , $decimal );
} else {
return undef; #undefined
}
}
#-------------------
sub prStudentSubject { # print the results of one student in one subject.
#-------------------
my %lex = ('Nil' => 'Nil',
'Assessment Item' => 'Assessment Item',
'Weight' => 'Wt',
'Score' => 'Score',
'ClasAvg' => 'ClasAvg',
'Max Score' => 'Max Score',
'Group' => 'Group',
'Average' => 'Average',
'NA' => 'NA',
'Not Assigned' => 'Not Assigned',
'Error' => 'Error',
'Missing' => 'Missing',
);
use Number::Format qw{round};
eval require "../../etc/gbook.conf";
if ( $@ ) {
print $lex{Error}. " $@
\n";
die $lex{Error}. " $@
\n";
}
# Passed Values
my ($studnum, $subjsec, $groupsonly, $showcomment) = @_;
if (not $groupsonly) { $groupsonly = 0; } # show all items.
if (not $showcomment) { $showcomment = 0; } # turn off comments.
# Possible: $groupmode, $termmode, $startdate, $enddate
if ($groupsonly){ $showcomment = 0;} # shut off comments if on by mistake.
#my $specchar = '*'; # should be moved into global config.
if (not defined $specchar){ print "Special Excused Character not defined in gbook.conf!
\n"; }
# only 3 fields - group, weight, and score
my $grouplineformat = '{|p{38mm}|p{12.7mm}|p{30.5mm}|}\\hline'. "\n";
# 5 fields - item, group, weight, score, classavg.
my $lineformat = '{|p{63.5mm}|p{38mm}|p{12.7mm}|p{30.5mm}|p{15.2mm}|}\\hline'. "\n";
my $commentwidth = '160mm'; # works with line above...
if ($groupsonly) { # switch modes..
$lineformat = $grouplineformat;
}
# Important Variables:
# %grouptotalweight{group} - is a hash of groups storing total
# weight for that group. Needed for the students average for that
# group (group percent).
# %grouptotalscore{group} - the weighted score of the student in
# each group. (score/maxscore * weight). When divided by the
# grouptotalweight for that group, will give the average of the
# student for that group.
# We won't print student name, since this should be handled at
# higher level. Only print subject name and results of tests and
# final average in this subject for this student.
# Note: where a student has an allowed 'miss' in an item, his/her
# groupweights and item weights will be slightly different since the
# total weight will be smaller than others in the class. The
# 'calcStudentAverage' function correctly takes this into account
# when calculating the student's overall average.
# Get subject name, teacher; $dbh handle already open.
my $sth = $dbh->prepare("select s.description, s.teacher, st.lastname, st.firstname
from subject s, staff st where s.teacher = st.userid and subjsec = ?");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my ( $desc, $tch, $lname, $fname ) = $sth->fetchrow;
my $tchname;
if ( $lname ) { $tchname = "$lname, $fname"; }
($desc,$tchname) = &latex_filter($desc,$tchname);
# find the student average (separate function)
my $avg = calcStudentAverage($studnum, $subjsec,1); # 1 decimal accuracy
$avg =~ s/%/\\%/; # escape any percent signs.
# Load the group weights from the current subject;
$sth = $dbh->prepare("select markscheme from subject where subjsec = ?");
$sth->execute($subjsec);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $markscheme = $sth->fetchrow;
#print "The markscheme is: $markscheme
\n";
# build a %groupweight hash from values in markscheme.
my @fields = split (/[\n|\r]/, $markscheme);
my %groupweight;
foreach my $fld (@fields) {
if ($fld) {
#print "F:$fld
\n";
my ($grp, $percent) = split(/=/, $fld);
$groupweight{$grp} = $percent;
}
}
# load groups and put in any missing ones from existing groups into %groupweight
$sth = $dbh->prepare("select distinct grp from gbtest where subjsec = ? and grp != ''");
$sth->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while (my $grp = $sth->fetchrow) {
if (not $groupweight{$grp}) { $groupweight{$grp} = $lex{NA}; }
}
## build a hash to map a weight number -> multiplier value (ie. 500 -> 5, 750 -> 6)
#foreach my $key (keys %wtmult) { # %wtmult from gbook.conf file
# my $value = round ( $wtmult{$key} * $defaultItemWeight ), 0;
# $weighttomult{$value} = $key;
# }
#foreach my $key (keys %weighttomult) { print "K:$key V:$weighttomult{$key}
\n"; }
my ($totalweight, %grouptotalweight, $totalscore, %grouptotalscore);
# Setup for getting score to classify weights...
my $sth1 = $dbh->prepare("select score from gbscore
where testid = ? and studnum = ?");
# Find total weights and grouptotalweights first.
$sth = $dbh->prepare("select id, weight, grp from gbtest
where subjsec = ? and name != 'sortorder'");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($id,$wt,$grp) = $sth->fetchrow ) {
$sth1->execute( $id, $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $score = $sth1->fetchrow;
# skip updating weights if score is one of following types...
if ($score eq $specchar or $score eq '' or not defined $score){ next; }
#$totalweight += $wt;
$grouptotalweight{$grp} += $wt;
}
if (not %grouptotalweight){ # empty hash = no marks
print TEX "\n\\medskip\n\n";
print TEX "{\\large\\bf $desc $subjsec ($tchname)}\\qquad";
print TEX "{\\large\\bf $lex{Average} $lex{NA}}\n\n";
return undef;
}
# print the top of the form: subject, teacher, and average.
print TEX "\n\\medskip\n";
print TEX "{\\large\\bf $desc $subjsec ($tchname)}\\qquad";
print TEX "{\\large\\bf $lex{Average} $avg}\n\n";
# Get the test information.
$sth = $dbh->prepare("select name, description, id, score, weight, grp
from gbtest where subjsec = ? and
name != 'sortorder' order by grp,tdate");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
# Print Table Headings
print TEX "\\begin{tabular}";
print TEX $lineformat, "\n";
if (not $groupsonly) {
print TEX "\\rowcolor[gray]{0.93}$lex{'Assessment Item'}&";
print TEX "$lex{Group} & $lex{Weight}";
print TEX "&$lex{Score}&$lex{ClasAvg} \\\\ \\hline\n\n";
} else {
print TEX "\\rowcolor[gray]{0.93}";
print TEX "$lex{Group} & $lex{Weight}";
print TEX "&$lex{Score}\\\\ \\hline\n\n";
}
# Loop through all tests/items
my $loopcount = 0;
if ($groupsonly){ $loopcount = 1;}
my $currgroup = -1;
my $oldgroup;
# loop through all tests...
while ( my ( $name, $desc, $id, $maxscore, $weight, $group ) = $sth->fetchrow ) {
if ( not $maxscore ) {
print "$lex{Error}: $lex{'Max Score'} $lex{Missing} $name\n";
die "$lex{Error}: $lex{'Max Score'} $lex{Missing} $name\n";
}
if (not $weight){ next; }; # skip 0 weighted items.
($name,$desc) = &latex_filter($name,$desc);
# update group
$oldgroup = $currgroup;
$currgroup = $group;
#print "CG: $currgroup OG:$oldgroup GRP:$group
\n";
# if group change and showgroup print group line.
if ( $oldgroup ne $currgroup and $oldgroup != -1 ) {
# there is a group change.
my $groupaverage;
if ( $grouptotalweight{$oldgroup} ) {
$groupaverage = round( $grouptotalscore{$oldgroup} / $grouptotalweight{$oldgroup} * 100, 1 );
} else {
$groupaverage = '0.00';
}
# only the copy is latex filtered.
my $pr_oldgroup = $oldgroup;
($pr_oldgroup) = latex_filter($pr_oldgroup);
# print "OG: $oldgroup PROG: $pr_oldgroup
\n";
if ($groupsonly) {
print TEX "\\bf $pr_oldgroup& ";
print TEX "$groupweight{$oldgroup}\\% & $groupaverage\\%";
print TEX " \\\\ \\hline\n\n";
} else { # full info
print TEX "\\rowcolor[gray]{0.96}";
print TEX "{$lex{'Group'} \\bf $pr_oldgroup}& ";
print TEX "& ";
print TEX "$groupweight{$oldgroup}\\% & $groupaverage\\%";
print TEX "& \\\\";
print TEX "\\hline\\hline\n\n";
}
$loopcount++;
} # End of Group Line
if ( not $groupsonly ) {
$loopcount++;
my $pr_group = $group;
($pr_group) = &latex_filter($pr_group); # not done, matching issues
print TEX "{\\bf $name} $desc &$pr_group &";
}
if (not $clasavg{$id}){ # Find average for this item if not already done.
my $sth1 = $dbh->prepare("select id, score from gbscore where testid = ?");
$sth1->execute( $id );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
my $scorecount;
my $scoretotal;
while (my ($dudid, $score) = $sth1->fetchrow){
# We don't have to worry about missing records here, only records that have a value
if ($score ne $specchar and $score){ # Note: text in score will count as 0.
$scorecount++;
$scoretotal += $score;
}
}
if ( $scoretotal and $maxscore ) { # we have values
$clasavg{$id} = round( ( $scoretotal / $scorecount ) / $maxscore * 100 , 1 );
} else {
$clasavg{$id} = $lex{'Nil'};
}
#print "Ttl:$scoretotal Count:$scorecount Max:$maxscore
\n";
}
# Get this student's score
$sth1 = $dbh->prepare("select score, comment from gbscore
where testid = ? and studnum = ?");
$sth1->execute( $id, $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
($score, $comment) = $sth1->fetchrow;
($score,$comment) = latex_filter($score, $comment);
my $testaverage; # initialize
#skip calcs for specialchar/blank
if ($score eq $specchar or $score eq '' or not defined $score){
# Print a blank record with NA stuff...
if (not $groupsonly){
print TEX "$lex{NA} & $score ",$lex{NA},'&';
print TEX $lex{NA}," \\\\ \\hline\n\n";
}
} else {
$totalscore += ($weight * $score / $maxscore);
$grouptotalscore{$group} += ($weight * $score / $maxscore);
# Note: maxscore being 0 already trapped above.
$testaverage = round $score / $maxscore * 100 , 1;
my $weightmultiplier;
if ( $defaultItemWeight > 0 ) {
$weightmultiplier = round( $weight / $defaultItemWeight , 2);
} else {
$weightmultiplier = $weight. 'pt';
}
if ( not $groupsonly ){
print TEX "$weightmultiplier". 'x'. " & ($score/$maxscore) $testaverage\\%";
print TEX "& $clasavg{$id}\\% \\\\ \\hline\n\n";
}
}
if ($comment and $showcomment){ # comment exists and showcomment is 1
if (not $groupsonly){
print TEX "\\multicolumn{5}{|p{$commentwidth}|}{\\it $comment}";
print TEX "\\\\ \\hline\n\n";
$loopcount++;
}
}
if ($loopcount % 4 == 0){ # repeat every 4 rows to allow page breaks.
#print "LC:(breaker) $loopcount
\n";
if ($groupsonly){ $loopcount = 1;}
print TEX "\\end{tabular}\n\n";
print TEX '\\begin{tabular}',$lineformat, "\n";
}
} # End of item loop
# Print Last Group Totals
if ($grouptotalweight{$currgroup}){
$groupaverage = round ( $grouptotalscore{$currgroup} / $grouptotalweight{$currgroup} * 100 ), 1
} else { $groupaverage = '0.00';}
my $pr_currgroup = $currgroup;
($pr_currgroup) = &latex_filter($pr_currgroup);
if ( $groupsonly ) {
print TEX "\\bf $pr_currgroup& ";
print TEX "$groupweight{$currgroup}\\% & $groupaverage\\%";
print TEX " \\\\ \\hline\n\n";
} else { # full info
print TEX "\\rowcolor[gray]{0.96}";
print TEX "{$lex{'Group'} \\bf $pr_currgroup}& ";
print TEX "& ";
print TEX "$groupweight{$currgroup}\\% & $groupaverage\\%";
print TEX "& \\\\";
print TEX "\\hline\n\n";
}
print TEX "\\end{tabular}\n\n";
} # End of prStudentSubject
#---------------
sub latex_filter { # Escape those funny LaTeX Characters.
#---------------
foreach $value (@_){
$value =~ s/\000//g; # remove nulls.
#$value =~ s/\$/\Q\\$\E/g;
$value =~ s/([^\\])*\$/$1\\\$/g;
$value =~ s/([^\\])*#/$1\\#/g;
$value =~ s/([^\\])*%/$1\\%/g;
# Match any &, not having a leading backslash to escape it.
$value =~ s/([^\\])&/$1\\&/g;
#$value =~ s/\\/\\\\/g; # Doubles backslashes above.
$value =~ s/\{/\\\{/g;
$value =~ s/\}/\\\}/g;
#$value =~ s/\^/\\^/g;
$value =~ s/_/\-/g;
$value =~ s/~/\\~/g;
}
return @_;
}
1; # End of Library.