#!/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="\n";
$fparms=join('',$fparms,"\n");
$fparms=join('',$fparms,"\n");
$fparms=join('',$fparms,"\n");
$fparms=join('',$fparms,"\n");
$fparms=join('',$fparms,"\n");
$fjscript="
function parmsDMIA(oform,tst) {
oform.tstid.value=tst;
oform.submit();
}
";
print "
$REPORT{'rptid'}
";
print "\n";
print "\n\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 "\n";
for $i (1 .. $#dataflds) {
($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
print "\t\t$dataflds[$i] | \n";
}
print "
\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 "\n";
print "\n";
print "\tTest Data Extraction\n";
print "\t\n";
print "\n";
print "\n";
print "\n";
print "$TEST{'desc'} ($TEST{'id'})
\n";
print "Raw Data Extraction
\n";
print "$ncount Completed Responses\n";
print "\n";
print "\n";
for $i (1 .. $#cols) {
($colalgn,$colhdr) = split(/:/,$cols[$i]);
print "\t\t$colhdr | \n";
}
print "
\n";
}
}
sub print_report_bycnd_footer {
if ($cExport) { return;}
print "
\n";
print "\n";
print "\n";
}