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

my %lex = ('Main' => 'Main',
	   'Report Card' => 'Report Card',
	   'Transcript' => 'Transcript',
	   'Post' => 'Post',
	   'Mark' => 'Mark',
	   'Student' => 'Student',
	   'Course' => 'Course',
	   'Courses' => 'Courses',
	   'Duplicate' => 'Duplicate',
	   'Error' => 'Error',
	   'Replace Existing' => 'Replace Existing',
	   'Record' => 'Record',
	   'Update Record' => 'Update Record',
	   'Skipping' => 'Skipping',
	   'Check' => 'Check',
	   'Select' => 'Select',
	   'Identity Mismatch' => 'Identity Mismatch',
	   'Edit' => 'Edit',
	   'Term' => 'Term',
	   'Skip' => 'Skip',
	   'Blank Marks' => 'Blank Marks',
	   'Average Mode' => 'Average Mode',
	   'Continue' => 'Continue',

	   );

# rounding precision of mark.
my $precision = 1;

my $self = 'tscpost.pl';
my $idfield = 'provnum'; # change to suit the field for state/provincial id or SSN, etc.

use DBI;
use CGI;
use Number::Format qw(:subs);


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

my $q = CGI->new;
print $q->header( -charset, $charset );
my %arr = $q->Vars;

my $fmt = new Number::Format(-decimal_fill => '1', -decimal_digits => '2');

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


# Page Header
my $title = qq{$lex{Transcript} $lex{Post}};

print qq{$doctype\n<html><head><title>$title</title>
<link rel="stylesheet" href="$css" type="text/css">
$chartype\n</head><body style="padding:1em 2em;">\n};

print qq{[ <a href="$homepage">$lex{Main}</a> |\n};
print qq{<a href="$reppage">$lex{'Report Card'}</a> ]\n};

print qq{<h1>$title</h1>\n};

if ( not $arr{page} ) { # We have a selected student.
    showStartPage();

} elsif ( $arr{page} == 1 ) {
    delete $arr{page};
    selectSubjects();

} elsif ( $arr{page} == 2 ) {
    delete $arr{page};
    postSubjects();
} 


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

    # Grade Selection
    my @grades;
    my $sth = $dbh->prepare("select distinct grade from student 
     where grade != '' and grade is not null");
    $sth->execute;
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    while ( my $grade = $sth->fetchrow ) {
	push @grades, $grade;
    }
    @grades = sort {$a <=> $b} @grades;
    
    
    # Term Selection
    my @terms;
    my $sth = $dbh->prepare("select distinct endrptperiod from subject 
     where endrptperiod != '' and endrptperiod is not null order by endrptperiod");
    $sth->execute;
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    while ( my $trm = $sth->fetchrow ) {
	push @terms, $trm;
    }

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="1">\n};

    print qq{<table cellpadding="5" border="1" cellspacing="0">\n};
    
    print qq{<tr><td class="bra">$lex{Select} $lex{Term}</td>};
    print qq{<td><select name="term"><option value=""></option>\n};
    foreach my $trm ( @terms ) {
	print qq{<option>$trm</option>};
    }
    print qq{</select></td></tr>\n};

    print qq{<tr><td class="bra">$lex{Check} $lex{Courses}</td>\n}; 
    print qq{<td><input type="checkbox" name="checked" value="checked"></td></tr>\n};

    print qq{<tr><td class="bra">$lex{Skip} $lex{'Blank Marks'}<br>($lex{'Average Mode'})</td>\n}; 
    print qq{<td><input type="checkbox" name="skipblanks" value="1"></td></tr>\n};

    print qq{<tr><td colspan="2" class="bla">Select Grades to Post</td></tr>\n};

    foreach my $grade ( @grades ) {
	print qq{<tr><td colspan="2" class="la">Grade $grade };
	print qq{<input type="checkbox" name="$grade" value="1"></td></tr>\n};
    }
    
    print qq{</table>\n};
    print qq{<input type="submit" value="$lex{Continue}">\n};
    
    print qq{</form></body></html>\n};

    exit;

}


#-----------------
sub selectSubjects {
#-----------------

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

    my $skipblanks = $arr{'skipblanks'};
    delete $arr{'skipblanks'};

    my $term = $arr{term};
    delete $arr{term};
    if (not $term ) {
	print qq{<h3>Missing Term</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    my $checked;
    if ( $arr{checked} ) {
	$checked = qq{checked="checked"};
	delete $arr{checked};
    }

    # remaining values will be grades.
    my %grades;
    foreach my $key (keys %arr ) {
	$grades{$key} = 1;
    }
    if ( not %grades ) {
	print qq{<h3>Missing Grades</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Check Values
#    print qq{Grades<br>};
#    foreach my $key ( sort keys %grades ) {
#	print qq{K:$key VAL:$grades{$key}<br>\n};
#    }

    
    # Get values for supression from configuration system
    my @fieldnames = qw( r_SupressSubject r_AdditionalComments ); 
    my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?");
    foreach my $var ( @fieldnames ) {
	$sth->execute( $var );
	my $datavalue = $sth->fetchrow;
	eval $datavalue;
	if ( $@ ) {
	    print qq{$lex{Error}: $@<br>\n};
	    exit qq{$lex{Error}: $@\n};
	}
    }
    
    # Course Selection - find courses with this term in eval (containing marks)
    my $sth = $dbh->prepare("select distinct e.subjcode from eval e, subject s 
			    where term = ? and grade = ? and e.subjcode = s.subjsec");
    my %crs;

    foreach my $grade ( sort keys %grades ) {
	$sth->execute( $term, $grade );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	while ( my $subjsec = $sth->fetchrow ) {
	    
	    # skip if member of %r_SupressSubject or AdditionalComments
	    my ($tsubjcode, $dud) = split('-', $subjsec );

	    if ( $r_SupressSubject{$tsubjcode} or $r_SupressSubject{$subjsec} or
		 $r_AdditionalComments{$tsubjcode} or $r_AdditionalComments{$subjsec} ) {
		next; 
	    }

	    $crs{$subjsec} = 1;
	}
    } # end of grade loop

    # Find Description, Grade for course
    my (%sort, %desc, %gr);
    $sth1 = $dbh->prepare("select endrptperiod, description, grade from subject where subjsec = ?");
    foreach my $subjsec ( keys %crs ) {
	$sth1->execute( $subjsec );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	my ( $endterm, $description,$grade ) = $sth1->fetchrow;

	if ( $endterm == $term ) { # the subject ends this term...
	    $desc{$subjsec} = qq{<b>$description</b> Gr $grade ($subjsec) };
	    $sort{"$grade$description$subjsec"} = $subjsec;
	    $gr{$subjsec} = $grade;
	}
    }

    # At this point hashes only contains subjects that have
    # endterm in the selected term.


    # Print Start of Selection.
    print qq{<h3>$lex{Select} $lex{Courses}</h3>\n};

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="2">\n};
    print qq{<input type="hidden" name="term" value="$term">\n};
    print qq{<input type="hidden" name="skipblanks" value="$skipblanks">\n};

    print qq{<div style="width:20em;border:1px solid gray;padding:0.5em;margin:0.5em 0em">};
    print qq{<input type="checkbox" name="replacemode" value="1"> \n};
    print qq{$lex{'Replace Existing'} $lex{Record}?</div>};


    print qq{<input type="submit" value="$lex{Select} $lex{Courses}">\n};
    print qq{<table cellpadding="5" border="1" cellspacing="0">\n};

    my ($currgrade,$prevgrade);
    my $backgroundcolor = "#FFF";
    foreach my $key ( sort keys %sort ) {

	my $subjsec = $sort{ $key };
	$prevgrade = $currgrade;
	$currgrade = $gr{$subjsec};
	
	if ( $currgrade ne $prevgrade and $prevgrade ){  # toggle color
	    if ( $backgroundcolor eq '#FFF' ) {
		$backgroundcolor = '#DDD';
	    } else {
		$backgroundcolor = '#FFF';
	    }
	}
	print qq{<tr><td class="la" style="background-color:$backgroundcolor;">};
	print qq{<input type="checkbox" name="$subjsec" value="1" $checked>};
	print qq{ $desc{$subjsec}</td></tr>\n};

    }

    print qq{</table>\n};
    print qq{<input type="submit" value="$lex{Select} $lex{Courses}">\n};
    print qq{</form></body></html>\n};

    exit;

}



#---------------
sub postSubjects {
#---------------

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
    
    # Get the r_MarkField value and others from configuration system
    my @fieldnames = qw( markToLetter term_desc term_key r_MarkField r_AverageWeight ); 
    my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?");
    foreach my $var ( @fieldnames ) {
	$sth->execute( $var );
	my $datavalue = $sth->fetchrow;
	eval $datavalue;
	if ( $@ ) {
	    print qq{$lex{Error}: $@<br>\n};
	    exit qq{$lex{Error}: $@\n};
	}
    }


    my $term = $arr{term};  # the term we are posting....
    delete $arr{term};

    my $replacemode = $arr{replacemode}; # may not exist in %arr hash.
    delete $arr{replacemode};

    my $skipblanks = $arr{'skipblanks'};
    delete $arr{'skipblanks'};


    # SQL Selections
    my $sth1 = $dbh->prepare("select lastname, firstname, initial, birthdate, 
     $idfield, graddate from studentall where studnum = ?");
    my $sth2 = $dbh->prepare("select count(*) from tscriptident where studnum = ?");
    my $sth3 = $dbh->prepare("select lastname, firstname, birthdate,studentid from tscriptident
     where studnum = ?");

    # Get the subject fields
    my $sth4 = $dbh->prepare("select description, credit, difficulty, area, calcavg 
			     from subject where subjsec = ?");
    my $sth5 = $dbh->prepare("select id, $r_MarkField, term from eval 
			     where subjcode = ? and studnum = ? order by term");

    # Print heading Section
    print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
    print qq{<tr><th>$lex{Student}</th><th>$lex{Subject}</th><th>$lex{Mark}</th></tr>\n};

    foreach my $subjsec ( sort keys %arr ) {

	# Get the subject information
	$sth4->execute ( $subjsec );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $description, $credit, $difficulty, $area, $calcavg ) = $sth4->fetchrow;

#	print qq{Sub:$description - $subjsec<br>\n};

	# select each student record in turn and post.
	my $sth = $dbh->prepare("select $r_MarkField , studnum from eval
				where term = ? and subjcode = ? order by studnum");
	$sth->execute( $term, $subjsec );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

STUDENT:
	while ( my ( $mark, $studnum ) = $sth->fetchrow ) {
	    # print qq{Mark:$mark Stud:$studnum<br>\n};

	    # Get full name and birthdate from studentall
	    $sth1->execute( $studnum );
	    if ( $DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	    my ($lastname,$firstname,$middlename,$birthdate,$studentid,$graddate)=$sth1->fetchrow;
	    # $studentid field is configurable at top of script.

	    # Skip NULL/Blank values in mark, if not in calcavg mode
	    if ( $calcavg eq 'N' or not $calcavg ) {
		if ( not defined $mark or $mark eq "" ) { # skip NULLs/Blanks
		    print qq{<tr style="color:red"><td>$lex{Skipping} Blank - };
		    print qq{$firstname $lastname</td>\n};
		    print qq{<td>$description ($subjsec)</td>\n};
		    print qq{<td>NULL</td></tr>\n};
		    next STUDENT;
		}
	    }

	    # Check to see if mark contains letters 
	    my $markContainsLetters;
	    if ( $mark =~ m/[a-zA-Z]/ ) {
		$markContainsLetters = 1;
		print qq{Mark Contains Letters: $mark<br>\n};
	    }

	    # Check for existing ident record, and match; fail on error; otherwise create.
	    $sth2->execute( $studnum );
	    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my $count = $sth2->fetchrow;
	    if ( $count > 1 ) { 
		print qq{<div>Fatal Error: more than 1 student ident record with same studnum!<br>\n};
		print qq{for student number: $studnum. Contact Administrator!</div>\n};
		exit;

	    } elsif ( $count < 1 ) { # add a new ident record.

		my $sth6 = $dbh->prepare("insert into tscriptident 
		 ( studnum, lastname, firstname, middlename, birthdate,studentid, graddate )
					 values ( ?, ?, ?, ?, ?, ?, ? )");
		if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
		$sth6->execute($studnum, $lastname , $firstname, $middlename, $birthdate,
			       $studentid, $graddate );
		if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }


	    } else { # we have an existing record. Check for a full match;
		
		$sth3->execute( $studnum );
		if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
		my ($testlastname, $testfirstname, $testbirthdate) = $sth3->fetchrow;

		if ( $lastname ne $testlastname or 
		     $firstname ne $testfirstname or 
		     $birthdate ne $testbirthdate) { # We have a problem
		    print qq{<tr><td colspan="3">\n};

		    my ($extraurl, $table, $id);
		    foreach my $tbl ( qw( student studentwd )) {
			my $sth6 = $dbh->prepare("select studid from $tbl where studnum = ?");
			$sth6->execute( $studnum );
			if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
			$id = $sth6->fetchrow;
			if ( $id ) {
			    if ( $tbl eq 'studentwd' ) { $extraurl = '&tbl=wd';}
			    last; 
			}
		    }

		    print $lex{'Identity Mismatch'};

		    print qq{:$firstname|$lastname|$birthdate|($studnum) };
		    print qq{$lex{Transcript}:$testfirstname|$testlastname|($testbirthdate)|\n};
		    print qq{[ <a href="../studed.pl?id=$id$extraurl">$lex{Edit} $lex{Student}</a> |\n};
		    print qq{ <a href="../repcard/tscdeled.pl">$lex{Edit} $lex{Transcript}</a> ]\n};
		    print qq{</td></tr></table></body></html>\n};
		    exit;
		}
	    }
	    # Now done with updating tscriptident records, if required.


	    # If using average method for mark, calculate it now and replace previous mark value.
	    if ( ( $calcavg eq 'Y' or $calcavg == 1 ) and not $markContainsLetters ) {

		$sth5->execute( $subjsec, $studnum ); # Get all mark field values.
		if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
		my ( $totalscore, $totalweight);
		
		while ( my ( $id, $score, $term ) = $sth5->fetchrow ) {

		    if ( $skipblanks ) { # normally ON; skip students with ANY blank marks
			if ( not defined $score ) {
			    print qq{<tr style="color:red"><td>$lex{Skipping} Blank - };
			    print qq{$firstname $lastname</td>\n};
			    print qq{<td>$description ($subjsec)</td>\n};
			    print qq{<td>$lex{Term} $term</td></tr>\n};
			    next STUDENT;
			}
		    }

		    # NULL or empty strings are skipped; redundant from above?
		    if ( not defined $score  or $score eq "" ) { next; }

		    if ( $score =~ m/\d/){ # if a digit...
			if ( not $r_AverageWeight{$term} ) { # Error
			    print qq{<h3>No Average Weight (r_AverageWeight) defined };
			    print qq{for this term $term</h3>\n};
			    print qq{</body></html>\n};
			    exit;
			}
			my $wt = $r_AverageWeight{$term}; #The weight for this term 
			$totalscore += ( $wt * $score );
			$totalweight += $wt;
		    }
		} # end of looping over course marks
	    
		if ( $totalweight ){ # We have some tests.
		    $testavg = $totalscore / $totalweight;
		    $testavg = format_number( $testavg, $precision,$precision); # set at to of script
		} else { 
		    $testavg = 0;
		}

		$mark = $testavg;
		
	    } # end of calcavg
	    

	    my $letter; # letter grade.
	    if ( $markContainsLetters ) { # We have a 'letter' mark, copy into $letter 
		$letter = $mark;
	    } else { # find the matching letter for this numeric value..
		foreach my $threshold (reverse sort keys %markToLetter ) { # from large to small...
		    if ( $mark >= $threshold ) {
			$letter = $markToLetter{$threshold};
			last;
		    }
		}
	    }


	    # Check for duplicate course records - same studnum, same
	    # subjsec, same year, same term.  Skip if duplicate
	    $sth6 = $dbh->prepare("select id from tscriptdata
				  where subjectcode = ? and studnum = ? and 
				  schoolyear = ? and term = ?");
	    $sth6->execute( $subjsec, $studnum, $schoolyear, $term );
	    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my $id = $sth6->fetchrow;

	    # Setup the Term Description info from the tscript.conf.
	    my $term_desc = $term_desc{ $term_key{$term} };


	    if ( $id > 0 ) {

		if ( not $replacemode ) { # skip this student/subject; already done.
		    print qq{<tr style="color:red;"><td>$lex{Duplicate}! };
		    print $lex{'Skipping'};
		    print qq{ $firstname $lastname</td><td>$description</td><td>$mark</td></tr>\n};
		    next STUDENT; # skip to next record!

		} else { # replace existing record
		    print qq{<tr><td><b>$lex{'Update Record'}</b>:};
		    print qq{ $firstname $lastname</td><td>$description</td><td>$mark</td></tr>\n};

		    my $sth6 = $dbh->prepare("update tscriptdata set
                      studnum = ?, subjectcode = ?, subjecttext = ?, subjectarea = ?, score_mark = ?, 
                      score_letter = ?, score_diff = ?, schoolyear = ?, crdate = now(), 
                      credit = ?, term = ?, term_desc = ? where id = ?");

		    $sth6->execute( $studnum, $subjsec, $description, $area, $mark, $letter, 
				    $difficulty, $schoolyear, $credit, $term, $term_desc, $id );
		    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
		}


	    } else { # no record found; insert one.

		# add the data record
		my $sth6 = $dbh->prepare("insert into tscriptdata
                 (studnum, subjectcode, subjecttext, subjectarea, score_mark, score_letter, 
                   score_diff, schoolyear, crdate, credit, term, term_desc )
                 values (?,?,?,?,?,?,?,?,now(),?,?,?)");

		$sth6->execute( $studnum, $subjsec, $description, $area, $mark, $letter, $difficulty, 
				$schoolyear, $credit, $term, $term_desc);
		if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

		print qq{<tr><td>$firstname $lastname</td><td>$description</td>\n};
		print qq{<td>$mark ($letter)</td></tr>\n};

	    }

	} # End of this student / course posting.

    } # End of this course

    print qq{</table>\n};

    print qq{<p>[ <a href="$self">$lex{Post} $lex{Subjects}</a> |\n};
    print qq{ <a href="$reppage">$lex{'Report Card'}</a> ]\n};
    print qq{</body></html>\n};

    exit;

}
