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

# $singleTermOnly is now in configuration system as $r_SingleTermOnly
# Set to 1, if teachers can only post to current term, not others. 
# my $singleTermOnly = '0';  # zero or 1


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',
	   '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',
	   'Grade' => 'Grade',
	   'Missing' => 'Missing',
	   'Cannot open file' => 'Cannot open file',
	   'Track' => 'Track',
	   'Not Found' => 'Not Found',

	   );


$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 Number::Format qw(:all);

my $q = new CGI;

eval require "../../etc/admin.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);



# Load the 2 report card configuration values
my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?");
foreach my $dataname ( 'r_MarkField', 'r_MarkEntryTerm', 'r_SingleTermOnly') {
    $sth->execute( $dataname );
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    my $datavalue = $sth->fetchrow;
    eval $datavalue;
    if ( $@ ) {
	print $lex{Error}. " $@<br>\n";
	die $lex{Error}. " $@\n";
    }
}


# 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 "<p>$lex{'Please Log In'}</p>\n";
    exit;
}

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";


# Get nominal grade for this subject, used below to get term for multi-track.
my $sth = $dbh->prepare("select grade from subject where subjsec = ?");
$sth->execute( $subjsec );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $grade = $sth->fetchrow;
if ( not $grade ) {
    print "<p><b>$lex{Error}</b>: $lex{Missing} $lex{Grade}: $subjsec</p>\n";
}

my $track = $g_MTrackTermType{$grade};
my $term = $r_MarkEntryTerm{$track};

#  print "Term:$term Grade:$grade Track:$track<br>\n";

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

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

# Disable Posting?
if ( $term == 0 ) {
    print qq{<h3>Missing Term. $lex{'System Disabled. Please contact secretary'}</h3></body></html>\n};
    exit;
}


print qq{<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 qq{<input type="submit" value="$lex{'Decimal Display'}">\n};
print qq{<select name="decimaldisplay">};
if ( $arr{decimaldisplay} ) { print qq{<option>$arr{decimaldisplay}</option>\n}; }
for my $val ( 0 .. 4 ) { print qq{<option>$val</option>}; }
print qq{\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 qq{<h1>$subjref->{'description'} ($subjref->{'subjsec'})</h1>\n};


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

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

    print qq{<tr style="background-color:#CCC;color:red">\n};
    print qq{<td class="bra" colspan="2">$lex{Term}</td>\n};
    print qq{<td><select name="term">};
    print qq{<option value="$term">$g_TermDisplay{$track}{$term}</option>\n};

    if ( not $r_SingleTermOnly ) {  # allow teacher to post to other terms.
	for my $trm ( $startterm .. $endterm ){
	    if ( $trm == $term ) { next; }
	    print qq{<option value="$trm">$g_TermDisplay{$track}{$trm}</option>};
	}
    }
    print qq{</select></td></tr>\n};

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

    # Print Override Marks Line
    print qq{<tr style="background-color:#CCC;">\n};
    print qq{<td class="ra" colspan="2|">$lex{'Override Existing Marks?'}</td>\n};
    print qq{<td><input type="checkbox" name="markoverride" value="1"></td></tr>\n};
    print qq{<tr><th>$lex{Name}</th><th>$lex{'Prev<br>Post'}</th><th>$lex{'GBook<br>Average'}</th></tr>\n};

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

    my $sth = $dbh->prepare("select $r_MarkField from eval where term = ? and studnum = ? and subjcode = ?");
    
    # Print the students and their marks;
    foreach my $studnum ( @studnum ) {

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

	print qq{<tr><td>$lastname, $firstname</td>\n};

	
	# Get current mark, if any for this term, subject, student.
	# $r_MarkField defined in repcard.conf - the field a1 to a20 with numeric mark
	$sth->execute( $term, $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 qq{<td class="cn">$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 qq{<td><input type="text" name="$studnum" size="4" value="$letter">$studentavg</td></tr>\n};

	} else {
	    $studentavg = format_number($studentavg, $arr{decimaldisplay} );
	    print qq{<td><input type="text" name="$studnum" 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 qq{<tr style="background-color: #CCC;"><td colspan="2" class="cn">};
    print qq{$lex{'Class Average'}</td>\n};
    my ($avgcount, $avgtotal);
    foreach my $avg (@studentavg){
	$avgcount++;
	$avgtotal += $avg;
    }
    if ( not $avgcount ){ print qq{<br>$lex{'No Tests Found'}<br>\n}; exit;}
    my $avgstudenttotal = $avgtotal / $avgcount;

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

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

    print qq{</table></form><p></p>\n};


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

	print qq{<form action="$self" method="post">\n};
	if ( $arr{decimaldisplay} ) {
	    print qq{<input type="hidden" name="decimaldisplay" value="$arr{decimaldisplay}">\n};
	}
	
	print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	print qq{<tr><th>$lex{'Convert to Letter Grade'}</th></tr>\n};
    
	print qq{<tr><td><select name="convertscheme">\n};
	foreach my $scheme ( @schemes ) {
	    print qq{<option>$scheme</option>};
	}
	print qq{</select></td></tr>\n};

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

	print qq{</table></form>\n};
    }

    print qq{</body></html>\n};


} # end of showStartPage




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

    my $error = shift;
    print qq{$doctype\n<html><head><title>$error</title>
    <link rel="stylesheet" href="$tchcss" type="text/css">
    $chartype\n </head><body><h1>$error</h1>
    <p><form action="post.pl" method="post">
    <input type="hidden" name="subjsec" value="$arr{subjsec}">}.
    $lex{Userid}. qq{: <input type="text" name="userid" size="8">}.
    $lex{Password}. qq{: <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> ]</body></html>};
    exit;

}



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

    # 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.

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

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

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

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

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


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




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

    print qq{<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 qq{</p><h3 style="padding-left:2em;">$postedCount };
	print qq{$lex{'marks were posted to the report card system'}.</h3>\n};
    } else {
	print qq{<h3>$lex{Error} $DBI::errstr</h3>\n};
    }
    
    print qq{</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 format_number( 100 * $totalscore / $totalweight, $arr{decimaldisplay} );
    } else {
	return 0;
    }

} # End of CalcAverage