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.
353 lines
9.8 KiB
353 lines
9.8 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
##!/usr/local/bin/perl5.8.0
|
||
|
|
#
|
||
|
|
# $Id: dmia.pl,v 1.4 2005/07/27 14:55:49 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: creports.pl
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
require 'sitecfg.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
require 'tstatlib.pl';
|
||
|
|
require 'cybertestlib.pl';
|
||
|
|
require 'ui.pl';
|
||
|
|
use Time::Local;
|
||
|
|
use FileHandle;
|
||
|
|
use URI::Escape;
|
||
|
|
|
||
|
|
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
|
||
|
|
%SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SUBTEST_RESPONSES);
|
||
|
|
use vars qw($testcomplete $cgiroot $pathsep $dataroot );
|
||
|
|
|
||
|
|
$FORM{'frm'}="";
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
|
||
|
|
|
||
|
|
if (&get_session($FORM{'tid'})) {
|
||
|
|
&LanguageSupportInit();
|
||
|
|
|
||
|
|
if ($FORM{'tstid'}) {
|
||
|
|
&get_session($FORM{'tid'});
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
my @sortbys = qw(Name LoginID Date);
|
||
|
|
$cExport;
|
||
|
|
|
||
|
|
if ($FORM{'csv'}) {
|
||
|
|
print "Content-Disposition: attachment;filename=report.csv\n\n";
|
||
|
|
$cExport=1;
|
||
|
|
} else {
|
||
|
|
print "Content-Type: text/html\n\n";
|
||
|
|
$cExport=0;
|
||
|
|
}
|
||
|
|
if (&get_session($FORM{'tid'})) {
|
||
|
|
&extract_test_data();
|
||
|
|
}
|
||
|
|
if ($cExport) {
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$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'}='DMIA';
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Exec Report $FORM{'rptno'}");
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
my $i;
|
||
|
|
$faction="$cgiroot/dmia.pl";
|
||
|
|
$fparms="<input type=hidden name=\"tid\" value=\"$SESSION{'tid'}\">\n";
|
||
|
|
$fparms=join('',$fparms,"<input type=hidden name=\"tstid\" value=\"\">\n");
|
||
|
|
$fparms=join('',$fparms,"<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n");
|
||
|
|
$fparms=join('',$fparms,"<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n");
|
||
|
|
$fparms=join('',$fparms,"<input type=hidden name=\"testsummary\" value=\"extract\">\n");
|
||
|
|
$fparms=join('',$fparms,"<input type=hidden name=\"csv\" value=\"1\">\n");
|
||
|
|
$fjscript="
|
||
|
|
function parmsDMIA(oform,tst) {
|
||
|
|
oform.tstid.value=tst;
|
||
|
|
oform.submit();
|
||
|
|
}
|
||
|
|
";
|
||
|
|
print "<HTML>
|
||
|
|
<HEAD>
|
||
|
|
<TITLE>$REPORT{'rptid'}</TITLE>
|
||
|
|
<SCRIPT language=\"JavaScript\">
|
||
|
|
<!--
|
||
|
|
$fjscript
|
||
|
|
// -->
|
||
|
|
</SCRIPT>
|
||
|
|
</HEAD>
|
||
|
|
<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
|
||
|
|
TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
|
||
|
|
VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
|
||
|
|
";
|
||
|
|
print "<FORM name=\"rptform1\" action=\"$faction\" METHOD=POST>\n$fparms\n";
|
||
|
|
|
||
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
|
||
|
|
<TR>
|
||
|
|
<TD VALIGN=\"top\">$CLIENT{'logo'}</TD>
|
||
|
|
<TD ALIGN=\"right\">
|
||
|
|
<FONT COLOR=\"$SYSTEM{'HEADERCOLOR'}\" size=2>
|
||
|
|
<B>$REPORT{'rptdesc'}\ </B><BR>
|
||
|
|
</FONT>
|
||
|
|
</TD>
|
||
|
|
</TR>
|
||
|
|
</TABLE>
|
||
|
|
";
|
||
|
|
@trecs = &get_test_list($CLIENT{'clid'});
|
||
|
|
@tmptrecs = ();
|
||
|
|
for (1 .. $#trecs) {
|
||
|
|
($id, $desc) = split(/&/, $trecs[$_]);
|
||
|
|
$trecs[$_] = join('&', "$desc", "$id");
|
||
|
|
push @tmptrecs, $trecs[$_];
|
||
|
|
}
|
||
|
|
@trecs = sort @tmptrecs;
|
||
|
|
for (0 .. $#trecs) {
|
||
|
|
($desc,$id) = split(/&/, $trecs[$_]);
|
||
|
|
$testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
|
||
|
|
$testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
|
||
|
|
$testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
|
||
|
|
$href="javascript:parmsDMIA(document.rptform1,\'$id\')\;";
|
||
|
|
$tstoption =" <TR>
|
||
|
|
<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>
|
||
|
|
<TD valign=top><FONT SIZE=2>$desc</FONT></TD>
|
||
|
|
<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>
|
||
|
|
<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>
|
||
|
|
<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD>
|
||
|
|
</TR>\n";
|
||
|
|
$tstoptions = join('', $tstoptions, $tstoption);
|
||
|
|
}
|
||
|
|
print "<CENTER><B>Survey Results</B><br>";
|
||
|
|
print "
|
||
|
|
<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">
|
||
|
|
<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
|
||
|
|
<TR>
|
||
|
|
<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>
|
||
|
|
<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>
|
||
|
|
<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>
|
||
|
|
<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>
|
||
|
|
<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>
|
||
|
|
</TR>
|
||
|
|
<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
|
||
|
|
$tstoptions
|
||
|
|
<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
|
||
|
|
</TABLE>
|
||
|
|
";
|
||
|
|
print "</FORM>\n";
|
||
|
|
print "</BODY>\n</HTML>\n";
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Exec Report $FORM{'rptno'} completed");
|
||
|
|
close(STDOUT);
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub extract_test_data() {
|
||
|
|
&LanguageSupportInit();
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
|
||
|
|
my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
|
||
|
|
my @colhdrs=();
|
||
|
|
push @colhdrs,"";
|
||
|
|
#if ($FORM{'cndnme'}) {
|
||
|
|
push @colhdrs,"left:Last Name";
|
||
|
|
push @colhdrs,"left:First Name";
|
||
|
|
push @colhdrs,"left:MI";
|
||
|
|
#}
|
||
|
|
push @colhdrs,"left:User ID";
|
||
|
|
#if ($FORM{'cndeml'}) {
|
||
|
|
push @colhdrs,"left:Email Address";
|
||
|
|
#}
|
||
|
|
if ($FORM{'cnd1'}) {
|
||
|
|
push @colhdrs,"left:$CLIENT{'clcnd1'}";
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd2'}) {
|
||
|
|
push @colhdrs,"left:$CLIENT{'clcnd2'}";
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd3'}) {
|
||
|
|
push @colhdrs,"left:$CLIENT{'clcnd3'}";
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd4'}) {
|
||
|
|
push @colhdrs,"left:$CLIENT{'clcnd4'}";
|
||
|
|
}
|
||
|
|
if ($FORM{'cndscr'}) {
|
||
|
|
push @colhdrs,"center:Correct";
|
||
|
|
push @colhdrs,"center:Incorrect";
|
||
|
|
push @colhdrs,"right:Score";
|
||
|
|
}
|
||
|
|
push @colhdrs,"left:Responses";
|
||
|
|
my @dataflds=();
|
||
|
|
my @unsorted=();
|
||
|
|
my $row="";
|
||
|
|
my @qsumry=();
|
||
|
|
my @qresps=();
|
||
|
|
my $user="";
|
||
|
|
my $joint="\&";
|
||
|
|
my $colhdr;
|
||
|
|
my $colalgn;
|
||
|
|
my $fidx;
|
||
|
|
for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
|
||
|
|
$user = $filelist[$fidx];
|
||
|
|
$user =~ s/.$TEST{'id'}$//;
|
||
|
|
$user =~ s/^$CLIENT{'clid'}.//;
|
||
|
|
my $excuser="inc$user";
|
||
|
|
if ($FORM{$excuser}) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
|
||
|
|
@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
|
||
|
|
&get_candidate_profile($CLIENT{'clid'},$user);
|
||
|
|
#if ($FORM{'cndnme'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'nml'}");
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'nmf'}");
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'nmm'}");
|
||
|
|
#}
|
||
|
|
$row=join($joint,$row,"$user");
|
||
|
|
#if ($FORM{'cndeml'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'eml'}");
|
||
|
|
#}
|
||
|
|
if ($FORM{'cnd1'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'cnd1'}");
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd2'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'cnd2'}");
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd3'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'cnd3'}");
|
||
|
|
}
|
||
|
|
if ($FORM{'cnd4'}) {
|
||
|
|
$row=join($joint,$row,"$CANDIDATE{'cnd4'}");
|
||
|
|
}
|
||
|
|
if ($FORM{'cndscr'}) {
|
||
|
|
$row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
|
||
|
|
}
|
||
|
|
my @qans = split(/\&/, $SUBTEST_ANSWERS{2});
|
||
|
|
shift @qans;
|
||
|
|
my @qids = split(/\&/, $SUBTEST_QUESTIONS{2});
|
||
|
|
shift @qids;
|
||
|
|
@qresps = split(/\&/, $SUBTEST_RESPONSES{2});
|
||
|
|
shift @qresps;
|
||
|
|
for (my $iqs=0; $iqs<=$#qresps; $iqs++) {
|
||
|
|
my ($resp, $trash) = split(/::/, $qresps[$iqs]);
|
||
|
|
my @tresps = split(/\?/, $resp);
|
||
|
|
my @resps = ();
|
||
|
|
foreach $tresp (@tresps) {
|
||
|
|
if ($tresp ne "xxx" && $tresp ne "") {
|
||
|
|
push(@resps, $tresp);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
my ($ans, $trash) = split(/::/, $qans[$iqs]);
|
||
|
|
my @ans = split(/\?/, $ans);
|
||
|
|
if ($#ans) { shift @ans; }
|
||
|
|
&get_question_definition($TEST{'id'}, $CLIENT{'clid'}, $qids[$iqs]);
|
||
|
|
@pans = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@qia = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@qia) {
|
||
|
|
push(@pans, $qia);
|
||
|
|
}
|
||
|
|
@qia=();
|
||
|
|
$resp = "";
|
||
|
|
foreach $aresp (@resps) {
|
||
|
|
if ($QUESTION{'qtp'} ne "esa" && $QUESTION{'qtp'} ne "nrt") {
|
||
|
|
my ($tans, $trash) = split(/=/, $ans[$aresp]);
|
||
|
|
$resp .= ",@pans[$tans]";
|
||
|
|
} else {
|
||
|
|
$resp .= ",$aresp";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($resp ne "") { $resp = substr($resp, 1); }
|
||
|
|
$row=join('&',$row,$resp);
|
||
|
|
}
|
||
|
|
push @unsorted, $row;
|
||
|
|
$row="";
|
||
|
|
}
|
||
|
|
my @sorted=sort @unsorted;
|
||
|
|
@unsorted=();
|
||
|
|
my $rowcount=$#filelist+1;
|
||
|
|
&print_report_dataextract_header($rowcount,@colhdrs,@colalign);
|
||
|
|
my ($i);
|
||
|
|
for $i (0 .. $#sorted) {
|
||
|
|
@dataflds=split($joint, $sorted[$i]);
|
||
|
|
if ($cExport) {
|
||
|
|
for $i (1 .. $#dataflds) {
|
||
|
|
print "\"$dataflds[$i]\"";
|
||
|
|
if ($i == $#dataflds) {
|
||
|
|
print "\n";
|
||
|
|
} else {
|
||
|
|
print ",";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "<TR>\n";
|
||
|
|
for $i (1 .. $#dataflds) {
|
||
|
|
($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
|
||
|
|
print "\t\t<td align=$colalgn valign=top>$dataflds[$i]</td>\n";
|
||
|
|
}
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
&print_report_bycnd_footer();
|
||
|
|
@sorted=();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub print_report_dataextract_header {
|
||
|
|
my ($ncount,@cols)= @_;
|
||
|
|
my $colhdr;
|
||
|
|
my $colalgn;
|
||
|
|
my $i;
|
||
|
|
if ($cExport) {
|
||
|
|
print "\"$TEST{'desc'} ($TEST{'id'})\"\n";
|
||
|
|
print "\"Raw Data Extraction\"\n";
|
||
|
|
print "\"$ncount Completed Responses\"\n";
|
||
|
|
for $i (1 .. $#cols) {
|
||
|
|
($colalgn,$colhdr) = split(/:/,$cols[$i]);
|
||
|
|
print "\"$colhdr\"";
|
||
|
|
if ($i == $#cols) {
|
||
|
|
print "\n";
|
||
|
|
} else {
|
||
|
|
print ",";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "<HTML>\n";
|
||
|
|
print "<HEAD>\n";
|
||
|
|
print "\t<TITLE>Test Data Extraction</TITLE>\n";
|
||
|
|
print "\t<SCRIPT language=\"JavaScript\">\n";
|
||
|
|
print "\t<\!--\n";
|
||
|
|
print "\t function wdwOnLoad() {\n";
|
||
|
|
print "\t window.focus();\n";
|
||
|
|
print "\t }\n";
|
||
|
|
print "\t window.onload=wdwOnLoad;\n";
|
||
|
|
print "\t//-->\n";
|
||
|
|
print "\t</SCRIPT>\n";
|
||
|
|
print "</HEAD>\n";
|
||
|
|
print "<BODY>\n";
|
||
|
|
print "<CENTER>\n";
|
||
|
|
print "<B>$TEST{'desc'} ($TEST{'id'})</B><BR>\n";
|
||
|
|
print "<B>Raw Data Extraction</B><BR>\n";
|
||
|
|
print "<font size=2><I>$ncount Completed Responses</I></font>\n";
|
||
|
|
print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
for $i (1 .. $#cols) {
|
||
|
|
($colalgn,$colhdr) = split(/:/,$cols[$i]);
|
||
|
|
print "\t\t<td align=$colalgn valign=top><b>$colhdr</b></td>\n";
|
||
|
|
}
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub print_report_bycnd_footer {
|
||
|
|
if ($cExport) { return;}
|
||
|
|
print "</TABLE>\n";
|
||
|
|
print "</BODY>\n";
|
||
|
|
print "</HTML>\n";
|
||
|
|
}
|