#!/usr/bin/perl
#
# $Id: creportsf.pl,v 1.11 2006/10/19 17:35:29 psims Exp $
#
# Source File: creportsf.pl
# Get config
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require 'qlib.pl';
$FORM{'frm'}="";
&app_initialize;
warn "INFO: " . __FILE__ . " running.\n" ;
print "Content-Type: text/html\n\n";
# ACT-C-004&Test Statistics by Test User Filter
### DED 10/24/2002 Added Filter-by-Question functionality
if (&get_session($FORM{'tid'})) {
&LanguageSupportInit();
$REPORT{'rptid'}="";
@rptdefs = &get_data("reports.$SESSION{'clid'}");
@lbls = split(/&/, $rptdefs[0]);
foreach $rptdef (@rptdefs) {
chomp ($rptdef);
@flds = split(/&/, $rptdef);
if ($flds[0] eq $FORM{'rptno'}) {
for $i (0 .. $#lbls) {
$REPORT{$lbls[$i]} = $flds[$i];
$i++;
}
}
}
$REPORT{'rptid'}=$FORM{'rptno'};
&get_client_profile($SESSION{'clid'});
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
&print_report_header();
if ($FORM{'filterbyques'} eq "on") {
&print_question_filter();
}
if ($FORM{'specfilter'} eq "on") {
&print_report_C_004();
}
&print_report_footer();
}
sub print_report_header() {
my $i;
# C_004
$FORM{'rptdesc'} =~ s/\+/ /g;
$faction="$cgiroot/teststats.pl";
$ftarget="rptwindow";
$fparms=" \n";
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fparms=join('',$fparms," \n");
$fjscript="
function onWdwLoad() {
var oform=document.rptform1;
}
window.onload=onWdwLoad;
";
if ($FORM{'filterbyques'} eq "on") {
$fuserjscript="
function rptform1_submit(oform) {
var ans=\"\";
if (oform.question.selectedIndex == 0) {
alert(\"You must select at least one question by which to filter!\");
return false;
}
if (oform.selanswer.selectedIndex == -1) {
alert(\"You must select at least one answer by which to filter!\");
return false;
}
for (var i = 0; i < oform.selanswer.options.length; i++) {
if (oform.selanswer.options[i].selected)
if (oform.selanswer.options[i].text == \"No Response\") {
ans=\"\&\"+oform.selanswer.options[i].text;
} else {
ans=ans+\"\&\"+i;
}
}
oform.answer.value=ans;
}
";
} else {
$fuserjscript="
function rptform1_submit(oform) {
return true;
}
";
}
print "
$REPORT{'rptid'} - $REPORT{'rptdesc'}
";
print "\n";
print "\n\n";
}
sub print_question_filter() {
&build_question_select_list();
&build_question_answer_list();
$fuserjscript="
function show_question(question) {
var jqid=\"$quesid\", jqtxt=\"$questxt\", jqans=\"$quesans\";
ajqid=jqid.split(\"\&\");
ajtxt=jqtxt.split(\"\&\");
ajans=jqans.split(\"\&\");
for (var i = 0; i < ajqid.length; i++) {
if (ajqid[i] == question.value) {
document.rptform1.questxt.value=ajtxt[i];
ajqans=ajans[i].split(\"\;\");
lajqans=ajqans.length;
//document.rptform1.questxt.value=lajqans+\":\"+ajqans[lajqans]+\":\";
for (var j = 0; j < lajqans; j++) {
document.rptform1.selanswer.options[j].text=ajqans[j];
}
document.rptform1.selanswer.options[lajqans].text=\"No Response\";
for (var j = lajqans+1; j < document.rptform1.selanswer.length; j++) {
document.rptform1.selanswer.options[j].text=\"\";
}
}
}
}
";
print "\n";
print "Filter By Question \n";
print "
\n";
print "Question \n";
print "Answer \n";
print " \n";
print "\n";
print "$TEST{'questionlist'} \n";
#print " \n";
#print "\n";
print "\n";
print "
\n";
print "\n";
print " \n";
print "\n";
for (0 .. $numans+1) {
print "\n";
}
print " \n";
print "\n";
print "
\n";
}
sub print_report_C_004 {
my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
my @converter;
if ($SESSION{'uid'} ne '') {
my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
if ($imaregistrar eq 'Y') {
foreach $rotator (@filelist) {
my @cnd = split(/\./, $rotator);
my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
}
@filelist = @converter;
}
} else {
&logger::logerr("No SESSION{uid} set!");
}
my @colhdrs=();
push @colhdrs,"right:$xlatphrase[744]";
push @colhdrs,"left:$xlatphrase[745]";
push @colhdrs,"left:$xlatphrase[746]";
push @colhdrs,"left:$xlatphrase[747]";
push @colhdrs,"left:$xlatphrase[748]";
push @colhdrs,"center:$xlatphrase[749]";
push @colhdrs,"center:$xlatphrase[137]";
push @colhdrs,"center:$xlatphrase[692]";
push @colhdrs,"right:$xlatphrase[361]";
my @dataflds=();
my @unsorted=();
my $row="";
my @qsumry=();
my $user="";
my $joint="\&";
my $colhdr;
my $colalgn;
if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";}
if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";}
if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";}
if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";}
my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}";
my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}";
for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
$user = $filelist[$fidx];
$user =~ s/.$TEST{'id'}//g;
$user =~ s/$CLIENT{'clid'}.//g;
my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
if (not defined $history) {
$history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'});
} else {
#print STDERR "$user from log.\n";
}
if (not defined $history) {
# no log file entry for this test
#print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n";
my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9];
$history->{'end'} = $mtime;
$history->{'start'} = $history->{'end'};
}
$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
if (&date_out_of_range($completedat,$datefm,$dateto)) {
next;
}
&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
&get_candidate_profile($CLIENT{'clid'},$user);
$row=join($joint,$row,"$CANDIDATE{'nml'}");
$row=join($joint,$row,"$CANDIDATE{'nmf'}");
$row=join($joint,$row,"$CANDIDATE{'nmm'}");
$row=join($joint,$row,"$user");
$row=join($joint,$row,"$CANDIDATE{'selfreg'}");
$row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
push @unsorted, $row;
$row="";
}
my @sorted=sort @unsorted;
@unsorted=();
my $rowcount=$#filelist+1;
print "Filter By User \n";
# Print check box to reverse the exclude feature to an include feature.
print ' ' ;
print "Exclude Selected Items \n" ;
print ' ' ;
print "Include Selected Items
\n" ;
&print_report_dataextract_header($rowcount,@colhdrs);
$jsarray = "";
for $i (0 .. $#sorted) {
@dataflds=split($joint, $sorted[$i]);
print "
\n";
for $i (0 .. $#dataflds) {
($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
if ($i == 0) {
print "\t\t ";
} else {
if ($colhdr eq "Self-Reg") {
print "\t\t$dataflds[$i]\n";
print "\t\t \n";
$jsarray .= "$dataflds[4]:";
} else {
print "\t\t$dataflds[$i] \n";
}
}
}
print " \n";
}
$jsarray = substr($jsarray,0,-1);
print "\n";
$jscript="
function self_reg_onClick(oform,exc) {
var jsl=\"$jsarray\", jsa, n, s;
jsa=jsl.split(':');
for (var i=0; i$jscript\n";
@sorted=();
}
sub print_report_dataextract_header {
my ($ncount,@cols)= @_;
my $colhdr;
my $colalgn;
my $i;
print "\n";
print "\t\n";
for $i (0 .. $#cols) {
($colalgn,$colhdr) = split(/:/,$cols[$i]);
print "\t\t$colhdr \n";
}
print "\t \n";
}
#
#
#
sub get_test_sequence_for_reports {
# There is a duplicate, and better version of this function in testlib.pl.
&get_test_profile($_[0], $_[2]);
$trash3 = join($pathsep, $testcomplete, "$_[0].$_[1].$_[2]");
$msg = "";
if ( ! open(TESTFILE,"<$trash3") ) {
&logger::logerr("Unable to open $trash3: $!");
$msg="failed";
print "\n";
$msg = "";
# Clear the hashs. Otherwise the calling code will process the current contents.
%TEST_SESSION = () ;
%SUBTEST_QUESTIONS = () ;
%SUBTEST_ANSWERS = () ;
%SUBTEST_RESPONSES = () ;
%SUBTEST_SUMMARY = () ;
} else {
@seqlines = ;
close TESTFILE;
$isubtest = 1; $iidx = 0; $iaryidx = 1;
foreach $seqline (@seqlines) {
chop ($seqline);
if ($iidx eq 0) {
@status = split(/&/, $seqline);
$ifld = 0;
$TEST_SESSION{'clid'} = $status[$ifld++];
$TEST_SESSION{'uid'} = $status[$ifld++];
$TEST_SESSION{'tstid'} = $status[$ifld++];
$TEST_SESSION{'state'} = $status[$ifld++];
$TEST_SESSION{'dscl'} = $status[$ifld++];
$TEST_SESSION{'profb'} = $status[$ifld++];
$TEST_SESSION{'id'} = $status[$ifld++];
$TEST_SESSION{'profa'} = $status[$ifld++];
$TEST_SESSION{'srvy'} = $status[$ifld++];
$TEST_SESSION{'ntfy'} = $status[$ifld++];
$TEST_SESSION{'emlcnd'} = $status[$ifld++];
@status = ();
$iidx++;
} else {
if ($iaryidx eq 1) {
$SUBTEST_QUESTIONS{$isubtest} = $seqline;
} elsif ($iaryidx eq 2) {
$SUBTEST_ANSWERS{$isubtest} = $seqline;
} elsif ($iaryidx eq 3) {
$seqline =~ s/\%0D\%0A/ /g;
$SUBTEST_RESPONSES{$isubtest} = unmunge($seqline);
} elsif ($iaryidx eq 4) {
$SUBTEST_SUMMARY{$isubtest} = $seqline;
}
$iaryidx++;
if ($iaryidx eq 5) {
$iaryidx = 1;
$isubtest++;
}
}
}
}
@seqlines = ();
return;
}
#wac merge v - this code commented out because replaced the calls with EFL changes
#
# $patterncount = CountFiles($directory, $pattern1, $pattern2);
#
#sub CountFiles {
# opendir (GDIR, $_[0]);
# @cdots = readdir(GDIR);
# closedir GDIR;
# $ncount=0;
# $crmmask1 = "$_[1]";
# $crmmask2 = "$_[2]";
# foreach $crmfile (@cdots) {
# if (($crmfile =~ /$crmmask1/ ) && ($crmfile =~ /$crmmask2/ )) {$ncount++;}
# }
# @cdots = ();
# return $ncount;
#}
# wac merge ^
################################################################################
#
# Subroutine Name
# GetTestHeader
#
# Description
# This subroutine returns the header of the test file
#
# Inputs
# $clientId -- The id of the client to search through
#
# Outputs
# None
#
# Returns
# @testFields -- An array of fields in the header
#
#adt080401###############################################################################
sub GetTestHeader
{
my $clientId = $_[0];
my @testList = &get_data("tests.$clientId");
my $testHdr = $testList[0];
my $testFields;
chop( $testHdr );
@testFields = split( /&/, $testHdr );
return @testFields;
}
#adt080401###############################################################################
#
# Subroutine Name
# GetTestsByOwner
#
# Description
# This subroutine searches through the test definition file of the given
# client for all the tests that are owned by the given user id or are public
#
# Inputs
# $clientId -- The id of the client to search through
# $ownedBy -- The name of the owner of the test to search for
#
# Outputs
# None
#
# Returns
# @tests -- An array of tests owned by the given user id
#
################################################################################
sub GetTestsByOwner
{
my $clientId = $_[0];
my $ownedBy = $_[1];
my %currHash;
my @testList = &get_data("tests.$clientId");
my @currField;
my @tests;
my $testHdr = $testList[0];
my $testFields;
my $testCntr;
@testFields = &GetTestHeader( $clientId );
for( $testCntr = 1; $testCntr < $#testList; $testCntr++ )
{
#print "$testList[$testCntr] \n";
chop( $testList[$testCntr] );
@currField = split( '&', $testList[$testCntr] );
for( 0 .. $#testFields )
{
$currHash{$testFields[$_]} = $currField[$_];
}
#print "$currHash{'ownedby'} - $ownedBy";
if( ( $currHash{'ownedby'} eq $ownedBy ) || ( $currHash{'ownedby'} eq "" ) )
{
push( @tests, $testList[$testCntr] );
#print "$testList[$testCntr] \n";
}
}
return @tests;
}