#!/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$fparms\n"; print "
$CLIENT{'logo'} $REPORT{'rptdesc'}\ 
"; @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 =" $id $desc $testscompleted $testsinprogress $testspending \n"; $tstoptions = join('', $tstoptions, $tstoption); } print "
Survey Results
"; print " $tstoptions

Test ID Description Cmp InP Pnd


"; 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\n"; } print "\n"; } } sub print_report_bycnd_footer { if ($cExport) { return;} print "
$colhdr
\n"; print "\n"; print "\n"; }