#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. my %lex = ('Main' => 'Main', 'GB Main' => 'GB Main', 'Clone/Duplicate Assessment Items' => 'Clone/Duplicate Assessment Items', 'Source Course' => 'Source Course', 'Destination Course' => 'Destination Course', 'Select these Subject-Sections' => 'Select these Subject-Sections', 'Name' => 'Name', 'Description' => 'Description', 'Group' => 'Group', 'Select' => 'Select', 'No Tests Found' => 'No Tests Found', 'Count' => 'Count', 'Add Selected Items' => 'Add Selected Items', 'Added Assessment Items...' => 'Added Assessment Items...', 'Maintenance Menu' => 'Maintenance Menu', 'No Userid Found' => 'No Userid Found', 'Error' => 'Error', 'Please Log In' => 'Please Log In', ); my $self = 'testclone.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"; } my $q = new CGI; my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Get session. 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 qq{\n}; print qq{

$lex{'Please Log In'}

\n}; print qq{\n}; exit; } print $q->header( -charset, $charset ); # Print Page Header my $title = $lex{'Clone/Duplicate Assessment Items'}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{

[ $lex{Main}\n | }; print qq{$lex{'GB Main'} ]

\n}; print qq{

$title

\n}; my $subjsec = $session->param('subjsec'); if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showTests(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; addTests(); } #---------------- sub showStartPage { #---------------- # Get Teacher's courses my %courses; $sth = $dbh->prepare("select subjsec, description from subject where teacher = ? order by description"); $sth->execute( $userid ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while (my ($subjsec, $desc) = $sth->fetchrow) { $courses{"$desc ($subjsec)"} = $subjsec; } # Start the form print qq{\n}; print qq{\n}; } #------------ sub showTests { #------------ # foreach my $key ( sort keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } # passed: destination, source, check (ie. checkall) my $check = $arr{check}; delete $arr{check}; # if present my $srcsubjsec = $arr{source}; my $destsubjsec = $arr{destination}; # Get Desc of Destination course my $sth = $dbh->prepare("select description from subject where subjsec = ?"); $sth->execute( $destsubjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $destcrs = $sth->fetchrow; $sth->execute( $srcsubjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $srccrs = $sth->fetchrow; # Print start of form. print qq{

\n}; print qq{\n}; print qq{\n}; # Table print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{\n}; # Get the source items, display in form. my $sth = $dbh->prepare("select id, name, description, grp from gbtest where subjsec = ? order by tdate, grp"); $sth->execute( $srcsubjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $srccount; while (my ($id, $name, $desc, $grp) = $sth->fetchrow) { print qq{\n}; print qq{\n}; print qq{\n}; $srccount++; } if ( not $srccount ){ print qq{\n}; print qq{

Source - $srccrs ($srcsubjsec)
$lex{Name}	$lex{Description}	$lex{Group}	$lex{Select}
}; print qq{}; print qq{
$name	$desc
$lex{'No Tests Found'}

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

\n}; print qq{\n}; exit; } # End of showTests #------------ sub addTests { #------------ # foreach my $key ( sort keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } # Passed: subjsec, numeric record id, then all group values (even if not selected) # This is the destination course... my $subjsec = $arr{subjsec}; delete $arr{subjsec}; # load the names of the destination course items to check for collisions. my $sth = $dbh->prepare("select name from gbtest where subjsec = ?"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my %testname; while ( my $name = $sth->fetchrow) { $testname{$name} = 1; } print qq{\n}; print qq{\n}; print qq{\n}; # Load the markscheme field for destination course, since we will update $sth1 = $dbh->prepare("select markscheme from subject where subjsec = ?"); $sth1->execute( $subjsec ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $markscheme = $sth1->fetchrow; # Setup groupweight to hold any new groups; write update after done loop below. my %groupweight; # 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; $groupweight{$grp} = $percent; } } # end of markscheme load # Get source record my $sth = $dbh->prepare("select name, description, tdate, score, weight, grp from gbtest where id = ?"); # Add Destination Record my $sth1 = $dbh->prepare("insert into gbtest (subjsec,name,description,tdate,score,weight,grp) values(?,?,?,?,?,?,?)"); # Insert clone tests/assessment items into the destination course foreach my $id ( keys %arr ) { if ($id =~ m/^\d/) { # only digits at the start... my $group = $arr{"group$id"}; # Get Source Record $sth->execute($id); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($name, $desc, $tdate, $score, $weight, $grp) = $sth->fetchrow; if ($grp ne $group) { # changed by user; # $group =~ s/\'+//g; # filter... $grp = $group; } # Allow group % value to remain the same # $groupweight{$grp} = 0; # my $originalname = $name; my $originaldesc = $desc; if ($testname{$name}) { # name already exists for this... $name .= '0'; # add trailing zero. } # Now do the insertion $sth1->execute($subjsec, $name, $desc, $tdate, $score, $weight,$grp); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } print qq{\n}; } # end of If the id. } # end of loop # Rewrite the markscheme for this subject. my $markscheme; foreach my $grp (sort keys %groupweight) { $markscheme .= "$grp=$groupweight{$grp}\n"; } $sth = $dbh->prepare("update subject set markscheme = ? where subjsec = ?"); $sth->execute( $markscheme, $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

**$lex{'Added Assessment Items...'}**
$lex{'Name'}	$lex{'Description'}
$name	$desc

\n}; print qq{

[ $lex{'Clone/Duplicate Assessment Items'} |\n}; print qq{$lex{'Maintenance Menu'} ]

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

$lex{'Source Course'}
Check All Items
$lex{'Destination Course'}
	\n}; print qq{