#! /usr/bin/perl
#  Copyright 2001-2024 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 = ('Assessment Entry' => 'Assessment Entry',
	   'No Course Enrollments' => 'No Course Enrollments',
	   'Main' => 'Main',
	   'Mark' => 'Mark',
	   'Move between fields using the <b>Tab</b> and <b>Shift-Tab</b> keys' =>
	     'Move between fields using the <b>Tab</b> and <b>Shift-Tab</b> keys',
	   'It is faster!' => 'It is faster!',
	   'Save' => 'Save',
	   'Objective' => 'Objective',
	   'Comment' => 'Comment',
	   'Record(s) Stored' => 'Record(s) Stored',
	   'Contact' => 'Contact',
	   'Assessments' => 'Assessments',
	   'Please Log In' => 'Please Log In',
	   'Error' => 'Error',
	   'Current Evaluation' => 'Current Evaluation',
	   'Missing' => 'Missing',
	   'Add' => 'Add',
	   'Term' => 'Term',

	   );

# Configured values
my $default_AssessKeyCols = 4;


my $self = 'markadd1.pl';

use DBI;
use CGI;
use CGI::Session;

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

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

if ( not $r_AssessKeyCols ) {  # in case not set yet.
    $r_AssessKeyCols = $default_AssessKeyCols;
}

my $q = new CGI;
my %arr = $q->Vars;

# Passed values from 0 script.
my $subjsec = $arr{subjsec}; # passed in...
my $term = $arr{entryterm};
my $track = $arr{track};


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 $userid;
if ( not $session->param('logged_in') ){
    $userid = $session->param('userid');
    print $q->header( -charset, $charset );
    print qq{$doctype\n<html><head><title>$lex{'Assessment Entry'}</title>\n};
    print qq{<link rel="stylesheet" href="$tchcss" type="text/css">\n};
    print qq{</head><body>[ <a href="$tchpage">$lex{Main}</a> ]\n};

    if ( $userid and $arr{writeflag} ) { # update records if user exists and writeflag set.
	delete $arr{writeflag};
	updateRecords();
	print qq{<h3>$lex{'Please Log In'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    } else {
	print qq{<h3>$lex{'Please Log In'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
}
# Ok, we have a login. Values below we have in environment.

$userid = $session->param('userid');
$duration = $session->param('duration');
if (not ($duration =~ m/\+/)) {
    $duration = '+'. $duration. 'm';
}
$session->expire('logged_in',$duration);
print $session->header( -charset, $charset );

my $title = $lex{'Assessment Entry'};
print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$tchcss" type="text/css">\n};

print qq{<style type="text/css">input:focus, textarea:focus };
print qq{ { background-color:#AEA;font-weight:bold; }\n};
print qq{a:link, a:visited { color:#DDD; }};
print qq{</style>\n};


# Some Javascript here for resizing...
print "<script type=\"text/javascript\">
 <!-- 
 function resize_div() {
   var x = document.getElementById(\"evalkey\");
   var iHeight = x.offsetHeight;
   //alert(iHeight);
   var oSpacer = document.getElementById(\"spacer\");
   oSpacer.style.height = (iHeight - 10 ) + 'px';
   //if (oFormDiv.offsetTop) {
   //  oFormDiv.style.top = iHeight + 20;
   //} else { alert('No Top Function'); }
   document.forms[0].elements[2].focus();
 }
\n";

print "function showmarks(studnum,term) { \n";
print " winName=window.open(\"viewassess.pl?studnum=\" + studnum + \"&term=\" + term,\n";
print "'Student_Marks','height=500,width=600,screenX=100,screenY=100,scrollbars=yes');";
print " winName.focus();
}
 -->
 </script>\n";

print qq{$chartype\n</head><body style="padding-left:1em;" onload="resize_div()">\n};
# End of HTML Head section.


# Load the AdditionalComments value, to test if subject is a comment only subject.
$sth = $dbh->prepare("select datavalue from conf_system
 where dataname = ?");
$sth->execute('r_AdditionalComments');
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $dv = $sth->fetchrow;
eval $dv;



# Get Course Info: Subjcode, Description, Grade
my $sth = $dbh->prepare("select subjcode, description, grade from subject where subjsec = ?");
$sth->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my ($subjcode, $description, $grade) = $sth->fetchrow;

my $acMode; # Additional Comments don't have any values but a comment...
if ( $r_AdditionalComments{ $subjsec } or $r_AdditionalComments{ $subjcode } ) { 
    $acMode = 1;
}

my $subjectname;
if ($description =~ m/$grade/) {
    $subjectname = $description;
} else {
    $subjectname = "$description $grade";
}


# Get Subject Objectives and Put in @qstarray
my @subject = ();
$sth = $dbh->prepare("select * from subject where subjsec = ?");
$sth->execute($subjsec);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
@subject = $sth->fetchrow;


my @qstarray = ();
# Stuff questions into the array.
foreach my $a (10..29) {
   if ($subject[$a]) { push @qstarray, $subject[$a]; }
}

if ( not $subject[10] ) { # blank qstarray
  # We must put in one question.
    push @qstarray, $lex{Mark};
}


# Update Records
if ( $arr{writeflag} ) {
    delete $arr{writeflag};
    updateRecords();
}



# Get the students in this course, in name order.
$sth = $dbh->prepare("select distinct e.studnum from eval e, student s 
  where e.subjcode = ? 
  and e.studnum = s.studnum and e.term = ? 
  order by s.lastname, s.firstname ");
$sth->execute($subjsec, $term);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

my @students;
while (my $studnum = $sth->fetchrow ) {
    push @students, $studnum;
}


if ( not @students ) {
    print qq{<h2>$lex{'No Course Enrollments'}</h2>\n};
    print qq{</body></html>\n};
    exit;
}


# Print Evaluation Keys
my @evalkey;
my @evalkeyAlt1;
if ( $r_Personal_Growth eq $description ) { # if the subject is personal development
    # figure out the key scheme...used to print eval schemes $r_PDEval{$scheme}{arrayidx}
    my $scheme = $r_PDEvalGrp{$grade};
    @evalkey = @{ $r_PDEval{$scheme} };

} else {
    my $scheme = $r_EvalSch{$grade}; 
    my $schemeAlt1 = $r_EvalSchAlt1{$grade};
    @evalkey = @{ $r_Eval{$scheme} };#  OR $r_Eval{scheme}[arrayidx]
    @evalkeyAlt1 = @{ $r_EvalAlt1{$schemeAlt1} };
}


# Print Assessment Table at top
print qq{<div style="position:fixed;top:0;left:1em;color:#063;font-size:80%;background-color:#FFF;" id="evalkey">\n};
print qq{<table cellpadding="3" border="1" cellspacing="0" style="margin:0.2em auto 0 auto;">\n};

# Print the Hint.
my $cols = $r_AssessKeyCols + 1;
print qq{<tr><td colspan="$cols" style="color:white;background-color:#063;">\n};
print qq{ | <a href="$tchpage">$lex{'Main'}</a> | \n};
print $lex{'Move between fields using the <b>Tab</b> and <b>Shift-Tab</b> keys'};
print qq{ $lex{'It is faster!'}</td></tr>\n};

print qq{<tr style="font-weight:bold;font-size:110%;text-align:center;background-color:#DDD">};
print qq{<td colspan="$cols">Evaluation Key</td></tr>\n};

my $itemcount;
print '<tr>';
foreach my $item ( @evalkey ){
    my ($key,$val) = split(/::/, $item);
    if ( $val ) { # we have 2 items
	print qq{<td>$key - $val</td>};
    } else { # just use item since it doesn't split with ::
	print qq{<td>$item</td>\n};
    }
    $itemcount++;
    if ( $itemcount % $r_AssessKeyCols == 0 ){ # 4-3 one less (3-2 works)
	print qq{</tr><tr>\n};
    }
}
$remainder = $r_AssessKeyCols - ( $itemcount % $r_AssessKeyCols );
if ( $remainder == $r_AssessKeyCols ) { $remainder = 0; }
for ( 1..$remainder ){ print qq{<td></td>\n};}
print qq{</tr>\n};


if ( @evalkeyAlt1 ) {
    my $itemcount;
    print qq{<tr style="font-weight:bold;font-size:110%;text-align:center;background-color:#DDD">};
    print qq{<td colspan="$r_AssessKeyCols">$r_EvalAlt1Title</td></tr>\n};
    print '<tr>';
    foreach my $item ( @evalkeyAlt1 ){
	my ($key,$val) = split(/::/, $item);
	if ( $val ) { # we have 2 items
	    print qq{<td>$key - $val</td>};
	} else { # just use item since it doesn't split with ::
	    print qq{<td>$item</td>\n};
	}
	$itemcount++;

	if ( $itemcount % $r_AssessKeyCols == 0 ){ # 4-3 one less (3-2 works)
	    print qq{</tr><tr>\n};
	}
    }
    $remainder = $r_AssessKeyCols - ( $itemcount % $r_AssessKeyCols );
    if ( $remainder == $r_AssessKeyCols ) { $remainder = 0; }
    for ( 1..$remainder ){ print qq{<td></td>\n};}
    print qq{</tr>\n};
}

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


# print Spacer div behind absolutely positioned assessment key div
print qq{<div style="height:50px;" id="spacer"></div>\n};


# Print Top Section / Start of Form
#$lex{'Assessment Entry'}
print qq{<h1 style="margin:0.5em;">$subjectname - $lex{Term} $term</h1>\n};

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

my $sth = $dbh->prepare("select * from eval where studnum = ? and subjcode = ? order by term");

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

foreach my $studnum ( @students ) { # Loop through all students in this class.

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


    # Load all eval records for this student in this subject (ie. all terms)
    # structure is a hash pointing to an array. (full eval record)
    my %evals = ();
    $sth->execute($studnum, $subjsec);

    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
    while ( my @eval = $sth->fetchrow ) { # put into %evals hash
	$evals{$eval[4]} = [ @eval ];
    }


    print qq{\n<table cellpadding="2" cellspacing="0" border="1" style="margin-bottom:1em;">\n};
    print qq{<tr><th colspan ="2" style="font-size:120%;">$firstname $lastname};
    print qq{<span style="font-size:80%;margin-left:2em;"><a href="javascript:showmarks($studnum,$term)">};
    print qq{$lex{'Current Evaluation'}</a></span></th></tr>\n};
    print qq{<tr><td class="cn"><!-- Now Inner Table -->\n};

    my $id = $evals{$term}->[0];
#    print qq{Term:$term|ID:$id<br>\n};

    if ( not $acMode ) {
	print qq{<table cellpadding="2" cellspacing="0">\n};
	print qq{<tr style="background-color:#DDD;"><td class="cn"><i>};
	print qq{$lex{Objective}</i></td>\n};

	# Print Terms row...
	foreach my $trm ( sort keys %evals ) {
	    if ( $trm <= $term ) {
		print qq{<td class="cn"><i>$g_TermDisplay{$track}{$trm}</i></td>\n};
	    } else {
		last; # just out if hit current term
	    }
	}
	print qq{</tr>\n};

	my $count = 1; 
	my $qst = 7;
	foreach my $question ( @qstarray ){ 
	    print qq{<tr><td class="la">$count. $question</td>};

	    # print previous term values
	    foreach my $trm ( sort keys %evals ) {
		if ( $trm < $term ) {
		    print qq{<td class="cn">$evals{$trm}->[$qst]</td>\n};
		} else {
		    last; # just out if hit current term
		}
	    }

	    # print current term.
	    print qq{<td class="la">};
	    print qq{<input type="text" name="$id:$studnum:$count" };
	    print qq{ style="width:4ch;" value="$evals{$term}->[$qst]"></td></tr>\n};

	    $count++;
	    $qst++;
	}
	print qq{<!-- Finish Inner Table -->\n};
	print qq{</table>\n};
    }


    print qq{<div style="text-align:left;padding:0.5em;">\n};
    # Print Previous Comments...
    foreach my $trm ( sort keys %evals ) {
	if ( $trm < $term and $evals{$trm}->[6] ) {
	    print qq{<b>$g_TermDisplay{$track}{$trm} $lex{Comment}:</b> }. $evals{$trm}->[6]. qq{<br>\n};
	}
    }


    print qq{<b>$g_TermDisplay{$track}{$term} $lex{Comment}:</b><br>\n};
    print qq{<textarea name="$id:$studnum:comment" cols="90" rows="4">};
    print $evals{$term}->[6];
    print qq{</textarea></div>\n};

    print qq{</td></tr></table>\n};

}

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



#----------------
sub updateRecords {
#----------------

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

    foreach my $key ( keys %arr ) {
 
	my ( $evalrec, $studnum, $qst) = split(/:/, $key);

        if ( not $evalrec ) {
	    print qq{<b>$lex{Error}: $lex{Missing} ID: $arr{$key}<br>\n};
	    next;
	} elsif ( not $qst ) {
	    print qq{<b>$lex{Error}: $lex{Missing} QST# : $arr{$key}<br>\n};
	    next;
	}

	# Strip any backspaces, since these are LaTeX control ocdes.
	$arr{$key} =~ s/\\//g;  


	# check field type and quote.
	if ($qst eq "comment"){

	    my $s = $arr{$key};

=head
	    if ( $s ) {
		my @temp = split(//,$s);
		foreach my $val ( @temp ) {
		    print qq{$val:",ord($val)," | };
		}
		print qq{<br><br>\n};
	    }
=cut

	    # Filter the comments.
	    # Convert newlines to spaces
	    $s =~ s/\r\n|\n|\r|\t/ /g;

	    # Convert Smart Quotes.

	    # Do multibyte characters first!
	    $s =~ s/\xE2\x80\x9C|\xE2\x80\x9D/"/g; # double quotes
	    $s =~ s/\xE2\x80\x98|\xE2\x80\x99/'/g; # Single Quotes
	    $s =~ s/\xE2\x80\x93/-/g; # ndash 
	    $s =~ s/\xE2\x80\xA2/*/g; # replace bullet.
	    $s =~ s/\xE2\x80\x94}/--/g; # mdash
	    $s =~ s/\xE2\x80\xA6/.../g; # ellipsis

#	    print "Comment:$arr{$key}<br>\n";
	    
	    # Single Byte Replacements
            $s =~ s/\x93|\x94/"/g; # double quotes
	    $s =~ s/\x91|\x92/'/g; # single quote

	    $s =~ s/\x95/*/g; # replace bullet.
	    $s =~ s/\x96/-/g; # ndash 
	    $s =~ s/\x97/--/g; # mdash
	    $s =~ s/\x85/.../g; # ellipsis
	    
	    # Strip control codes
	    $s =~ s/[\x80-\x9F]//g; # strip upper control codes area
	    $s =~ s/[\x00-\x1F]//g; # strip lower control codes area

	    $fieldid = "comment";
	    $arr{$key} = $s;

	} else {
	    $fieldid = "a$qst";
	    $arr{$key} = "\U$arr{$key}";
	}

#	print "Comment:$arr{$key}<br>\n";

	
	$sth = $dbh->prepare("update eval set $fieldid = ? where id = ? ");

	$sth->execute( $arr{$key},$evalrec );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }

    }

    if ( not $DBI::errstr ) {
	print qq{<div style="font-size:150%;margin:2em;font-weight:bold;border:2px solid gray;width:16ch;padding:0.4em;">};
	print qq{$lex{'Record(s) Stored'}</div>\n};

    } else {
	print qq{<h3>$lex{Error}: $DBI::errstr</h3><h3>$lex{Contact}:};
	print qq{ $adminname <a href="mailto:$adminemail">$adminemail</a></h3>\n};
    }

    print qq{<div style="background-color:#063;black;padding:0.5em;margin:1em;width:30ch;">};
    print qq{<a href="$tchpage">$lex{Main}</a> | \n};

    print qq{<a href="markadd0.pl">$lex{Add} More $lex{Assessments}</a></iv>\n};
    print qq{</body></html>\n};

    exit;

} # End of Update Record.
