#!/usr/bin/perl
# Copyright 2001-2008 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.
# weightgrp.pl - script to adjust test weighting by group percent
# vars showWeights - from gbook.conf
my %lex = ( 'Adjust Group Weights' => 'Adjust Group Weights',
'Main' => 'Main',
'GB Main' => 'GB Main',
'Weight by Item' => 'Weight by Item',
'Group' => 'Group',
'Weight' => 'Weight',
'Items' => 'Items',
'Group Weight' => 'Group Weight',
'Update Weights' => 'Update Weights',
'Total Weight' => 'Total Weight',
'Please Log In' => 'Please Log In',
'Add New Groups' => 'Add New Groups',
'Put X in weight to delete' => 'Put X in weight to delete',
'Please Log in' => 'Please Log in',
);
# 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}. " $@ \n";
die $lex{Error}. " $@ \n";
}
eval require "../../etc/gbook.conf";
if ( $@ ) {
print $lex{Error}. " $@ \n";
die $lex{Error}. " $@ \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;
my $logged_in = $session->param(logged_in);
if (not $logged_in){
print $lex{'Please Log in'}. "! \n";
die;
}
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 $subject = $sth->fetchrow;
# Print Document Head
print "$doctype\n". $lex{'Adjust Group Weights'};
print "\n\n";
print "$chartype\n\n";
print "[ ". $lex{'GB Main'}. " | \n";
print "". $lex{'Weight by Item'}. " ]\n";
print "
". $lex{'Adjust Group Weights'}. " - $subject
\n";
#print "
". $lex{'Put X in weight to delete'}. "
\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} = '-1';
}
# 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;
# put in %groups percent weights from values in markscheme.
my @fields = split (/[\n|\r]/, $markscheme);
foreach my $fld ( @fields ) {
if ($fld) {
#print "F:$fld \n";
my ($grp, $percent) = split /=/, $fld;
if ( $groups{$grp} ) { # only assign weights to groups that exist in gbtest.
$groups{$grp} = $percent;
}
}
}
print "\n";
print "
\n";
#---------------
sub writeWeights {
#---------------
my $subjsec = shift; # passed subject
if (not $subjsec) {
print $lex{'Subject not found'}. "! \n";
die $lex{'Subject not found'}. "! \n";
}
#foreach my $key (sort keys %arr) { print "K:$key V:$arr{$key} \n"; }
#die;
my $newscheme;
foreach my $grp (sort keys %arr){
#print "G:$grp V:$arr{$grp} \n";
$newscheme .= "$grp=$arr{$grp}\n";
}
# 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; }
return;
}