#!/usr/bin/perl
#  Copyright 2001-2023 Leslie Richardson

#  This file is part of Open Admin for Schools.

# Globals: useMultipliers, defaultItemWeight

my %lex = ('Assessment Item' => 'Assessment Item',
	   'Main' => 'Main',
	   'GB Main' => 'GB Main',
	   'Save' => 'Save',
	   'Name' => 'Name',
	   'Max Raw Score' => 'Max Raw Score',
	   'Date' => 'Date',
	   'Weight' => 'Weight',
	   'New Group' => 'New Group',
	   'Back' => 'Back',
	   'Missing Value(s)' => 'Missing Value(s)',
	   'Add Scores' => 'Add Scores',
	   'Item' => 'Item',
	   'Add' => 'Add',
	   'or' => 'or',
	   'Description' => 'Description',
	   'Record(s) Stored' => 'Record(s) Stored',
	   'New Group Weight' => 'New Group Weight',
	   'Continue' => 'Continue',
	   'Total' => 'Total',
	   'Error' => 'Error',
	   'Please Log In' => 'Please Log In',
	   'Contact' => 'Contact',
	   'must be a number' => 'must be a number',
	   'Exists' => 'Exists',
	   'Added' => 'Added',
	   'Course' => 'Course',
	   
	   );

my $self = 'testadd.pl';

use DBI;
use CGI;
use CGI::Session;
use Number::Format qw{ round };
#use strict;


# Set the current date
my @tim = localtime(time);
my $year = @tim[5] + 1900;
my $month = @tim[4] + 1;
my $day = @tim[3];
my $currdate = "$year-$month-$day"; 

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

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

my $q = new CGI;

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


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

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


# Print Page Header
print qq{$doctype\n<html><head><title>$lex{Add} $lex{'Assessment Item'}</title>\n};
print qq{<link rel="stylesheet" href="$tchcss" type="text/css">\n};
print qq{$chartype\n</head><body onload="document.forms[0].elements[3].focus()">\n};


if ( not $arr{page} ) { # load jQuery date picker
    print qq{<link rel="stylesheet" type="text/css" media="all" };
    print qq{href="/js/calendar-blue.css" title="blue">\n};
    print qq{<script type="text/javascript" src="/js/calendar.js"></script>\n};
    print qq{<script type="text/javascript" src="/js/lang/calendar-en.js"></script>\n};
    print qq{<script type="text/javascript" src="/js/calendar-setup.js"></script>\n};
}


print qq{<div style="padding: 0 1em;">[ <a href="$tchpage">};
print qq{$lex{Main}</a> | <a href="gbmain.pl">GB Main</a> ]\n};
print qq{</div><h1>$lex{Add} $lex{'Assessment Item'}</h1>\n};

if ( not $arr{flag} ) {
    showStartPage();

} elsif ( $arr{newgrp} and $arr{flag} != 2 ) {
    delete $arr{flag};
    getGroupPercent( $subjsec );

} else {
    delete $arr{flag};
    addRecord();
} 


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

    # Get assessment groups and put into %group; not really needed??
    my %group;
    my $sth = $dbh->prepare("select distinct grp from gbtest
     where subjsec = ? and grp != '' order by grp");
    $sth->execute( $subjsec );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    while ( my $grp = $sth->fetchrow ) {
	$group{$grp} = 1;
    }

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

    
    # Load the markscheme field
    $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 qq{Mark Scheme: $markscheme<br>\n};
    
    # add to the %group hash above; removing duplicates effectively.
    my @fields = split (/[\n|\r]/, $markscheme); # separate into lines.
    foreach my $fld (@fields) { 
	if ($fld) {
	    my ($grp, $percent) = split('=', $fld);
	    $group{$grp} = $percent;
	}
    }

    # Test
#    foreach my $grp ( sort keys %group ) {
#	print qq{MS Grp:$grp Per:group{$grp}<br>\n};
#    }

    
    # Get Subject-Section name.
    $sth = $dbh->prepare("select description from subject where subjsec = ?");
    $sth->execute( $subjsec );
    if ($DBI::errstr){ print $DBI::errstr; die; }
    my $description = $sth->fetchrow;
    print qq{<h1>$description ($subjsec)</h1>\n};
    

    # Print Start of 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="flag" value="1">\n};

    # Save
    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};
    print qq{<tr><td></td><td class="la">};
    print qq{<input type="submit" value="$lex{Save} $lex{'Assessment Item'}"></td></tr>\n};


    # Test Name
    print qq{<tr><td class="bra">Assessment/Test $lex{Name}</td>\n};;
    print qq{<td><input type="text" name="name" size="12" maxlength="32"> };
    print qq{ ex.Asn11, T13,HW23;keep short,max 6 characters;letters and numbers only</td></tr>\n};

    # Test Description
    print qq{<tr><td class="bra">$lex{Description}</td>\n};
    print qq{<td><input type="text" name="description" size="50" maxlength="255">};
    print qq{</td></tr>\n};

    # Test Date
    print qq{<tr><td class="bra">$lex{Date}</td>\n};
    print qq{<td><input type="text" style="width:12ch;" name="tdate" id="date" value="$currdate">};
    print qq{<button type="reset" id="start_trigger">...</button>\n};    
    print qq{</td></tr>\n};

    # Test Max Score
    print qq{<tr><td class="bra">$lex{'Max Raw Score'}</td>\n};
    print qq{<td><input type="text" name="score" size="4" maxlength="8"> };
    print qq{ Use Integers to keep score entry simple; Use natural score total, not 100</td></tr>\n};

    # Test Weight
    print qq{<tr><td class="bra">$lex{'Weight'}</td>\n};


    if ( $useMultipliers ) { # found in gbook.conf; on/off 1/0 type;

	print qq{<td><select name="multiplier">\n};
	foreach my $idx (sort {$a <=> $b} keys %wtmult) {
	    my $value = round( $wtmult{$idx}, 2);
	    print qq{<option value="$value"};
	    if ($idx eq '5') { print q{ selected="selected"}; }

	    print qq{>$value\X</option>};
	}
	print qq{\n</select> Normally leave at 1x (1 times) weight</td></tr>\n};

    } else {
	print qq{<td><input type="text" name="weight" size="4" };
	print qq{value="$defaultItemWeight"> Normally leave at base value</td></tr>\n};
    }

    # Assessment Group
    print qq{<tr><td class="bra">Assessment Group</td><td><select name="grp">\n};
    print qq{<option value=""></option>\n};
    foreach my $gp (keys %group){
	print qq{<option>$gp</option>\n};
    }
    print qq{</select> $lex{or} <i>$lex{'New Group'}</i>\n};;
    print qq{ <input type="text" name="newgrp" size="16" maxlength="64">};
    print qq{ (eg. Term1,Exam1,T1HW,T1Test)</td></tr>\n};

    print qq{<tr><td></td><td class="la">};
    print qq{<input type="submit" value="$lex{Save} $lex{'Assessment Item'}">};
    print qq{</td></tr></table></form>\n};

    print qq{<script type="text/javascript">
     Calendar.setup({
        inputField  : "date",
        ifFormat    : "%Y-%m-%d",
        button      : "start_trigger",
        singleClick : false,
        step        : 1
    }) };
    print qq{</script>\n};
    
    print qq{</body></html>\n};

    exit;

} # end of showStartPage



#------------
sub addRecord {
#------------

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

    my $subjsec = $arr{subjsec};
    my $weight = $arr{weight};
    # either weight or multiplier passed, not both. Depends on mode set.
    if ( $arr{multiplier} ) {
	# was: my $multiplier = $wtmult{$arr{multiplier}};
	my $multiplier = $arr{multiplier};
	$weight = $defaultItemWeight * $arr{multiplier};
	# print qq{MULT: $multiplier  WT: $weight<br>\n};
    }
    # $weight is now set...

    if ( $arr{newgrp} ) { # remove leading/trailing spaces and cr/lf
	$arr{newgrp} =~ s/^\s+|\s+$//;
	$arr{newgrp} =~ s/\r|\n//;
    }


    # check for missing fields.
    if ( ( not $arr{grp} and not $arr{newgrp} ) or 
	 not $arr{name} or not $arr{score} ){ # Fail!
	print qq{<br><h3>$lex{'Missing Value(s)'}</h3>\n};
	print qq{<form><input type="button" value = "$lex{Back}" };
	print qq{onclick="javascript:history.back()"></form>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Check that Max Score is a number, not text.
    if ( $arr{score} =~ m/\D/ ) { 
	print qq{<p>$lex{'Max Raw Score'} $lex{'must be a number'}</p>\n};
	print qq{</body></html>\n};
	exit;
    }


    if ( $arr{name} eq 'sortorder' ){ # fail
	print qq{<br>You cannot name an item &quot;sortorder&quot;.<br>\n};
	print qq{It has a special use in OA Gradebook.<br>\n};
	print qq{<form><input type="button" value = "Back!" };
	print qq{onclick="javascript:history.back()"></form>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Check for a duplicate name
    $sth = $dbh->prepare("select count(*) from gbtest where subjsec = ? and name = ? ");
    $sth->execute( $arr{subjsec}, $arr{name});
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    my $count = $sth->fetchrow;
    if ($count > 0) { # already have this name....
	print qq{<h3>$arr{name} $lex{Exists}</h3>\n};

	print qq{<form><input type="button" value = "Back!" };
	print qq{onclick="javascript:history.back()"></form>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Replace any double quotes in description with a single quote
    my $val = $arr{description};
    $val =~ s/"/\'/g;
    $arr{description} = $val;

    
    # Set group to newgrp; update the markscheme field.
    if ( $arr{newgrp} ) {  # we have a new group in mark scheme field
	$arr{grp} = $arr{newgrp};
	$newgroupflag = 1;

	# Update the markscheme field, possibly
	$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;
	$markscheme =~ s/\n$|\s+$|^\s+//; # Strip leading/trailing CR/spaces.
#	print "<div>Current Markscheme:$markscheme|</div>\n";

	
	my $prefix; # a CR to make it a new line if we have an existing markscheme
	if ( $markscheme ) { $prefix = qq{\n}; }

	if ( not $arr{newpercent} ) {
	    print qq{<div>No Group Weight - Skipping Group</div>\n};
	    # $arr{newpercent} = '0'; }
	    
	} else { # we have a percent 
	    $markscheme .= "$prefix$arr{newgrp}=$arr{newpercent}";
#	    print "<div>Updated Markscheme:$markscheme|</div>\n";

	    
	    $sth = $dbh->prepare("update subject set markscheme = ? where subjsec = ?");
	    $sth->execute( $markscheme, $subjsec );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	}
	
    }
    # Once to this point, we should have: $weight and $arr{grp} defined.


    # Strip colons from name since used as field separator in scripts.
    $arr{name} =~ s/://g;

    if ( not $weight ) { undef $weight; }
    # insert the assessment item record.
    $sth = $dbh->prepare("insert into gbtest 
      ( subjsec, name, description, tdate, score, weight, grp )
        values ( ?, ?, ?, ?, ?, ?, ? )");

    $sth->execute( $arr{subjsec}, $arr{name}, $arr{description}, 
		   $arr{tdate}, $arr{score},$weight, $arr{grp} );


    my $id; # id of test
    if ( not $DBI::errstr ) { 
	# Find the ID number of the test to make link for score entries.
	$sth = $dbh->prepare("select id from gbtest where subjsec = ? and name = ?");
	$sth->execute( $arr{subjsec}, $arr{name} );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
	$id = $sth->fetchrow;

	print qq{<h3>$lex{'Record(s) Stored'}</h3></p>\n};  
	if ( $newgroupflag ){ print qq{<p>$lex{'New Group'} $lex{Added}</p>\n};}

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

    }

    print qq{<p>[ <a href="scoreAdd.pl?id=$id">$lex{'Add Scores'}</a> |\n};
    print qq{ <a href="testadd.pl">$lex{Add} $lex{Item}</a> |\n};
    print qq{ <a href="gbmain.pl">$lex{'GB Main'}</a> |\n};
    print qq{ <a href="$tchpage">$lex{Main}</a> ]\n};
    print qq{</body></html>\n};

    exit;

}



#------------------
sub getGroupPercent {
#------------------

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

    my %group;
    # Load the markscheme field
    $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 @fields = split (/[\n|\r]/, $markscheme);
    foreach my $fld ( @fields ) { 
	if ( defined $fld ) {
	    my ($grp, $percent) = split '=', $fld;
	    $group{$grp} = $percent;
	}
    }

    print qq{<h3>$lex{'New Group Weight'}</h3>\n};

    # Print Start of Form.
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="flag" value="2">\n\n};

    # convert double quotes into single quotes
    foreach my $key ( keys %arr ) {
	my $val = $arr{$key};
	$val =~ s/"/\'/g;
	print qq{<input type="hidden" name="$key" value="$val">\n};
    }

    # Filter the newgrp value to remove leading and trailing spaces.
    if ( $arr{newgrp} ) {
	my $val = $arr{newgrp};
	$val =~ s/^\s+|\s+$//g;
	$arr{newgrp} = $val;
    }

#    print qq{<div>New Group: |$arr{newgrp}|</div>\n};
    
#    print qq{<input type="hidden" name="subjsec" value="$subjsec">\n};    
#    print qq{<input type="hidden" name="name" value="$arr{name}">\n};
#    print qq{<input type="hidden" name="score" value="$arr{score}">\n};
#    print qq{<input type="hidden" name="description" value="$arr{description}">\n};
#    print qq{<input type="hidden" name="grp" value="$arr{grp}">\n};
#    print qq{<input type="hidden" name="newgrp" value="$arr{newgrp}">\n};
#    print qq{<input type="hidden" name="tdate" value="$arr{tdate}">\n};
#    print qq{<input type="hidden" name="multiplier" value="$arr{multiplier}">\n};

    # Weight is passed, since mode without multiplier allows this. Leave for now
    print qq{\n<input type="hidden" name="weight" value="$arr{weight}">\n};

    # Now put in table.
    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};

    # display existing groups and percent weight.
    my $totalpercent;
    foreach my $grp ( sort keys %group) {
	print qq{<tr><th class="bra"><b>$grp</b></th><td>$group{$grp}%</td></tr>\n};
	$totalpercent += $group{$grp};
    }

    # print total line
    print qq{<tr style="background-color:#DDD;">};
    print qq{<td class="bra">$lex{Total}</td>\n};
    print qq{<td>$totalpercent%</td></tr>\n};

    print qq{<tr><th class="bra"><b>$arr{newgrp}</b></td>\n};
    print qq{<td><input type="text" name="newpercent" size="4">%</td></tr>\n};
    print qq{<tr><td colspan="2" class="cn"><input type="submit" };
    print qq{value="$lex{'Continue'}"></td></tr>\n};
    print qq{</table></form></body></html>\n};

    exit;

}
