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

#  This file is part of Open Admin for Schools.

# compress.pl - compress / delete assessment items into a single item
# (or zero items in the case of delete)

my %lex = ('Compress' => 'Compress',
	   'Delete' => 'Delete',
	   'Delete/Compress' => 'Delete/Compress',
	   'GB Main' => 'GB Main',
	   'Main' => 'Main',
	   'Error' => 'Error',
	   'Assessments' => 'Assessments',
	   'Select all items?' => 'Select all items?',
	   'Sort by' => 'Sort by',
	   'Please select items to compress.' => 'Please select items to compress.',
	   'Please enter values for new target item.' => 
	     'Please enter values for new target item.',
	   'Name' => 'Name',
	   'Description' => 'Description',
	   'Date' => 'Date',
	   'No colons(:) please' => 'No colons(:) please',
	   'Group' => 'Group',
	   'or New Group' => 'or New Group',
	   'Name required to add a new item. Dying.' => 'Name required to add a new item. Dying.',
	   'No Maximum Score for Test' => 'No Maximum Score for Test',
	   'Item with this name exists. Please try again.' => 
	     'Item with this name exists. Please try again.',
	   'Please Log In' => 'Please Log In',
	   'No Record(s) Found' => 'No Record(s) Found',

	   );

my $self = 'compress.pl';

%sortorder = ('Date' => 'tdate',
	      'Name' => 'name',
	      'Group' => 'grp,tdate'
	      );

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

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

my $q = new CGI;

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

my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw",
 undef,{Handle => $dbh}) or die CGI::Session->errstr;

my $userid = $session->param('userid');
my $logged_in = $session->param(logged_in);
if (not $logged_in){
    print $q->header( -charset, $charset );
    print $lex{'Please Log In'}. "<br>\n";
    exit;
}
my $subjsec = $session->param('subjsec');
my $userid = $session->param('userid');

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


# Now setup page header
my $title = qq{$lex{'Delete/Compress'} $lex{Assessments}};
print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$tchcss" type="text/css">$chartype\n};
print qq{</head><body>\n};

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

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


# Check for an action value
if ( $arr{action} eq $lex{Compress} ) { # do compression...
    doCompress( $arr{subjsec}, $arr{sortorder}, $arr{selectall} );
    exit;

} elsif ($arr{action} eq $lex{Delete}) { # do deletion...
    doDelete($arr{subjsec},$arr{sortorder},$arr{selectall});

} elsif ($arr{deleterecords}) {
    delete $arr{deleterecords}; # remove the flag value, leave id's.
    deleteRecords(\%arr);

} elsif ($arr{compressrecords}) {
    delete $arr{compressrecords}; # remove the flag value, leave id's.
    compressRecords(\%arr);
}

print qq{<div>Please select a subject to remove / compress items from:</div>\n};
print qq{<form action="$self" method="post">\n};
print qq{<table cellpadding="3" cellspacing="0" border="0">\n};


# Get Teacher's subjects
$sth = $dbh->prepare("select smdesc, description, subjsec from subject 
		     where teacher = ? order by description");
$sth->execute($userid);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my ( $name,$description,$subjsec ) = $sth->fetchrow) {
    print qq{<tr><td><input type="radio" name="subjsec" value="$subjsec"></td>\n};
    print qq{<td>$name - $description ($subjsec)</td></tr>\n};
}
print qq{</table>\n};


print qq{<p><b>$lex{'Select all items?'}</b>};
print qq{<input type="checkbox" name="selectall" value="1"></p>\n};


print qq{<p><b>$lex{'Sort by'}:</b>\n};
print qq{<select name="sortorder">\n};
foreach my $so (sort keys %sortorder) {
    print qq{<option>$so</option>};
}
print qq{</select></p>\n};

print qq{<p><input type="submit" name="action"  value="$lex{Delete}">\n};
print qq{<input type="submit" name="action"  value="$lex{Compress}"></p>\n};

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


#======== Functions ================

#-----------
sub doDelete {  # Delete selected items of this subject...
#-----------

    my ($subjsec,$sortkey,$selectall) = @_;
    my $checked;
    if ($selectall) { $checked = 'CHECKED'; }

    # Find the items in the correct order.
    my $sortorder = "order by $sortorder{$sortkey}";

    my $sth = $dbh->prepare("select id, name, description, tdate, grp from gbtest
			    where subjsec = ? $sortorder");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
    my $count = $sth->rows;
    if ($count < 1){
	print qq{<h3>$lex{'No Record(s) Found'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    print qq{<div>Please select items to remove. Scores will also be deleted.</div>\n};
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="deleterecords" value="1">\n};
    
    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};

    while (my ($id, $name, $description,$tdate,$grp) = $sth->fetchrow) {
	print qq{<tr><td><input type="checkbox" name="$id" value="1" $checked></td>\n};
	print qq{<td>$name - $description</td><td>$tdate</td><td>$grp</td></tr>\n};
    }
    print qq{</table>\n};
    print qq{<input type="submit" value="$lex{Delete} $lex{Assessments}">\n};
    print qq{</form>};
    print qq{</body></html>\n};

    exit;

} # End of doDelete


#----------------
sub deleteRecords {  # Do the actual record deletion.
#----------------
    # Passed a list of test item id's, delete the item and all scores for the item.
    my $hash_ref = shift;
    my %items = %{$hash_ref};

    my $count;
    foreach my $id (keys %items) {
	#print qq{K:$id V:$items{$id}<br>\n};
	my $result = $dbh->do("delete from gbtest where id = '$id'");
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
	my $result = $dbh->do("delete from gbscore where testid = '$id'");
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
	$count++;
    }

    print qq{$count Item(s) deleted.<br>\n};
    print qq{[ <a href="$self">$lex{'Delete/Compress'} $lex{Assessments}</a> ]\n};
    print qq{</body></html>\n};

    exit;

} # End of deleteRecords


#-------------
sub doCompress { 
#-------------
    
    my ($subjsec,$sortkey,$selectall) = @_;
    my $checked;
    if ($selectall) { $checked = 'CHECKED'; }

    my @group;
    my $sth = $dbh->prepare("select distinct grp from gbtest
			    where subjsec = ? and grp != ''");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
    while ( my $grp = $sth->fetchrow) {
	push @group, $grp;
    }
        

    # Find the items in the correct order.
    my $sortorder = "order by $sortorder{$sortkey}";

    $sth = $dbh->prepare("select id, name, description, tdate, grp from gbtest
			 where subjsec = ? $sortorder");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
    my $count = $sth->rows;
    if ($count < 1){
	print qq{<h3>$lex{'No Record(s) Found'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    print qq{<p>$lex{'Please select items to compress.'}</p>\n};
    
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="compressrecords" value="1">\n};
    print qq{<input type="hidden" name="subjsec" value="$subjsec">\n};
    print qq{<table cellpadding="3" cellspacing="0" border="1" style="background-color:#DFD;">\n};

    while (my ($id, $name, $description,$tdate,$grp) = $sth->fetchrow) {
	print qq{<tr><td><input type="checkbox" name="$id" value="1" $checked></td>\n};
	print qq{<td>$name - $description</td><td>$tdate</td><td>$grp</td></tr>\n};
    }
    print qq{</table>\n};

    print qq{<p><b>$lex{'Please enter values for new target item.'}</b></p>\n};
    print qq{<table cellpadding="3" cellspacing="0" border="1" style="background-color:#DFD;">\n};
    print qq{<tr><td class="ra">$lex{Name}</td>};
    print qq{<td><input type="text" name="name" style="width:10ch;" maxlength="32"> };
    print qq{$lex{'No colons(:) please'}</td></tr>\n};

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

    print qq{<tr><td class="ra">$lex{Date}</td>};
    print qq{<td><input type="text" name="tdate" style="width:12ch;" value="$currdate"></td></tr>\n};

    print qq{<tr><td class="ra">$lex{Group}</td>};

    print qq{<td><select name="grp">};
    foreach my $gp (@group){
	print qq{<option>$gp</option>\n};
    }
    print qq{</select>\n};
    print qq{$lex{'or New Group'} <input type="text" name="newgrp" style="width:16ch;" };
    print qq{maxlength="64"></td></tr>\n};
    
    print qq{</table>\n};

    print qq{<input type="submit" value="$lex{Compress} $lex{Assessments}">\n};
    print qq{</form>};

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

    exit;

}


#------------------
sub compressRecords {  # Do the actual record compressions 
#------------------

    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }
    
    # Extract 5 values to use for the new item.
    my $description = $arr{description};
    delete $arr{description};

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

    my $name = $arr{name};
    delete $arr{name};
    if ( not $name) {
	print qq{<div> $lex{'Name required to add a new item. Dying.'}</div>\n};
	print qq{</body></html>\n};
	exit;
    }

    my $tdate = $arr{tdate};
    delete $arr{tdate};
    
    my $grp = $arr{grp};
    delete $arr{grp};

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

    my $group; # for insertion.
    if ($newgrp) { # IF we have a new group, that overrides.
	$group = $newgrp;
    } else { 
	$group = $grp; 
    }

    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }
    # only key values left for the assessments to compress.
    
    
    my ($totalweight, $totalmaxscore);
    # Get all tests and load their max scores and weights
    foreach my $id (keys %arr) {
	my $sth = $dbh->prepare("select weight,score from gbtest where id = ?");
	$sth->execute( $id );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}
	my ($wt,$score) = $sth->fetchrow;
	#print qq{ID: $id SCORE: $score  W: $wt V: $arr{$id}<br>\n};

	$weight{$id} = $wt;
	$totalweight += $wt;

	$maxscore{$id} = $score;
	$totalmaxscore += $score;
    }

    #print qq{TS: $totalmaxscore  TW: $totalweight <br>\n};

    # create the new assessment item and get it's new id. It will use the TW and TS above.
    # Check for presence of that 'name' for the item...
    #$arr{$key} =~ s/'/''/g;

    
    # Check for an existing item with this name in this subject.
    my $sth = $dbh->prepare("select count(*) from gbtest where subjsec = ? and name = ?");
    $sth->execute( $subjsec, $name );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    my $count = $sth->fetchrow;
    if ($count) {
	print qq{<p><b>$lex{'Item with this name exists. Please try again.'}</b></p>\n};
	print qq{</body></html>\n};
	exit;
    }

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

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

    # add to the %group hash above; removing duplicates effectively.
    my @fields = split (/[\n|\r]/, $markscheme);
    foreach my $fld (@fields) { 
	if ($fld) {
	    my ($grp, $percent) = split '=', $fld;
	    $group{$grp} = $percent;
	}
    }


    # Add the group into markscheme if it doesn't exist there.
    if ( not $group{$group} ) { 
	$markscheme .= "\n$group=0";
	$sth = $dbh->prepare("update subject set markscheme = ? where subjsec = ?");
	$sth->execute( $markscheme, $subjsec );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    }

    
    my $sth = $dbh->prepare("insert into gbtest ( subjsec,name,description,tdate,score,weight,grp )
			    values ('$subjsec','$name',? ,'$tdate','$totalmaxscore','$totalweight', ?)
			    ");
    $sth->execute( $description, $group );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }    
    print qq{<h3>GB Test Inserted - $name / $tdate / $totalmaxscore</h3>\n};

    
    
    # Now get the ID for that new record...
    my $sth = $dbh->prepare("select id from gbtest where name = ? and subjsec = ?");
    $sth->execute( $name, $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }    
    my $newid = $sth->fetchrow;
    if ( not $newid ) {
	print qq{<h3>Unable to find new item id. Contact Technical support</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
    #print qq{The New Item ID is: $newid<br>\n};


    # next get the kids (from eval) and loop through putting in records
    $sth = $dbh->prepare("select distinct studnum from eval where subjcode = ? and studnum != ''");
    $sth->execute( $subjsec );
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    
    $sth1 = $dbh->prepare("select score from gbscore where studnum = ? and testid = ? ");

    # loop through each student and create their new score records.    
    while (my $studnum = $sth->fetchrow) {

	my ($localtotalweight, $localtotalscore);

	# First read in their score (if any) for each item to be compressed.
	foreach my $testid (keys %arr) {

	    # Get a score...
	    $sth1->execute($studnum,$testid);
	    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	    my $score = $sth1->fetchrow;

	    if ($score eq $specchar or $score eq '' or not defined $score) {  #skip this score
		next; 
	    }

	    if ( not $maxscore{$testid} ) { #check for any problems with this...
		print qq{$lex{'No Maximum Score for Test'}: $testid<br>\n};
		next;
	    }

	    if ($score =~ /\d/) { # if score is a digit... do it.
		$localtotalweight += $weight{$testid};
		$localtotalscore += ($weight{$testid} * $score / $maxscore{$testid});
		
	    } else { 
		# some sort of text score...count as zero... update total weight.
		$localtotalweight += $weight{$testid};
	    }
	    #print qq{SC: $score  WT:$weight{$testid} MAX: $maxscore{$testid}<br>\n};
	} # End of tests loop

	#print qq{SN: $studnum W:$localtotalweight SC:$localtotalscore<br>\n};
	if ($localtotalweight){
	    $score = $localtotalscore * $totalmaxscore / $localtotalweight;
	} else {
	    $score = 0;
	}
	$score = round( $score, 1);
	#NOTE: 1 decimal rounding should give sufficient accuracy. Change if required.
	
	#print qq{<br>Score: $score  Max: $totalmaxscore<br>\n};

	# Write the record with the updated score.
	my $sth2 = $dbh->prepare("insert into gbscore (studnum,testid,score,comment )
				 values ('$studnum','$newid',?,?)");
	$sth2->execute( $score, $comment );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }

    }

    print qq{<h3>Student Scores Added for New Item</h3>\n};

    
    # delete the existing records for each 'old' item...
    foreach my $id (keys %arr ) {
	#print qq{K:$id V:$arr{$id}<br>\n};
	my $result = $dbh->do("delete from gbtest where id = '$id'");
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	my $result = $dbh->do("delete from gbscore where testid = '$id'");
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
    }
    print qq{<h3>Previous Items and Scores Removed</h3>\n};

    
    print qq{[ <a href="$self">$lex{'Delete/Compress'} $lex{Assessments}</a> ]\n};
    print qq{</body></html>\n};

    exit;

} # End of compressRecords
