#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # compress.pl - compress / delete assessment items into a single item # (or zero items in the case of delete) my %lex = ('Compress' => 'Compress', 'Delete' => 'Delete', 'Delete/Compress' => 'Delete/Compress', 'GB Main' => 'GB Main', 'Main' => 'Main', 'Error' => 'Error', 'Assessments' => 'Assessments', 'Select all items?' => 'Select all items?', 'Sort by' => 'Sort by', 'Please select items to compress.' => 'Please select items to compress.', 'Please enter values for new target item.' => 'Please enter values for new target item.', 'Name' => 'Name', 'Description' => 'Description', 'Date' => 'Date', 'No colons(:) please' => 'No colons(:) please', 'Group' => 'Group', 'or New Group' => 'or New Group', 'Name required to add a new item. Dying.' => 'Name required to add a new item. Dying.', 'No Maximum Score for Test' => 'No Maximum Score for Test', 'Item with this name exists. Please try again.' => 'Item with this name exists. Please try again.', 'Please Log In' => 'Please Log In', 'No Record(s) Found' => 'No Record(s) Found', ); my $self = 'compress.pl'; %sortorder = ('Date' => 'tdate', 'Name' => 'name', 'Group' => 'grp,tdate' ); use DBI; use CGI::Session; use CGI; use Number::Format qw{ round }; # 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"; } my $q = new CGI; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw", undef,{Handle => $dbh}) or die CGI::Session->errstr; my $userid = $session->param('userid'); my $logged_in = $session->param(logged_in); if (not $logged_in){ print $q->header( -charset, $charset ); print $lex{'Please Log In'}. "
\n"; exit; } my $subjsec = $session->param('subjsec'); my $userid = $session->param('userid'); print $q->header( -charset, $charset ); my %arr = $q->Vars; # Now setup page header my $title = qq{$lex{'Delete/Compress'} $lex{Assessments}}; print qq{$doctype\n$title\n}; print qq{$chartype\n}; print qq{\n}; print qq{[ $lex{Main} |\n}; print qq{$lex{'GB Main'} ]\n}; print qq{

$title

\n}; # foreach my $key (keys %arr) { print qq{K: $key V: $arr{$key}
\n}; } # Check for an action value if ( $arr{action} eq $lex{Compress} ) { # do compression... doCompress( $arr{subjsec}, $arr{sortorder}, $arr{selectall} ); exit; } elsif ($arr{action} eq $lex{Delete}) { # do deletion... doDelete($arr{subjsec},$arr{sortorder},$arr{selectall}); } elsif ($arr{deleterecords}) { delete $arr{deleterecords}; # remove the flag value, leave id's. deleteRecords(\%arr); } elsif ($arr{compressrecords}) { delete $arr{compressrecords}; # remove the flag value, leave id's. compressRecords(\%arr); } print qq{

Please select a subject to remove / compress items from:

\n}; print qq{\n}; #======== Functions ================ #----------- sub doDelete { # Delete selected items of this subject... #----------- my ($subjsec,$sortkey,$selectall) = @_; my $checked; if ($selectall) { $checked = 'CHECKED'; } # Find the items in the correct order. my $sortorder = "order by $sortorder{$sortkey}"; my $sth = $dbh->prepare("select id, name, description, tdate, grp from gbtest where subjsec = ? $sortorder"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my $count = $sth->rows; if ($count < 1){ print qq{

$lex{'No Record(s) Found'}

\n}; print qq{\n}; exit; } print qq{

Please select items to remove. Scores will also be deleted.

\n}; print qq{}; print qq{\n}; exit; } # End of doDelete #---------------- sub deleteRecords { # Do the actual record deletion. #---------------- # Passed a list of test item id's, delete the item and all scores for the item. my $hash_ref = shift; my %items = %{$hash_ref}; my $count; foreach my $id (keys %items) { #print qq{K:$id V:$items{$id}
\n}; my $result = $dbh->do("delete from gbtest where id = '$id'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my $result = $dbh->do("delete from gbscore where testid = '$id'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} $count++; } print qq{$count Item(s) deleted.
\n}; print qq{[ $lex{'Delete/Compress'} $lex{Assessments} ]\n}; print qq{\n}; exit; } # End of deleteRecords #------------- sub doCompress { #------------- my ($subjsec,$sortkey,$selectall) = @_; my $checked; if ($selectall) { $checked = 'CHECKED'; } my @group; my $sth = $dbh->prepare("select distinct grp from gbtest where subjsec = ? and grp != ''"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} while ( my $grp = $sth->fetchrow) { push @group, $grp; } # Find the items in the correct order. my $sortorder = "order by $sortorder{$sortkey}"; $sth = $dbh->prepare("select id, name, description, tdate, grp from gbtest where subjsec = ? $sortorder"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my $count = $sth->rows; if ($count < 1){ print qq{

$lex{'No Record(s) Found'}

\n}; print qq{\n}; exit; } print qq{

$lex{'Please select items to compress.'}

\n}; print qq{}; print qq{\n}; exit; } #------------------ sub compressRecords { # Do the actual record compressions #------------------ # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Extract 5 values to use for the new item. my $description = $arr{description}; delete $arr{description}; my $subjsec = $arr{subjsec}; delete $arr{subjsec}; my $name = $arr{name}; delete $arr{name}; if ( not $name) { print qq{

$lex{'Name required to add a new item. Dying.'}

\n}; print qq{\n}; exit; } my $tdate = $arr{tdate}; delete $arr{tdate}; my $grp = $arr{grp}; delete $arr{grp}; my $newgrp = $arr{newgrp}; delete $arr{newgrp}; my $group; # for insertion. if ($newgrp) { # IF we have a new group, that overrides. $group = $newgrp; } else { $group = $grp; } # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # only key values left for the assessments to compress. my ($totalweight, $totalmaxscore); # Get all tests and load their max scores and weights foreach my $id (keys %arr) { my $sth = $dbh->prepare("select weight,score from gbtest where id = ?"); $sth->execute( $id ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my ($wt,$score) = $sth->fetchrow; #print qq{ID: $id SCORE: $score W: $wt V: $arr{$id}
\n}; $weight{$id} = $wt; $totalweight += $wt; $maxscore{$id} = $score; $totalmaxscore += $score; } #print qq{TS: $totalmaxscore TW: $totalweight
\n}; # create the new assessment item and get it's new id. It will use the TW and TS above. # Check for presence of that 'name' for the item... #$arr{$key} =~ s/'/''/g; # Check for an existing item with this name in this subject. my $sth = $dbh->prepare("select count(*) from gbtest where subjsec = ? and name = ?"); $sth->execute( $subjsec, $name ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth->fetchrow; if ($count) { print qq{

$lex{'Item with this name exists. Please try again.'}

\n}; print qq{\n}; exit; } # Strip colons from name since used as field separator in gbmain. $name =~ s/://g; # 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; } } # Add the group into markscheme if it doesn't exist there. if ( not $group{$group} ) { $markscheme .= "\n$group=0"; $sth = $dbh->prepare("update subject set markscheme = ? where subjsec = ?"); $sth->execute( $markscheme, $subjsec ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } } my $sth = $dbh->prepare("insert into gbtest ( subjsec,name,description,tdate,score,weight,grp ) values ('$subjsec','$name',? ,'$tdate','$totalmaxscore','$totalweight', ?) "); $sth->execute( $description, $group ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } print qq{

GB Test Inserted - $name / $tdate / $totalmaxscore

\n}; # Now get the ID for that new record... my $sth = $dbh->prepare("select id from gbtest where name = ? and subjsec = ?"); $sth->execute( $name, $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $newid = $sth->fetchrow; if ( not $newid ) { print qq{

Unable to find new item id. Contact Technical support

\n}; print qq{\n}; exit; } #print qq{The New Item ID is: $newid
\n}; # next get the kids (from eval) and loop through putting in records $sth = $dbh->prepare("select distinct studnum from eval where subjcode = ? and studnum != ''"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $sth1 = $dbh->prepare("select score from gbscore where studnum = ? and testid = ? "); # loop through each student and create their new score records. while (my $studnum = $sth->fetchrow) { my ($localtotalweight, $localtotalscore); # First read in their score (if any) for each item to be compressed. foreach my $testid (keys %arr) { # Get a score... $sth1->execute($studnum,$testid); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $score = $sth1->fetchrow; if ($score eq $specchar or $score eq '' or not defined $score) { #skip this score next; } if ( not $maxscore{$testid} ) { #check for any problems with this... print qq{$lex{'No Maximum Score for Test'}: $testid
\n}; next; } if ($score =~ /\d/) { # if score is a digit... do it. $localtotalweight += $weight{$testid}; $localtotalscore += ($weight{$testid} * $score / $maxscore{$testid}); } else { # some sort of text score...count as zero... update total weight. $localtotalweight += $weight{$testid}; } #print qq{SC: $score WT:$weight{$testid} MAX: $maxscore{$testid}
\n}; } # End of tests loop #print qq{SN: $studnum W:$localtotalweight SC:$localtotalscore
\n}; if ($localtotalweight){ $score = $localtotalscore * $totalmaxscore / $localtotalweight; } else { $score = 0; } $score = round( $score, 1); #NOTE: 1 decimal rounding should give sufficient accuracy. Change if required. #print qq{
Score: $score Max: $totalmaxscore
\n}; # Write the record with the updated score. my $sth2 = $dbh->prepare("insert into gbscore (studnum,testid,score,comment ) values ('$studnum','$newid',?,?)"); $sth2->execute( $score, $comment ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } print qq{

Student Scores Added for New Item

\n}; # delete the existing records for each 'old' item... foreach my $id (keys %arr ) { #print qq{K:$id V:$arr{$id}
\n}; my $result = $dbh->do("delete from gbtest where id = '$id'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $result = $dbh->do("delete from gbscore where testid = '$id'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } print qq{

Previous Items and Scores Removed

\n}; print qq{[ $lex{'Delete/Compress'} $lex{Assessments} ]\n}; print qq{\n}; exit; } # End of compressRecords

$lex{Name}	}; print qq{$lex{'No colons(:) please'}
$lex{Description}
$lex{Date}
$lex{Group}	\n}; print qq{$lex{'or New Group'}