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

#  This file is part of Open Admin for Schools.

# weightgrp.pl - script to adjust test weighting by group percent
# vars showWeights - from gbook.conf

my %lex = ( 'Adjust Group Weights' => 'Adjust Group Weights',
	    'GB Main' => 'GB Main',
	    'Weight by Item' => 'Weight by Item',
	    'Group' => 'Group',
	    'Weight' => 'Weight',
	    'Items' => 'Items',
	    'Update Weights' => 'Update Weights',
	    'Total Weight' => 'Total Weight',
	    'Please Log In' => 'Please Log In',
	    'Error' => 'Error',
	    'No Course' => 'No Course',

	   );

# Number of blank group entries to allow
my $maxEntries = 6;

my $self = 'weightgrp.pl';

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

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

delete $arr{subjsec}; # no longer needed; session based.

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

print $q->header( -charset, $charset );

my $logged_in = $session->param(logged_in);
if ( not $logged_in ) {
    print qq{[ <a href="gbmain.pl">$lex{'GB Main'}</a> ]\n};
    print qq{<h3>$lex{'Please Log In'}</h3>\n};
    print qq{</body></html>\n};
    exit;
}

my $subjsec = $session->param('subjsec');

# Get Subject Description
$sth = $dbh->prepare("select description from subject where subjsec = ?");
$sth->execute($subjsec);
if ($DBI::errstr){ print $DBI::errstr; die "$DBI::errstr:$!\n";}
my $course = $sth->fetchrow;


# Print Document Head
my $title = qq{$lex{'Adjust Group Weights'} - $course};
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>\n};
print qq{[ <a href="gbmain.pl">$lex{'GB Main'}</a> | \n};
print qq{<a href="weightadj.pl">$lex{'Weight by Item'}</a> ]\n};
print qq{<h1>$title</h1>\n};


if ( $arr{writeflag} )  {
    delete $arr{writeflag};
    writeWeights($subjsec);
}


# Load the assessment groups
my %groups;
$sth = $dbh->prepare("select distinct grp from gbtest where subjsec = ? order by grp desc");
$sth->execute( $subjsec );
if ( $DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $grp = $sth->fetchrow ) {
    $groups{$grp} = '0';
}


# Load the markscheme field; possibly updated.
$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;
# Strip trailing/leading CR/spaces
$markscheme =~ s/\n$|\s+$|^\s+//; 
# print qq{<div>Mark Scheme:$markscheme|</div>\n};


# put in %groups percent weights from values in markscheme.
my @fields = split (/[\n|\r]/, $markscheme);
foreach my $fld ( @fields ) {
    if ( $fld ) {
#	print qq{F:$fld<br>\n};
	my ($grp, $percent) = split '=', $fld;
	$grp =~ s/^\s+//; # strip leading, trailing spaces from group name
	$grp =~ s/\s+$//;
	$groups{$grp} = $percent; 
    }
}

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

print qq{<table cellpadding="3" border="1" cellspacing="0">\n};
print qq{<tr><th>$lex{Group}</th><th>$lex{Items}</th>};
print qq{<th>$lex{Weight}</th></tr>\n};

my $grpcolor = -1;
my $totalweight;

my $sth = $dbh->prepare("select count(*) from gbtest where grp = ? and subjsec = ?");

foreach my $grp ( sort keys %groups) { 

    $sth->execute($grp, $subjsec);
    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
    my $count = $sth->fetchrow;

    # Remove this group is no assessment items and not percentage weight;
    if ( not $count and not $groups{$grp} ) { # remove the group
	print qq{<div>Removing $grp</div>\n};
	delete $groups{$grp};
	next;
    }
    
    $grpcolor++;

    print qq{<tr style="background-color: $g_color[$grpcolor]; color: black;">};
    print qq{<td>$grp</b></td><td class="cn">$count</td>\n};
    print qq{<td class="cn">};
    print qq{<input type="text" name="$grp" value="$groups{$grp}" style="width:4ch;">};
    print qq{<b>%</b></td></tr>\n};

    $totalweight += $groups{$grp};

}

print qq{<tr style="background-color: #BBB; color: black;">};
print qq{<td class="cn" colspan="2">$lex{'Total Weight'}</td>\n};
print qq{<td class="cn">$totalweight%</td></tr>\n};

print qq{<tr style="background-color: #DDD; color: black;">};
print qq{<td class="cn" colspan="3">};
print qq{<input type="submit" value="$lex{'Update Weights'}"></td></tr>\n};
print qq{</table></form>\n};

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


#---------------
sub writeWeights {
#---------------

    print qq{<div>Sub writeWeights</div>\n};
    foreach my $key ( sort keys %arr ) {
	print qq{K:$key VAL:$arr{$key}<br>\n};
    }

    # $subjsec set at top of script via session variable.
    if ( not $subjsec ) {
	print qq{<h3>$lex{'No Course'}!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    
    my $newscheme;
    foreach my $grp (sort keys %arr){
	print qq{G:$grp V:$arr{$grp}<br>\n};
	if ( not defined $arr{$grp} ) { next; } # skip any blank/zero groups.
	$newscheme .= "$grp=$arr{$grp}\n";
    }

    # strip trailing CRLF
    chomp $newscheme;

    
    # now write it back into the subject markscheme field
    $sth = $dbh->prepare("update subject set markscheme = ? where subjsec = ?");
    $sth->execute($newscheme, $subjsec);
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

    print qq{<h3>Group Weights Updated!</h3>\n};
    
    return;

}
