#!/usr/bin/perl
#  Copyright 2001-2009 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.

# Passed Values: Subject/Section value (passed as subjsec). 

my $specchar = '*';  # causes this test to be skipped in calculating avg.
my $altcolor = '#3B7'; #1B6 Complement to the 063 green of teacher site.

my %lex = ('Nil' => 'Nil',
	   'marks were posted to the report card system' => 
	     'marks were posted to the report card system',
	   'Post to Report Card System' => 'Post to Report Card System',
	   'GB Main' => 'GB Main',
	   'Main' => 'Main',
	   'There was an error storing your data' => 'There was an error storing your data',
	   'Please contact' => 'Please contact',
	   'System Disabled. Please contact secretary' => 
	     'System Disabled. Please contact secretary',
	   'No Tests Found!' => 'No Tests Found!',
	   'Mark' => 'Mark',
	   'Objective:# to Post' => 'Objective:# to Post',
	   'Override Existing Marks?' => 'Override Existing Marks?',
	   'Name' => 'Name',
	   'Prev<br>Post' => 'Prev<br>Post',
	   'GBook<br>Average' => 'GBook<br>Average',
	   'Userid' => 'Userid',
	   'Password' => 'Password',
	   'Enter Gradebook' => 'Enter Gradebook',
	   'Term' => 'Term',
	   'Previous Value exists and not overridden. Skipping' => 
	     'Previous Value exists and not overridden. Skipping',
	   'updated' => 'updated',
	   'Error' => 'Error',
	   'Please Log in!' => 'Please Log in!',
	   'Class Average' => 'Class Average',
	   'Student' => 'Student',
	   'Convert to Letter Grade' => 'Convert to Letter Grade',
	   'Convert Marks' => 'Convert Marks',
	   'Decimal Display' => 'Decimal Display',

	   );


$markToLetter{1} = { '89.5' => 'E', '74.5' => 'M', '59.5' => 'B', '0' => 'N' };
#$markToLetter{2} = { '92.5' => 'A', '82.5' => 'B','72.5' => 'C', '62.5' => 'D',
# '59.9' => 'D-','0' => 'F'};

my @schemes;
foreach my $idx ( sort keys %markToLetter ) {
    my $scheme;
    foreach my $key ( sort reverse keys %{ $markToLetter{$idx} } ) {
	$scheme = $scheme. " $key < $markToLetter{$idx}{$key} < ";
    }
    chop $scheme; chop $scheme;
    $scheme .= "($idx)";
    push @schemes, $scheme;
}


my $self = 'post.pl';

use DBI;
use CGI;
use CGI::Session;
use Date::Business;
use Number::Format qw(:all);

my $q = new CGI;

eval require "../../etc/admin.conf";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@<br>\n";
}

# get the markfield value... a1-a20 which stores numeric mark.
eval require "../../etc/repcard.conf";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@<br>\n";
}

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!'}. "<br>\n";
    die;
}

my $subjsec = $session->param('subjsec');
print $q->header( -charset, $charset );
my %arr = $q->Vars;

if ( not defined $arr{decimaldisplay} ) {
    $arr{decimaldisplay} = '0';
}

my $markToLetter;  # mode switch
my %mark2Letter;
if ( $arr{convertscheme} ) { # passed value from markToLetter table.
    my ( $dud, $id ) = split /\(/, $arr{convertscheme};
    chop $id;
    $markToLetter = 1;
    %mark2Letter = %{ $markToLetter{$id} }; # holds the values
}

my ($sec, $min, $hour, $mday, $mon, $year, $wday, 
 $yday, $iddst) = localtime(time);
$year = $year + 1900;
$mon++;
$wday++;
if (length($mon) ==1){ $mon = '0'.$mon;}
if (length($mday) ==1){ $mday = '0'.$mday;}
my $currdate = "$dow[$wday], $month[$mon] $mday, $year";
my $currsdate = "$year$mon$mday";
my $dateobj = new Date::Business(DATE => $currsdate);


# Read in the term and check for disabled function. Fail if zero.
my $termread = "Error!";
open(TERM, "../../etc/term") || die "Can't find the term number!";
$termread = <TERM>;
if ( $termread == 0 ) {
    print "<br>". $lex{'System Disabled. Please contact secretary'}. ".\n";
    print "</body></html>\n";
    die;
}

#### DISABLED:  Otherwise calculate term from times...
####  my $term = calcTerm();


# Print Head of Page
print "$doctype\n<html><head><title>". $lex{'Post to Report Card System'};
print "</title>\n<link rel=\"stylesheet\" href=\"$tchcss\" type=\"text/css\">
$chartype\n</head><body>\n";

print "[ <a href=\"$tchpage\">". $lex{Main};
print "</a> |\n <a href=\"gbmain.pl\">". $lex{'GB&nbsp;Main'};
print "</a> ]\n";

print "<form action=\"$self\" method=\"post\" style=\"display:inline;\">\n";

# Comment out, unless you want to lock into letter entry once chosen.
#if ( $arr{convertscheme} ) {
#    print "<input type=\"hidden\" name=\"convertscheme\" value=\"$arr{convertscheme}\">\n";
#}

print "<input type=\"submit\" value=\"". $lex{'Decimal Display'}. "\">\n";
print "<select name=\"decimaldisplay\">";
if ( $arr{decimaldisplay} ) { print "<option>$arr{decimaldisplay}</option>\n"; }
for my $val ( 0 .. 4 ) { print "<option>$val</option>"; }
print "\n</select></form>\n";


if ( $arr{postflag} ) {
    delete $arr{postflag};
    postMarks();
} else {
    showStartPage( $subjsec );  # $subjsec comes from session.
}


#----------------
sub showStartPage {
#----------------

    my $subjsec = shift;

    # Get the Subject Information (objectives)
    $sth = $dbh->prepare("select * from subject where subjsec = ?");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    my $subjref = $sth->fetchrow_hashref;

    my $startterm = $subjref->{'startrptperiod'};
    my $endterm = $subjref->{'endrptperiod'};
    my @objective = ();
    for my $i (1 .. 20){ # index of objectives in subject table
	$key = 'a'. $i;
	if ( $subjref->{$key} ){ # if objective exists, push it into array
	    $subjref->{$key} =~ s/://g; # strip any colons in objective
	    push @objective, $subjref->{$key}. ":$i";
	}
    }
    if ( not @objective ){ # no objectives entered; put in a single one
	$objective[0] = $lex{Mark}. ":1";
    }

    # Creates array controlling student sort order.
    my @studnum = mkStudNum( $subjsec );


    # Now lookup tests for this class.
    $sth = $dbh->prepare("select name, id, score, weight from gbtest 
      where subjsec = ? and name != 'sortorder' order by tdate");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
    while ( my ( $name,$id,$score,$weight ) = $sth->fetchrow ) {
	#$name =~ s/://g; # strip colons from name... just in case.
	#push @test, "$name:$id:$score";
	$weight{$id} = $weight; # used for calculating averages.
	$maxscore{$id} = $score;
    }
    # Now done putting in the tests.


    # Load the markscheme field to get groupweight hash.
    $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;

    my %groupweight;
    my @fields = split (/[\n|\r]/, $markscheme);
    foreach my $fld ( @fields ) { 
	if ( $fld ) {
	    my ($grp, $percent) = split /=/, $fld;
	    $groupweight{$grp} = $percent;
	}
    }


    # Print top of page heading
    print "<center><h1>". $subjref->{'description'};
    print " (". $subjref->{'subjsec'}. ")</h1>\n";


    # Start form.
    print "<form action=\"$self\" method=\"post\">\n";
    print "<input type=\"hidden\" name=\"subjsec\" value=\"$subjsec\">\n";
    print "<input type=\"hidden\" name=\"postflag\" value=\"1\">\n";

    # Print the table header
    print "<table cellpadding=\"3\" cellspacing=\"0\" border=\"1\">\n";

    print "<tr style=\"background-color: #CCC;color:red\">\n";
    print "<td align=\"right\" colspan=\"2\"><b>". $lex{Term}. "</b></td>\n";
    print "<td><select name=\"term\"><option>$termread</option>\n";
    for my $trm ( $startterm .. $endterm ){ 
	print "<option>$trm</option>";
    }
    print "</select></td></tr>\n";


    # Print Objectives to post into.
    print "<tr style=\"background-color:#EEE;\"><td align=\"right\"  colspan=\"2\">";
    print  $lex{'Objective:# to Post'}. "</td><td><select name=\"objective\">\n";
    foreach my $o ( @objective ) {
	print "<option>$o</option>";
    }
    print "</select></td></tr>\n";

    # Print Override Marks Line
    print "<tr style=\"background-color: #CCC;\">\n";
    print "<td align=\"right\" colspan=\"2|\">". $lex{'Override Existing Marks?'}. "</td>\n<td>";
    print "<input type=\"checkbox\" name=\"markoverride\" value=\"1\">";
    print "</td></tr>\n";

    print '<tr><th>'. $lex{Name}. '</th><th>'. $lex{'Prev<br>Post'}. '</th><th>';
    print $lex{'GBook<br>Average'}. "</th></tr>\n";

    my $sth = $dbh->prepare("select lastname, firstname from studentall
      where studnum = ?");

    # Print the students and their marks;
    foreach my $studnum ( @studnum ) {

	$sth->execute( $studnum );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	my ($lastname,$firstname) = $sth->fetchrow;

	print "<tr><td>$lastname, $firstname</td>\n";

	# Get current mark, if any for this term, subject, student.
	# $markfield defined in repcard.conf - the field a1 to a20 with numeric mark
	my $sth = $dbh->prepare("select $markfield from eval 
         where term = ? and studnum = ? and subjcode = ?");
	$sth->execute( $termread, $studnum, $subjsec );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
	my $mark = $sth->fetchrow;

	# print "Mark: $mark  Trm: $termread Studnum: $studnum Subject: $subjsec<br>\n";

	if ( not $mark ) { $mark = $lex{Nil}; }
	print "<td align=\"center\">$mark</td>";

	my $studentavg = calcAverage($studnum, $subjsec, \%maxscore, \%weight, \%groupweight);

	push @studentavg, $studentavg; # used to calc class average below.

	
	if ( $markToLetter ) { # mode shift to Letter Grade conversion.
	    my $letter;
	    foreach my $threshold ( reverse sort keys %mark2Letter ) { # from large to small...
		#print "TH: $threshold  SN:$studentavg<br>\n";
		if ( $studentavg >= $threshold ) {
		    $letter = $mark2Letter{$threshold};
		    last;
		}
	    }
	    print "<td><input type=\"text\" name=\"$studnum\" ";
	    print "size=\"4\" value=\"$letter\"> $studentavg</td></tr>\n";

	} else {
	    $studentavg = round($studentavg, $arr{decimaldisplay} );
	    print "<td><input type=\"text\" name=\"$studnum\" ";
	    print "size=\"4\" value=\"$studentavg\"></td></tr>\n";
	}
    

    } # End of student loop.

    # Calc and print overall student average in this subject.
    # Note: This class average calculation method differs slightly from
    #  the main gradebook method, since it doesn't use all of the weighted
    #  values from all items, rather just using the average of all student
    #  averages that don't have a totalweight of 0 (ie all excused).

    print "<tr style=\"background-color: #CCC;\"><td colspan=\"2\" align=\"center\">";
    print $lex{'Class Average'}. "</td>\n";
    my ($avgcount, $avgtotal);
    foreach my $avg (@studentavg){
	$avgcount++;
	$avgtotal += $avg;
    }
    if ( not $avgcount ){ print "<br>". $lex{'No Tests Found!'}. "<br>\n"; die;}
    my $avgstudenttotal = $avgtotal / $avgcount;

    $avgstudenttotal = round($avgstudenttotal, $arr{decimaldisplay} );

    print "<td>$avgstudenttotal%</td></tr>\n";
    print "<tr style=\"background-color:#AAA;\"><td colspan=\"3\" align=\"center\">\n";
    print "<input type=\"submit\" value=\"". $lex{'Post to Report Card System'}. "\">\n";
    print "</td></tr></form>\n";

    print "</table><p></p>\n";


    # Now print the mark To Letter table, if desired.
    if ( %markToLetter ) {

	print "<table cellpadding=\"3\" cellspacing=\"0\" border=\"1\">\n";
	print "<tr><th>". $lex{'Convert to Letter Grade'}. "</th></tr>\n";
    
	print "<form action=\"$self\" method=\"post\">\n";
	if ( $arr{decimaldisplay} ) {
	    print "<input type=\"hidden\" name=\"decimaldisplay\" value=\"$arr{decimaldisplay}\">\n";
	}

	print "<tr><td><select name=\"convertscheme\">\n";
	foreach my $scheme ( @schemes ) {
	    print "<option>$scheme</option>";
	}
	print "</select></td></tr>\n";

	print "<tr style=\"background-color:#AAA;text-align:center;\"><td>\n";
	print "<input type=\"submit\" value=\"". $lex{'Convert Marks'}. "\"></td></tr>\n";

	print "</form></table>\n";
    }

    print "</center></body></html>\n";


} # end of showStartPage




#--------
sub login { # print error, login screen and die;
#--------

    my $error = shift;
    print "$doctype\n<html><head><title>$error</title>
    <link rel=\"stylesheet\" href=\"$tchcss\" type=\"text/css\">
    $chartype\n </head><body><center><h1>$error</h1>
    <p><form action=\"post.pl\" method=\"post\">
    <input type=\"hidden\" name=\"subjsec\" value=\"$arr{subjsec}\">".
    $lex{Userid}. ": <input type=\"text\" name=\"userid\" size=\"8\">".
    $lex{Password}. ": <input type=\"password\" name=\"password\" size=\"8\"><br>
    <input type=\"submit\" value=\"". $lex{'Enter Gradebook'}. "\"></form></p>

    [ <b><a href=\"$tchpage\">". $lex{Main}. "</a></b> ]</center></body></html>";
    die;

}


# NOT USED ANY MORE....
#-----------
sub calcTerm { # Figure out what term it is and return it.
#-----------
    # Figure out the current term, if not passed term
    # Requires Date::Business
    my $maxterm = 12;
    my $term = 0;
    for (1..$maxterm){ # worst case scenario.. what's reasonable?
	if (not $g_termstart{$_}){ next;}
	my $startdate = $g_termstart{$_}; $startdate =~ s/-//g;
	my $startobj = new Date::Business(DATE => $startdate);
	my $enddate = $g_termend{$_}; $enddate =~ s/-//g;
	my $endobj = new Date::Business(DATE => $enddate);
	$startoffset = $dateobj->diffb($startobj,'prev','next');
	$endoffset = $dateobj->diffb($endobj,'prev','next');
	#print "StartOffset: $startoffset  Endoffset: $endoffset<br>\n";
	
	if ($startoffset >= 0 and $endoffset <= 0){
	    $term = $_; last;
	}
    } 

    return $term;

} # End of CalcTerm



#------------
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 postMarks {
#------------

    #foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }

    # Really needs to have checking added to check for an existing
    # record (mark) and then ignore updates if a mark already
    # exists. It should also say if it has done this for a particular
    # student.

    my $subjsec = $arr{subjsec};
    delete $arr{subjsec};

    my $term = $arr{term};
    delete $arr{term};

    my $markoverride = $arr{markoverride};
    delete $arr{markoverride};

    my $dsn = "DBI:$dbtype:dbname=$dbase";
    my $dbh = DBI->connect($dsn,$user,$password);
    $dbh->{mysql_enable_utf8} = 1;

    # Read in the term to check for failure
    my $termread = "Error!";
    if ( not open(TERM, "../../etc/term")) { 
	print "Can't find the term number!<br> "; 
	die "Can't find the term number!";
    }
    $termread = <TERM>;

    if ( $termread == 0 ) {
	print "<br>". $lex{'System Disabled. Please contact secretary'}. ".\n";
	print "</body></html>\n";
	die;
    }

    # Set which objective to post into.
    my ($objective,$idx) = split /:/,$arr{objective};
    $idx = 'a'.$idx; # make a1, a2, etc.
    delete $arr{objective};

    print "<p style=\"padding-left:2em;\">\n";

    my $postedCount = 0; # track how many marks were posted.

    foreach my $key ( keys %arr ) {

	$sth = $dbh->prepare("select $idx from eval where term = ? and subjcode = ? and studnum = ?");
	$sth->execute( $term, $subjsec, $key );
	if ($DBI::errstr) { 
	    print $lex{Student}. " $studnum ". $lex{Error}. ": $DBI::errstr"; 
	    die $lex{Student}. " $studnum ". $lex{Error}. ": $DBI::errstr"; 
	}
	my $prevalue = $sth->fetchrow;

	if ( $prevalue and not $markoverride ){ # skip updating
	    # We have a mark/value already submitted and not overridden

	    # Get Name.
	    $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
	    $sth1->execute( $key );
	    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	    my ($lastname, $firstname) = $sth1->fetchrow;
	
	    print $lex{'Previous Value exists and not overridden. Skipping'}. " $lastname, $firstname";
	    print "($key) ";
	    print $lex{Mark}. ": $arr{$key} ". $lex{Term}. ": $term<br>\n";

	} else { # update mark

	    # Get Name
	    $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
	    $sth1->execute( $key );
	    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
	    my ($lastname, $firstname) = $sth1->fetchrow;

	    print "<b>$lastname, $firstname ($key) ". $lex{updated}. ".</b>\n";
	    print $lex{Mark}. ": $arr{$key} ". $lex{Term}. ": $term<br>\n";

	    $postedCount++; # increment counter.
	    $sth = $dbh->prepare("update eval set $idx = ? where term = ? and subjcode = ? and studnum = ?");
	    #print "T: $term IDX: $idx V: $arr{$key} SN: $key<br>\n";
	    $sth->execute( $arr{$key}, $term, $subjsec, $key);
	    if ( $DBI::errstr ) {
		print $lex{Student}. " $studnum ". $lex{Error}. ": $DBI::errstr"; 
		die $lex{Student}. " $studnum ". $lex{Error}. ": $DBI::errstr";
	    }

	}
    }
    # End of Mark Update Loop

    if ( not $DBI::errstr ) {
	print "</p><h3 style=\"padding-left:2em;\">$postedCount ";
	print $lex{'marks were posted to the report card system'}. ".</h3>\n";
    } else {
	print '<h3>'. $lex{'There was an error storing your data'}. ".\n";
	print $lex{'Please contact'}. " $adminname [ <a href=\"mailto:$adminemail\">$adminemail</a> ]\n";
	print "$DBI::errstr</h3></p>";
    }
    
    print "</body></html>\n";

    exit;

} # end of postMarks



#--------------
sub calcAverage {
#--------------

    require strict;
    # needed: $maxscore{$id}, $weight{$id}, $groupweight{$grp}

    my ($studnum, $subjsec, $maxscore_ref, $weight_ref, $groupweight_ref ) = @_;

    my %maxscore = %$maxscore_ref;
    my %weight = %$weight_ref;
    my %groupweight = %$groupweight_ref;

    my $totalweight;
    my $totalscore;

    my $sth = $dbh->prepare("select gbscore.id, gbscore.testid, gbscore.score, gbtest.grp 
      from gbscore, gbtest 
      where gbscore.testid = gbtest.id and gbtest.name != 'sortorder' and  
      gbscore.studnum = ? and gbtest.subjsec = ?
      order by gbtest.grp");
    $sth->execute( $studnum, $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }

    my $currgrp = -1;
    my $oldgrp;
    my $first = 1;
    my $totalscore; # running total for score; zeroed for each new group.
    my $totalweight; # running total for weight; zeroed for each new group.
    my %groupscore;

    while ( my ( $id, $testid, $score, $grp ) = $sth->fetchrow ) {
	$score =~ s/\s//g; # strip any spaces in score;
	if ( $score eq $specchar or $score eq '' or not defined $score ) { next; } # skip

	$oldgrp = $currgrp;
	$currgrp = $grp;
	if ( $currgrp ne $oldgrp and not $first) {
	    # setup group values for the current group
	    if ($totalweight) {
		$groupscore{$oldgrp} = $totalscore / $totalweight;
	    } # What to do if totalweight == 0?

	    $totalscore = 0;
	    $totalweight = 0;
	}
	if ( $first ) { $first = 0; }

	if ( $score =~ /\d/ ) { # if score is a digit... do it.
	    $totalscore += $score / $maxscore{$testid} * $weight{$testid};
	    $totalweight += $weight{$testid};
	} else {
	    # some sort of text score...count as zero... update total weight.
	    $totalweight += $weight{$testid};
	}	    

	#print "TS: $totalscore TW:$totalweight GP:$grp<br>\n";

    } # End of Scores Loop


    # Get Last group, if any;
    if ( $totalweight ) { 
	$groupscore{$currgrp} = $totalscore / $totalweight;
    }
    $totalscore = 0;
    $totalweight = 0;

    #foreach my $key (keys %groupscore) { print "K: $key GS: $groupscore{$key}<br>\n"; }

    # 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}<br>\n";
	$totalweight += $groupweight{$grp};
    }

    #print "TS:$totalscore TW:$totalweight<br><br>\n";
    if ( $totalweight ) { 
	return round( 100 * $totalscore / $totalweight, $arr{decimaldisplay} ). '%';
    } else {
	return 0;
    }

} # End of CalcAverage