#!/usr/bin/perl # Copyright 2001-2022 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}. " $@
\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); $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; print $q->header( -charset, $charset ); my $logged_in = $session->param(logged_in); if ( not $logged_in ) { print qq{[ $lex{'GB Main'} ]\n}; print qq{

$lex{'Please Log In'}

\n}; print qq{\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$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{'GB Main'} | \n}; print qq{$lex{'Weight by Item'} ]\n}; print qq{

$title

\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; # 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
\n}; my ($grp, $percent) = split '=', $fld; $grp =~ s/^\s+//; # strip leading trailing spaces from group name $grp =~ s/\s+$//; # if ( $groups{$grp} ) { # only assign weights to groups that exist in gbtest. $groups{$grp} = $percent; # } } } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\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; $grpcolor++; print qq{}; print qq{\n}; print qq{\n}; $totalweight += $groups{$grp}; } print qq{}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{
$lex{Group}$lex{Items}$lex{Weight}
$grp$count}; print qq{}; print qq{%
$lex{'Total Weight'}$totalweight%
}; print qq{
\n}; print qq{\n}; #--------------- sub writeWeights { #--------------- my $subjsec = shift; # passed subject if (not $subjsec) { print qq{

$lex{'No Course'}!

\n}; print qq{\n}; exit; } # foreach my $key (sort keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } # exit; my $newscheme; foreach my $grp (sort keys %arr){ # print qq{G:$grp V:$arr{$grp}
\n}; if ( not $arr{$grp} ) { next; } # skip any blank/zero groups. $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; } print qq{

Group Weights Updated!

\n}; return; }