#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # Edit a test/assessment item record. my %lex = ('Edit Assessment Item' => 'Edit Assessment Item', 'Main' => 'Main', 'GB Main' => 'GB Main', 'Your item MUST have a group and a score!' => 'Your item MUST have a group and a score!', 'There was an error storing your data' => 'There was an error storing your data', 'or New Group' => 'or New Group', 'Update Assessment Item' => 'Update Assessment Item', 'The test/assessment is now stored' => 'The test/assessment is now stored', 'Your new group was added' => 'Your new group was added', 'Name' => 'Name', 'Description' => 'Description', 'Date' => 'Date', 'Max Raw Score' => 'Max Raw Score', 'Weight' => 'Weight', 'Group' => 'Group', 'The default weight is' => 'The default weight is', 'Error' => 'Error', 'Please Log In' => 'Please Log In', 'must be a number' => 'must be a number', ); use DBI; use CGI; use CGI::Session; use Number::Format qw{round}; my $self = 'gbTestEdit.pl'; # 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); my $subjsec = $session->param('subjsec'); print $q->header( -charset, $charset ); my %arr = $q->Vars; my $testid = $arr{id}; my $title = $lex{'Edit Assessment Item'}; print qq{$doctype\n$title\n}; print qq{$chartype\n}; print qq{\n}; print qq{[ $lex{Main} |\n}; print qq{$lex{'GB Main'} ]\n}; if ( not $logged_in ){ print qq{

$lex{'Please Log In'}

\n}; print qq{\n}; exit; } if ( not $arr{page} ) { # load jQuery date picker print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } # Load the different groups, using %group hash my %group; $sth = $dbh->prepare("select distinct grp from gbtest where grp != '' and grp is not null and subjsec = ?"); $sth->execute($subjsec); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while (my $grp = $sth->fetchrow){ if ($grp){ $group{$grp} = 1;} } # Load the markscheme field from the subject $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; } } $sth = $dbh->prepare("select description from subject where subjsec = ?"); $sth->execute( $subjsec ); if ($DBI::errstr){ print $DBI::errstr; exit; } my $subject = $sth->fetchrow; print qq{

$title - $subject ($subjsec)

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 and $arr{multiplier} eq 'Custom' ) { addCustomWeight(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; updateRecord(); } #------------------ sub addCustomWeight { #------------------ # print qq{
SUB: addCustomWeight
\n}; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # form. print qq{
\n}; # print qq{\n}; # print qq{\n}; # print qq{\n}; foreach my $key ( sort keys %arr ) { if ( $key eq 'multiplier' ) { next; } # skip multiplier; not passed on. print qq{\n}; } print qq{
Test Weight $defaultItemWeight = 1x weight
\n}; print qq{
\n}; print qq{
\n}; exit; } #---------------- sub showStartPage { #---------------- # build a hash to map a weight number -> multiplier value (ie. 500 -> 5, 750 -> 6) my %weightToMult; foreach my $key (keys %wtmult) { # %wtmult from gbook.conf file my $value = round( $wtmult{$key} * $defaultItemWeight, 0); $weightToMult{$value} = $key; } #foreach my $key (keys %weightToMult) { print "K:$key V:$weightToMult{$key}
\n"; } # Get the test info.... my $sth = $dbh->prepare("select subjsec, name, description, tdate, score, weight, grp from gbtest where id = ?"); $sth->execute( $testid ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ( $subjsec, $name, $desc, $tdate, $score, $weight, $grp) = $sth->fetchrow; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Table print qq{\n}; # Name print qq{\n}; print qq{\n}; # Description print qq{\n}; print qq{\n}; # Date Entry print qq{\n}; print qq{\n}; print qq{\n}; # Weight print qq{\n};; if ( $useMultipliers ) { # found in etc/gbook.conf; we have a $weight value my $key = $weightToMult{$weight}; # key will be a number 1-9; an index. print qq{\n}; } else { print qq{\n}; } # Group print qq{}; print qq{\n}; # Update print qq{\n}; print qq{
$lex{Name}\n}; print qq{ ex.Asn11, T13,HW23;keep short,max 6 characters;letters and numbers only
$lex{Description}}; print qq{
$lex{Date}}; print qq{\n}; # Max Raw Score print qq{
$lex{'Max Raw Score'}}; print qq{ Use Integers to keep score entry simple; Use natural score total, not 100
$lex{Weight} Normally leave at 1x (1 times) weight
}; print qq{$lex{'The default weight is'} $defaultItemWeight}; print qq{
$lex{Group} $lex{'or New Group'} }; print qq{ }; print qq{ (ex Term1,Exam1,T1HW,T1Test)
\n}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; } #--------------- sub updateRecord { # write the updated record. #--------------- # print qq{
SUB updateRecord
\n}; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $id = $arr{id}; delete $arr{id}; if ($arr{newgrp}){ # Update the grouping $newgroupflag = 1; $arr{grp} = $arr{newgrp}; delete $arr{newgrp}; } # weight or multiplier both will be raw values (ie. 500, etc) if ( $arr{multiplier} and not $arr{weight} ) { $arr{weight} = $arr{multiplier}; delete $arr{multiplier}; } # $weight is now set... # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Remove any double quotes replacing with single quote, since they can cause problems. my $val = $arr{description}; $val =~ s/"/'/g; $arr{description} = $val; if ( not $arr{grp} or not $arr{score} ) { print qq{

$lex{'Your item MUST have a group and a score!'}\n}; print qq{

\n}; exit; } # Check that Max Score is a number, not text. if ( $arr{score} =~ m/\D/ ) { print qq{

$lex{'Max Raw Score'} $lex{'must be a number'}

\n}; print qq{\n}; exit; } my $sth = $dbh->prepare("update gbtest set name = ?, description = ?, tdate = ?, score = ?, weight = ?, grp = ? where id = ? "); $sth->execute($arr{name}, $arr{description}, $arr{tdate}, $arr{score}, $arr{weight}, $arr{grp}, $id); if ( not $DBI::errstr ) { print qq{

$lex{'The test/assessment is now stored'}

\n}; if ($newgroupflag){ print qq{
$lex{'Your new group was added'}
\n}; } } else { print qq{

$lex{'There was an error storing your data'} }; print qq{ $DBI::errstr

\n}; } print qq{

[ $lex{'GB Main'} ]

\n}; print qq{\n}; exit; } # End of updateRecs