#!/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. # Globals: useMultipliers, defaultItemWeight my %lex = ('Add Assessment Item' => 'Add Assessment Item', 'Main' => 'Main', 'GB Main' => 'GB Main', 'No colons(:) please' => 'No colons(:) please', 'Subject-Section' => 'Subject-Section', 'Save Assessment Item' => 'Save Assessment Item', 'Name' => 'Name', 'Description' => 'Description', 'Max Raw Score' => 'Max Raw Score', 'Date' => 'Date', 'Select
Group
and Weight' => 'Select
Group
and Weight', 'Sel' => 'Sel', 'Weight' => 'Weight', 'Group' => 'Group', 'Items' => 'Items', 'New Group' => 'New Group', 'A colon (:) is used to separate group and subgroup. Do not use a colon' => 'A colon (:) is used to separate group and subgroup. Do not use a colon', 'in the group name unless you mean to create a group with subgroups' => 'in the group name unless you mean to create a group with subgroups', 'No group chosen or defined' => 'No group chosen or defined', 'You must make sure that you fill in the group, name, and' => 'You must make sure that you fill in the group, name, and', 'the maximum score value. Please go back and try again' => 'the maximum score value. Please go back and try again', 'Back' => 'Back', 'Missing field values' => 'Missing field values', 'Add Scores' => 'Add Scores', 'Add Another Item' => 'Add Another Item', 'Save Assessment Item' => 'Save Assessment Item', 'or' => 'or', 'Simple Form Entry' => 'Simple Form Entry', 'Description' => 'Description', 'Select Grp/New Wt' => 'Select Grp/New Wt', 'New Grp/New Wt' => 'New Grp/New Wt', 'No weight defined' => 'No weight defined', 'Your new group was added' => 'Your new group was added', 'The assessment item is now stored in the database' => 'The assessment item is now stored in the database', 'New Group Weight' => 'New Group Weight', 'Continue' => 'Continue', 'Total' => 'Total', 'Error' => 'Error', 'Please Log In' => 'Please Log In', ); my $self = 'testadd.pl'; use DBI; use CGI; use CGI::Session; #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}. " $@
\n"; die $lex{Error}. " $@
\n"; } eval require "../../etc/gbook.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@
\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; print "

". $lex{'Please Log in'}. "!

\n"; die; } my $subjsec = $session->param('subjsec'); print $q->header; my %arr = $q->Vars; # Print Page Header print "$doctype\n". $lex{'Add Assessment Item'}. " $chartype\n\n"; print "
[ ". $lex{Main}; print " | ". $lex{'GB Main'}. " ]

". $lex{'Add Assessment Item'}. "

\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 groups and put in %group 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; } # 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; } } # Lookup 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 Start of Form. print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n\n"; print "\n"; if ( $useMultipliers ) { # found in gbook.conf print "\n"; } else { print "\n"; } print "\n"; print "\n"; print "
". $lex{'Subject-Section'}; print "$description ($subjsec)
". $lex{Name}; print "\n"; print $lex{'No colons(:) please'}. ".
". $lex{Description}; print ""; print "
". $lex{Date}; print ""; print "
". $lex{'Max Raw Score'}; print "
". $lex{'Weight'}. "
Group '. $lex{or}. ' '. $lex{'New Group'}; print "
\n"; print $lex{'A colon (:) is used to separate group and subgroup. Do not use a colon'}. "
\n"; print $lex{'in the group name unless you mean to create a group with subgroups'}; print "
"; print ""; print "
\n"; print "\n"; exit; } # end of showStartPage #------------ sub addRecord { #------------ foreach my $key ( keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $subjsec = $arr{subjsec}; # since this is quoted later; needed for link # either weight or multiplier passed, not both. Depends on mode set. my $weight = $arr{weight}; # only if no multiplier method if ( $arr{multiplier} ) { $arr{multiplier} =~ s/\(.*\)//; # strip stuff in brackets. $arr{multiplier} =~ s/\s//g; # strip any spaces my $multiplier = $wtmult{$arr{multiplier}}; $weight = $defaultItemWeight * $multiplier; #print "MULT: $multiplier WT: $weight
\n"; } # $weight is now set... # Set group to newgrp; update the markscheme field. if ( $arr{newgrp} ) { $arr{grp} = $arr{newgrp}; $newgroupflag = 1; # Update 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; if ( not $arr{newpercent} ) { $arr{newpercent} = '0'; } $markscheme .= "\n$arr{newgrp}=$arr{newpercent}"; $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. # check for missing fields. if ( not $arr{grp} or not $arr{name} or not $arr{score} ){ # Fail! print "

"; print $lex{'You must make sure that you fill in the group, name, and'}. "
"; print $lex{'the maximum score value. Please go back and try again'}. ".

\n"; print "
\n"; print "\n"; die $lex{'Missing field values'}; } # Check if group has no colon, but subgroups exist... not allowed # A Top level container group (ie. Term1) CANNOT be used if there # are several subgroups: Term1:test, Term1:assignment $sth = $dbh->prepare("select count(*) from gbtest where grp $sql{like} ?"); my $likegrp = "$arr{grp}:%"; $sth->execute( $likegrp ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $count = $sth->fetchrow; if ($count > 0){ print "
Subgroups of type $arr{grp}:xxxx exist.
\n"; print "You cannot have a top level group like this.
\n"; print "
\n"; print "\n"; die "Top level group with subgroup not allowed.\n"; } if ( $arr{name} eq 'sortorder' ){ # fail print "
You cannot name an item "sortorder".
\n"; print "It has a special use in OA Gradebook.
\n"; print "
\n"; print "\n"; die "sortorder names not allowed.\n"; } # 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 "
The item name $arr{name} is already used.
\n"; print "Please select another name.
\n"; print "
\n"; print "\n"; die "Duplicate name for assessment item.\n"; } # Strip colons from name since used as field separator in scripts. $arr{name} =~ s/://g; # quote all fields, except name and subjsec ( since need to find id next ) $arr{description} = $dbh->quote( $arr{description} ); $arr{tdate} = $dbh->quote( $arr{tdate} ); $arr{score} = $dbh->quote( $arr{score} ); $arr{grp} = $dbh->quote( $arr{grp} ); # insert the assessment item record. $sth = $dbh->prepare("insert into gbtest values ( $sql{default}, ?, ?, $arr{description}, $arr{tdate}, $arr{score},$sql{default}, ?, $arr{grp} )"); $sth->execute( $arr{subjsec}, $arr{name}, $weight ); 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 '

'. $lex{'The assessment item is now stored in the database'}. ".

\n"; if ($newgroupflag){ print '

'. $lex{'Your new group was added'}. ".

\n";} } else { print '

'. $lex{'There was an error storing your data'}; print "\n Contact $adminname at "; print "$adminemail Please record the following error string.\n"; print "

The DBI error string is: $DBI::errstr

"; } print "

[ ". $lex{'Add Scores'}. " |\n"; print " ". $lex{'Add Another Item'}. " |\n"; print " ". $lex{'GB Main'}. " |\n"; print " ". $lex{Main}. " ]\n"; print "

\n"; exit; } #------------------ sub getGroupPercent { #------------------ 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 ( $fld ) { my ($grp, $percent) = split /=/, $fld; $group{$grp} = $percent; } } print "

". $lex{'New Group Weight'}. "

\n"; # Print Start of Form. print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; # Now put in table. print "\n"; # display existing groups and percent weight. my $totalpercent; foreach my $grp ( sort keys %group) { print "\n"; $totalpercent += $group{$grp}; } # print total line print "\n"; print "\n"; print "\n"; print "\n"; print "
$grp$group{$grp}%
". $lex{Total}; print "$totalpercent%
$arr{newgrp}%
\n"; exit; }