You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

543 lines
17 KiB

#!/usr/bin/perl
# Source File: tstatlib.pl
#
# log the statistics entry for the test question
#
use Time::Local;
sub log_test_stats() {
my $tslogentry;
my $tslogfile;
my $tslogdir;
my $movelog;
my $uqrsp;
my $msg;
my @tslogentries;
my $cnt;
my $chmodok;
my $iidx;
$uqrsp = &format_responses();
$tslogentry = $TEST_SESSION{'state'};
$tslogentry = join('&',$tslogentry,$SESSION{'clid'},$SESSION{'uid'},$FORM{'tstid'},$FORM{'qno'},$FORM{'qid'},$FORM{'tcap'},$FORM{'submit'},$uqrsp);
$movelog = 0;
$tslogdir = $testinprog;
if ($tstate eq $TEST_STATES{'_TERMINATED'}) {
$movelog = 1;
} else {
if (($FORM{'submit'} eq "$xlatphrase[488]")
|| ($FORM{'submit'} eq "$xlatphrase[5]")
|| ($FORM{'submit'} eq "$xlatphrase[549]")) {
## I DECLINE BUTTON
## DONE BUTTON
## TIME EXPIRED
$movelog = 1;
}
}
#$tslogfile = join($pathsep, $tslogdir, "$SESSION{'clid'}.$SESSION{'uid'}.$FORM{'tstid'}.tim");
#$msg = "";
#open(TSLOGFILE, ">>$tslogfile") or $msg="failed";
#if ($msg eq '') {
#print TSLOGFILE "$tslogentry\n";
#close TSLOGFILE;
#if ($movelog == 1) {
#open(TSLOGFILE, "<$tslogfile") or $msg="failed";
#if ($msg eq '') {
#@tslogentries = <TSLOGFILE>;
#close TSLOGFILE;
#$tslogfile = join($pathsep, $testcomplete, "$SESSION{'clid'}.$SESSION{'uid'}.$FORM{'tstid'}.tim");
#open(TSLOGFILE, ">>$tslogfile") or $msg="failed";
#if ($msg eq '') {
#for $iidx (0 .. $#tslogentries) {
#print TSLOGFILE "$epochtime\&$tslogentries[$iidx]";
#}
#close TSLOGFILE;
#$chmodok = chmod 0666, $tslogfile;
#$tslogfile = join($pathsep, $tslogdir, "$SESSION{'clid'}.$SESSION{'uid'}.$FORM{'tstid'}.tim");
#$chmodok = chmod 0666, $tslogfile;
#$cnt = unlink $tslogfile;
#} else {
#close TSLOGFILE;
#}
#} else {
#close TSLOGFILE;
#}
#}
#} else {
#close TSLOGFILE;
#}
}
sub format_responses() {
my $qrs;
my $ipqr;
my $rkey;
my $qtp;
$qtp = $FORM{'qtp'};
$qrs = "";
if (($qtp eq 'mcm') || ($qtp eq 'mch') || ($qtp eq 'ord')) {
for $ipqr (0 .. 25) {
# if( $TEST{'seq'} eq 'svy' ) {
# $rkey = "q$FORM{'qno'}";
# $rkey = join( '-', $rkey, "qrs$ipqr" );
# } else {
$rkey = "qrs$ipqr";
# }
$qrs = join('', $qrs, $FORM{$rkey});
}
} else {
$qrs = join('?', $qrs, $FORM{'qrs'});
}
return $qrs;
}
### DED 9/1/04 Removed .tim files
#sub getClientUserTests {
#my ($clid,$cndid,$tstid) = @_;
#my @testdates;
#my $sgrepfor;
#my @tslogentries;
#
#my $tslogfile = join($pathsep, $testcomplete, "$clid.$cndid.$tstid.tim");
#my $tshistfile = join($pathsep, $testcomplete, "$clid.$tstid.history");
#
#$sgrepfor="\&1.2.1\&$clid.$cndid.$tstid";
#open(TSLOGFILE, "<$tslogfile");
#@tslogentries = <TSLOGFILE>;
#close TSLOGFILE;
#@testdates = grep( /$sgrepfor/,@tslogentries);
#@tslogentries = ();
#return @testdates;
#}
#sub getCUTTimes {
#my ($tdate,$clid,$cndid,$tstid) = @_;
#my @testentries;
#my $sgrepfor;
#my @tslogentries;
#
#my $tslogfile = join($pathsep, $testcomplete, "$clid.$cndid.$tstid.tim");
#my $tshistfile = join($pathsep, $testcomplete, "$clid.$tstid.history");
#
#$sgrepfor="$tdate\&(.*)\&$clid\&$cndid\&$tstid\&(.*)";
#open(TSLOGFILE, "<$tslogfile");
#@tslogentries = <TSLOGFILE>;
#close TSLOGFILE;
#@testentries = grep( /$sgrepfor/,@tslogentries);
#@tslogentries = ();
#return @testentries;
#}
#
# Return: Count of test result files in $dir matching regex with $clid
# and $testid, OR -1 if there was an error.
#
sub getHistoricTests {
my ($dir, $clid, $testid, $cndid) = @_;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', testid '$testid'");
return -1;
}
if ( ! defined($clid) ) {
&logger::logerr("Undefined client ID for directory '$dir', testid '$testid'");
return -1;
}
if ( ! defined($testid) ) {
&logger::logerr("Undefined test ID for directory '$dir', client ID '$clid'");
return -1;
}
my $historyfile = join($pathsep,$dir,"$clid.$testid.history");
open (HISTFILE,"<$historyfile") or return 0;
my @histentries = <HISTFILE>;
close HISTFILE;
my $sgrepfor=join('&',"\<\<\>\>$clid","$cndid","$testid","");
my @cndidentries = grep( /$sgrepfor/,@histentries);
@histentries = ();
my $iidx;
my @lines;
my $testdate;
my $correct;
my $incorrect;
my $score;
for $iidx (0 .. $#cndidentries) {
$sgrepfor="\<\<\>\>";
@lines = split(/$sgrepfor/,$cndidentries[$iidx]);
$testdate = $lines[0];
($correct,$incorrect,$score,$trash) = split(/&/, $lines[5]);
$tstrec = join('&',$testdate,$correct,$incorrect,$score);
push @histentries,$tstrec;
}
@lines = ();
return @histentries;
}
sub getClientTestTakers {
my ($clid,$tstid) = @_;
my @testtakers;
my $sgrepfor;
my @histentries;
my $tshistfile = join($pathsep, $testcomplete, "$clid.$tstid.history");
#2002-04-12 17:43:06 GMT<<>>sandbox&user2&tutor&6.0.0&ndammtas&&tutor&&&bcarico@actscorp.com&Y.Y.Y.N<<>>1.2.f.1.24h.Y.0&tutor.001&tutor.002&tutor.004&tutor.005&tutor.006&tutor.009&tutor.003&tutor.010&tutor.011<<>>&TRUE::ASTR.0:1:10:0&?0=1?3=0?4=0?2=0?1=0::ASTR.0:1:10:0&earth;the 3rd rock;terra firma::ASTR.0:1:10:0&FALSE::ASTR.0:1:10:0&?5=0?3=0?0=1?2=1?4=0?1=1::ASTR.0:1:10:0&a.8.1.2.7.3.6.0.4.5::MATCH.0:1:1:0&?2=1?1=1?4=0?3=0?0=1::METW.0:1:0:0&o.1.3.2.4.0::ORDERED.0:1:1:0&TRUE::ENDOF.0:1:1:0<<>>&TRUE::&0::&earth::&FALSE::&xx23x5::&xxxxxxxxx::&01xx4::&24351::&TRUE::<<>>8&1&88&greenbar.jpg&264&/1.true.true/1.0.0/1.earth;the 3rd rock;terra firma.earth/1.false.false/1.235.235/0.gbcehifda.xxxxxxxxx/1.014.014/1.24351.24351/1.true.true
$sgrepfor="\&$clid\&(.*)\&$tstid";
open(TSLOGFILE, "<$tshistfile");
@histentries = <TSLOGFILE>;
close TSLOGFILE;
@testtakers = grep( /$sgrepfor/,@histentries);
@histentries = ();
return @testtakers;
}
sub get_teststartend {
my ($clid,$cnd,$test,$testendtime) = @_;
if (!$testendtime) { $testendtime = "01-Jan-0000 00:00:00"; }
my ($day,$month,$year,$hour,$min,$sec,$startsec,$endsec,$duration);
$logfile = "$clid.$cnd";
#print STDERR "$logfile, Test Start $test, Test Complete $test\n";
my @logs = get_log($logfile);
#print STDERR Dumper(\@logs);
#my @startlines = grep(/Test Start $test/,@logs);
#my ($starttime, $startsession, $startnum, $startmsg) = split(/,/, pop(@startlines));
#my @endlines = grep(/Test Complete $test/,@logs);
#my ($endtime, $endsession, $endnum, $endmsg) = split(/,/, pop(@endlines));
#print STDERR "($starttime, $startsession, $startnum, $startmsg)\n";
my $status = 'Null';
my ($time, $session, $num, $msg, $starttime, $endtime);
foreach my $log (@logs) {
if ($log =~ /Test Start $test/) {
#print STDERR $log."\n";
$status = "Start";
($time, $session, $num, $msg) = split(/,/,$log);
} elsif ($log =~ /Test Complete $test/ and $status eq 'Start') {
#print STDERR $log."\n";
$status = 'Complete';
$starttime = $time;
($time, $session, $num, $msg) = split(/,/,$log);
$endtime = $time;
#if ($endtime eq $testendtime) { break; }
}
}
#print STDERR "$status, $starttime, $endtime\n";
if ($starttime) {
$startsec = toSeconds($starttime);
#($sec,$min,$hour) = localtime($startsec);
($sec,$min,$hour) = gmtime($startsec);
$starttime = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
} else {
$starttime = 'Unknown';
}
if ($endtime) {
$endsec = toSeconds($endtime);
#($sec,$min,$hour) = localtime($endsec);
($sec,$min,$hour) = gmtime($endsec);
$endtime = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
} else {
$endtime = 'Unknown';
}
if ($startsec and $endsec) {
$duration = fmtDuration($endsec - $startsec);
} else {
$duration = 'Unknown';
}
#print STDERR "($starttime,$endtime,$duration)\n\n";
return ($starttime,$endtime,$duration);
}
sub toGMSeconds {
my ($asciitime) = @_;
#print STDERR "$asciitime\n";
my %months = ("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4,
"Jun" => 5, "Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9,
"Nov" => 10, "Dec" => 11);
my ($day,$month,$year,$hour,$min,$sec);
if ($asciitime =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
($year,$month,$day,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
$month--;
} elsif ($asciitime =~ /(\d+)-(\w+)-(\d+) (\d+):(\d+):(\d+)/) {
($day,$month,$year,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
$month = $months{$month};
} else {
return undef;
}
if ($year < 100) {$year += 2000;}
return timegm($sec,$min,$hour,$day,$month,$year);
}
sub toLocalSeconds {
my ($asciitime) = @_;
#print STDERR "$asciitime\n";
my %months = ("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4,
"Jun" => 5, "Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9,
"Nov" => 10, "Dec" => 11);
my ($day,$month,$year,$hour,$min,$sec);
if ($asciitime =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
($year,$month,$day,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
$month--;
} elsif ($asciitime =~ /(\d+)-(\w+)-(\d+) (\d+):(\d+):(\d+)/) {
($day,$month,$year,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
$month = $months{$month};
} else {
return undef;
}
if ($year < 100) {$year += 2000;}
return timelocal($sec,$min,$hour,$day,$months{$month},$year);
}
sub fmtDuration {
my ($duration) = @_;
#print STDERR "$duration\n";
my $sec = $duration % 60;
my $min = (int($duration/60)) % 60;
my $hour = int($duration/3600);
return sprintf("%02d:%02d:%02d",$hour,$min,$sec);
}
sub get_testhistory_from_log {
my ($clid,$cnd,$test,$testendtime) = @_;
#print STDERR "($clid,$cnd,$test,$testendtime)\n";
if ($testendtime) {$testendtime = toGMSeconds($testendtime);}
my $logfile = "$clid.$cnd";
my @logs = get_log($logfile);
my ($history, $oldhist);
my $start;
foreach my $log (@logs) {
chomp $log;
my ($time, $session, $num, $msg) = split(/,/,$log,4);
$time = toGMSeconds($time);
if (not defined $time) {next;}
#print STDERR "(log = $log)\n($time | $session | $num | $msg)\n";
my $data = {'action' => 'unknown',
'time' => $time,
'session' => $session,
'num' => $num,
'message' => $msg};
if ($log =~ /Test Start $test/) {
#print STDERR $log."\n";
$oldhistory = $history;
$data->{'action'} = 'Start';
$history = {'history' => [$data],
'start' => $data->{'time'},
'total' => 0,
'actual' => 0,
'end' => $data->{'time'},
'badlog' => 0,
};
$start = $data->{'time'};
#print STDERR "($data->{'action'},$start)\n";
} elsif ($history and $log =~ /Test (Complete|Pause|Resume|Ready|Question) $test/) {
#print STDERR $log;
$data->{'action'} = $1;
if ($log =~ /(Complete|Pause|Question)/) {
$history->{'end'} = $data->{'time'};
}
#print STDERR "($data->{'action'} , $history->{'end'} => $data->{'time'}\n";
#print STDERR "($data->{'action'},$start)\n";
push @{$history->{'history'}}, $data;
if (($data->{'action'} eq 'Pause') or ($data->{'action'} eq 'Complete')) {
if (defined $start) {
$history->{'actual'} += ($data->{'time'} - $start);
$start = undef;
#print STDERR "$history->{'actual'}, ($data->{'time'} , $start)\n";
} else {
# Ugh, there is something wrong with the log
# set the badlog flag to true
$history->{'badlog'} = 1;
}
} elsif ($data->{'action'} eq 'Resume') {
if (defined $start) {
# wasn't properly paused, use the time of the last question as the pause time.
$history->{'actual'} += ($history->{'end'} - $start);
}
$start = $data->{'time'};
}
if ($testendtime and $log =~ /(Complete|Pause|Question)/) {
# At one point in time, the test completion time stamp
# in *.history files could be different from the
# completion stamp in log files. This resulted in
# tests sometimes being missed. This bug has since
# been fixed, but we check for a 5 second window so we
# can use old data files. jeffo - 2004-01-20
#print STDERR "abs($testendtime - $data->{'time'})\n";
if (abs($testendtime - $data->{'time'}) <=5) {
last;
} elsif ($testendtime < ($data->{'time'}+5)) {
# no test found with the given endtime
return undef;
}
}
}
}
if (not $history) {
# no test start was found!
return undef;
}
$history->{'total'} = $history->{'history'}->[@{$history->{'history'}}-1]->{'time'} - $history->{'history'}->[0]->{'time'};
if (defined $start) {
$history->{'actual'} += ($history->{'history'}->[@{$history->{'history'}}-1]->{'time'} - $start);
} else {
# Test paused and not yet restarted, or test complete
}
#print STDERR "Done\n";
return $history
}
#
# Return: Count of test result files in $dir matching regex with $clid
# and $testid, OR -1 if there was an error.
#
sub CountTestFiles {
my ($dir, $clid, $testid) = @_;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', testid '$testid'");
return -1;
}
if ( ! defined($clid) ) {
&logger::logerr("Undefined client ID for directory '$dir', testid '$testid'");
return -1;
}
if ( ! defined($testid) ) {
&logger::logerr("Undefined test ID for directory '$dir', client ID '$clid'");
return -1;
}
if ($clid eq "all") { $clid = "*"};
return scalar(get_matching_files($dir, "^$clid".'\.\S+\.'."$testid\$"));
}
#
# Return: Count of cnd result files in $dir matching regex with $clid
# and $cndid, OR -1 if there was an error.
#
sub CountCndFiles {
my ($dir, $clid, $cndid) = @_;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', cndid '$cndid'");
return -1;
}
if ( ! defined($clid) ) {
&logger::logerr("Undefined client ID for directory '$dir', cndid '$cndid'");
return -1;
}
if ( ! defined($cndid) ) {
&logger::logerr("Undefined cnd ID for directory '$dir', client ID '$clid'");
return -1;
}
return scalar(get_matching_files($dir, "^$clid".'\.'."$cndid".'\.\S+$'));
}
#
# Return: Count of cnd result files in test.histry file and $dir
# matching regex with $clidand $cndid,
# OR -1 if there was an error.
#
sub CountCndTests {
my ($dir, $clid, $cndid) = @_;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', cndid '$cndid'");
return -1;
}
if ( ! defined($clid) ) {
&logger::logerr("Undefined client ID for directory '$dir', cndid '$cndid'");
return -1;
}
if ( ! defined($cndid) ) {
&logger::logerr("Undefined cnd ID for directory '$dir', client ID '$clid'");
return -1;
}
my @histfiles=get_history_files($dir, $clid, $cndid);
my @lasttests=get_lasttest_files($dir, $clid, $cndid, @histfiles);
}
sub get_history_files {
my ($dir, $clid, $cndid) = @_;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', cndid '$cndid'");
return undef;
}
if ( ! opendir (GDIR, $dir) ) {
&logger::logerr("Unable to open directory '$dir' for reading: $!");
return undef;
}
my @filenames = readdir(GDIR);
closedir GDIR;
my @filelist = ();
my $regex = "^$clid\.(.*)\.history";
foreach $file (sort @filenames) {
if (($file =~ /$regex/i )) {
push @filelist, $file;
print "<!-- $file -->\n";
}
}
return @filelist;
}
sub get_lasttest_files {
my ($dir, @histfiles, $clid, $cndid) = @_;
my $testid;
if ( ! defined($dir) ) {
&logger::logerr("Undefined directory for client ID '$clid', cndid '$cndid'");
return undef;
}
if ( ! opendir (GDIR, $dir) ) {
&logger::logerr("Unable to open directory '$dir' for reading: $!");
return undef;
}
my @filenames = readdir(GDIR);
closedir GDIR;
my @filelist = ();
my $regex = "^$clid\.$cndid\.(.*)";
foreach $file (sort @filenames) {
if (($file =~ /$regex/i )) {
$testname = $file;
$testname =~ s/^$clid\.$cndid\.//g;
push @filelist, $file;
}
}
return @filelist;
}
sub date_out_of_range {
my ($completedat,$datefm,$dateto) = @_;
my @unsorted=();
push @unsorted, $completedat;
push @unsorted, $datefm;
push @unsorted, $dateto;
my @sorted = sort @unsorted;
my $bretyes = ($sorted[1] eq $unsorted[0]) ? 0 : 1;
@unsorted=();
@sorted=();
return $bretyes;
}
# end with True because this is a require file
1;