#!/usr/bin/perl # # $Id: testdata.pl,v 1.10 2006/11/29 14:44:59 ddoughty Exp $ # # Source File: testdata.pl # Get config use FileHandle; use Reporter; use Data::Dumper; require 'sitecfg.pl'; require 'testlib.pl'; use strict; use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT %SUBTEST_RESPONSES); use vars qw($testcomplete $cgiroot $pathsep $dataroot $testgraphic $graphroot); &app_initialize; &LanguageSupportInit(); &get_client_profile($SESSION{'clid'}); # Make sure we have a valid session, and exit if we don't if (not &get_session($FORM{'tid'})) { exit(0); } my $options; if (exists $FORM{'testid'}) { @{$options}{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)} = @FORM{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)}; &DisplayQuestions($SESSION{'clid'},$FORM{'testid'},$options); } else { &ReportChooser($SESSION{'clid'}); } # There should only be function definitions beyond this point. exit(0); sub ReportChooser { my ($client) = @_; print &Reporter::HTMLHeader("Test Data"); # options to be implemented - # drop down menu to choose test # checkbox and text field to choose subset of questions # remediation checkbox # show active checkbox # show inactive checkbox # filter by subjct multichoice # filter by difficulty print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; #print ""; print ""; print ""; print "\n"; print "
TestQuestionsS print "
Select Test:
Show Questions:
All
". "Subset:
Display:
Active Questions
". "Inactive Questions
". "Question Answers
". "Remediation
\n"; print "\n"; #my @subjects = qw(astronomy geology physics); print ""; print "\n"; print "
Filter By:
Subject:Difficulty:
\n"; print "\n"; print &Reporter::HTMLFooter(); } sub DisplayQuestions { my ($client,$test,$options) = @_; &get_test_profile($client,$test); my $details = &get_question_definitions($client,$test); print &Reporter::HTMLHeaderPlain("Test Data for $TEST{'desc'}"); print "

Test Data for $TEST{'desc'}

\n"; print "\n"; my (@questnum,%subjects,$difficulty); if ($options->{'showquest'} eq 'subset') { $options->{'displayquest'} =~ s/\s+//g; #eliminate whitespace foreach (split(/,/,$options->{'displayquest'})) { if (/^\d+$/) {$questnum[$_] = 1;} if (/^(\d+)-$/) {foreach ($1 .. (scalar(@$details)+1)) {$questnum[$_]=1;}} if (/^-(\d+)$/) {foreach (1 .. $1) {$questnum[$_]=1;}} if (/^(\d+)-(\d+)$/) {foreach ($1 .. $2) {$questnum[$_]=1;}} } } if ($options->{'bysubject'}) { %subjects = map(($_=>1),split(/,/,$options->{'subjfilter'})); } if ($options->{'bydiff'}) { $difficulty = $options->{'difffilter'}; } my $questcount = 0; foreach my $question (@$details) { ### DED 7/28/04 Some questions have qil blank; look for !N instead of Y #if (not (($options->{'active'} and $question->{'qil'} eq 'N') or # ($options->{'inactive'} and $question->{'qil'} eq 'Y'))) { if (not (($options->{'active'} and $question->{'qil'} ne 'Y') or ($options->{'inactive'} and $question->{'qil'} eq 'Y'))) { next; } if ($options->{'bysubject'} and not $subjects{$question->{'subj'}}) {next;} if ($options->{'bydiff'} and ($question->{'skilllevel'} != $options->{'difffilter'})) {next;} my (undef, $qindex) = split(/\./,$question->{'id'}); if (($options->{'showquest'} eq 'subset') and not $questnum[$qindex]) {next;} $questcount++; if ($question->{'qil'} eq 'Y') { print "

$question->{'id'} - Inactive

\n"; } else { print "

$question->{'id'}

\n"; } print "Subject: $question->{'subj'}, Skill: ".(qw(basic intermediate advanced))[$question->{'skilllevel'}]. "

\n"; if ($question->{'qim'}) { print $question->{'illustration'}."
\n"; } if ($question->{'qtp'} eq 'tf') { print formatTF($question,$options); } elsif ($question->{'qtp'} eq 'esa') { print formatESA($question,$options); } elsif ($question->{'qtp'} eq 'nrt') { print formatNRT($question,$options); } elsif ($question->{'qtp'} eq 'mch' or $question->{'qtp'} eq 'ord') { print formatMCHORD($question,$options); } elsif ($question->{'qtp'} eq 'mcs' or $question->{'qtp'} eq 'mcm') { print formatMC($question,$options); } elsif ($question->{'qtp'} eq 'mtx' or $question->{'qtp'} eq 'mtr') { print formatMT($question,$options); } else { #print "

".Dumper($question)."
"; } if ($options->{"remediation"}) { if ($question->{'qrm'}) { print "Remdiation:
\n$question->{'qrm'}
\n"; } else { print "No Remediation.
\n"; } } print "
\n"; } print "No Matching Questions Found.\n"; } #print "
".Dumper($details,$options)."
"; print &Reporter::HTMLFooter(); } sub formatTF { my ($question,$options) = @_; my ($optTrue,$optFalse) = ('',''); #my $outline = "

$question->{'id'}

\n"; my $outline = "$question->{'qtx'}

\n"; if ($options->{'answers'}) { $optTrue = ($question->{'qca'}=~/(true|yes)/i ? "checked" : "" ); $optFalse = ($question->{'qca'}=~/(false|no)/i ? "checked" : "" ); } my ($true,$false) = ($question->{'qca'}, $question->{'qia'}); if ($question->{'qca'} !~ /(true|yes)/i) { ($true,$false) = ($false,$true); } $outline .= "{'id'}\" value=\"$true\" $optTrue>$true
\n"; $outline .= "{'id'}\" value=\"$false\" $optFalse>$false

\n"; return $outline; } sub formatESA { my ($question,$options) = @_; my ($tmp); #my @esaanswers = split(/\n/,$question->{'qca'}); my $len; $tmp = "

\n"; $len += 5; my $anslist = "{'id'}\" VALUE=\"\" SIZE=$len>"; my $qtext = $question->{'qtx'}; if ($qtext =~ // ) { $qtext =~ s//$anslist/g; } else { $qtext .= "

$anslist\n"; } my $outline .= "$qtext

\n"; if ($options->{'answers'}) { $outline .= "Answers:
\n"; $outline .= $tmp; } return $outline; } sub formatMCHORD { my ($question,$options) = @_; my $tmp = $question->{'qca'}; $tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g; my @ansopt = split(/\n/,$tmp); $tmp = $question->{'qia'}; $tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g; my @desc = split(/\n/,$tmp); my @albls = set_answer_labels($question->{'qalb'}); my $outline = "$question->{'qtx'}

\n"; my $num = (@ansopt > @desc? @ansopt: @desc); $outline .= "\n"; my @answers; if ($options->{'answers'}) {@answers = @albls;} for (my $i=0; $i<$num; $i++) { if ($question->{'qtp'} eq 'mch') { $outline .= ""; $outline .= ""; $outline .= "\n"; } else { my $answer = ($options->{'answers'}?" value=\"".($i+1)."\"":""); $outline .= ""; } $outline .= "\n"; } $outline .= "
{'id'}.$i\" value=\"$answers[$i]\">". " $ansopt[$i]   $albls[$i] $desc[$i]
{'id'}.$i\"$answer>". " $ansopt[$i] 

\n"; return $outline; } sub formatNRT { my ($question,$options) = @_; my $outline = "$question->{'qtx'}

\n"; my $nrtmaxlen = $question->{'qca'}; my $nrtcols = 50; my $nrtrows = $nrtmaxlen/$nrtcols; $nrtrows = ($nrtrows > 5) ? 5 : $nrtrows; $outline .= "\n"; return $outline; } sub formatMC { my ($question,$options) = @_; my ($inptyp); if (($question->{'qtp'} eq 'mcs' ) || ($question->{'qtp'} eq 'mca')) { $inptyp = "RADIO"; } elsif ($question->{'qtp'} eq 'mcm' ) { $inptyp = "CHECKBOX"; } else{ return undef; } if ($question->{'anslay'} eq "h") { $inptyp .= ":".$question->{'anslay'}; } my @albls = set_answer_labels($question->{'qalb'}); my $qca = $question->{'qca'}; $qca =~ s/\r/\n/g; $qca =~ s/\n\n/\n/g; my %qansopt = map(($_=>{'correct' =>1}), split(/\n/, $qca)); my $qia = $question->{'qia'}; $qia =~ s/\r/\n/g; $qia =~ s/\n\n/\n/g; foreach (split(/\n/, $qia)) {$qansopt{$_}->{'correct'} = 0;} my @order; push @order,split(/\n/, $qca), split(/\n/, $qia); my $outline="$question->{'qtx'}

\n"; my $iord=0; foreach (@order) { my $qans; if ($question->{'qalb'} ne "x") { $qansopt{$_}->{'formatted'} = $albls[$iord].") $_"; } else { $qansopt{$_}->{'formatted'} = $_; } $qansopt{$_}->{'index'} = $iord++; } if ($inptyp eq 'RADIO:h') { my $colspan = scalar(keys(%qansopt))+2; $outline = "\n"; $outline .= " \n"; $outline .= " "; } foreach my $qans (@order) { my $optselected = (($options->{'answers'} and $qansopt{$qans}->{'correct'}) ? "CHECKED" : ""); if ($inptyp eq 'RADIO') { $outline .= "{'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}
\n"; } elsif ($inptyp eq 'RADIO:h') { $outline .= ""; } else { my $akey = "$question->{'id'}.$qansopt{$qans}->{'index'}"; $outline .= "{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}
\n"; } } if ($inptyp eq 'RADIO:h') { $outline .= "\n"; $outline .= " "; foreach my $qans (@order) { $outline .= ""; } $outline .= "\n"; $outline .= "
"; $outline .= " \n"; $outline .= " "; $outline .= " \n"; $outline .= "
$question->{'left_be'}$question->{'right_be'}
\n"; $outline .= "
 {'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected> 
 $qansopt{$qans}->{'formatted'} 
\n"; } return $outline."

\n";; } sub formatMT { my ($question,$options) = @_; my $outline = "$question->{'qtx'}

\n"; # Split qia into row and col headers my $qia = $question->{'qia'}; $qia =~ s/\r/\n/g; $qia =~ s/\n\n/\n/g; my ($qrowhdr, $qcolhdr) = split(/RC/,$qia); my @qrowhdr = split(/\n/, $qrowhdr); my @qcolhdr = split(/\n/, $qcolhdr); #@optvalues = split(/\?/, $_[2]); #shift @optvalues; my @optvalues = (); my $i=0; my @chmatrix; if ($question->{'qtp'} eq 'mtx') { # Mark previous selections with "CHECKED" foreach my $row (0 .. $#qrowhdr) { foreach my $col (0 .. $#qcolhdr) { if ($optvalues[$i] != "xxx") { $chmatrix[$row][$col]="CHECKED"; } else { $chmatrix[$row][$col]=""; } $i++; } } } else { # Mark previous selections with "SELECTED" foreach my $row (0 .. $#qrowhdr) { foreach my $col (0 .. $#qcolhdr) { my $rank = $optvalues[$i]; foreach my $irank (0 .. 5) { if ($irank eq $rank) { $chmatrix[$i][$irank]="SELECTED"; } else { $chmatrix[$i][$irank]=""; } } $i++; } } } # Build matrix html $outline="\n"; foreach (0 .. $#qcolhdr) { $outline .= ""; } $outline .= "\n"; $i=0; foreach my $row (0 .. $#qrowhdr) { $outline .= ""; foreach my $col (0 .. $#qcolhdr) { if ($question->{'qtp'} eq 'mtx') { $outline .= ""; } else { $outline .= ""; } $i++; } $outline .= "\n"; } $outline .= "
 $qcolhdr[$_]
$qrowhdr[$row]
\n"; return $outline; } sub get_question_definitions { my ($clid, $testid) = @_; my $qcount = 0; my $questions = []; my @qrecs = &get_question_list($testid, $clid); chomp $qrecs[0]; my @flds = split(/&/,shift(@qrecs)); foreach my $qrec (@qrecs) { chomp ($qrec); #($id, $qtyp) = split(/&/, $qrec); my @rowdata = split(/&/, $qrec); my $i=0; my $question = {}; @{$question}{@flds} = @rowdata; ($question->{'subj'},$question->{'skilllevel'}) = split(/\./,$question->{'subj'}); $question->{'tf'} = ($question->{'qtp'} eq 'tf') ? "SELECTED" : ""; $question->{'mcs'} = ($question->{'qtp'} eq 'mcs') ? "SELECTED" : ""; $question->{'mcm'} = ($question->{'qtp'} eq 'mcm') ? "SELECTED" : ""; $question->{'esa'} = ($question->{'qtp'} eq 'esa') ? "SELECTED" : ""; $question->{'nrt'} = ($question->{'qtp'} eq 'nrt') ? "SELECTED" : ""; $question->{'qtx'} =~ s/\;/\n/g; $question->{'qca'} =~ s/\;/\n/g; $question->{'qia'} =~ s/\;/\n/g; $question->{'lbla'} = ($question->{'qalb'} eq 'a') ? "SELECTED" : ""; $question->{'lblA'} = ($question->{'qalb'} eq 'A') ? "SELECTED" : ""; $question->{'lbln'} = ($question->{'qalb'} eq 'n') ? "SELECTED" : ""; $question->{'lblr'} = ($question->{'qalb'} eq 'r') ? "SELECTED" : ""; $question->{'lblR'} = ($question->{'qalb'} eq 'R') ? "SELECTED" : ""; $question->{'tft'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'TRUE') ? "CHECKED" : ""; $question->{'tff'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'FALSE') ? "CHECKED" : ""; $question->{'tfy'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'YES') ? "CHECKED" : ""; $question->{'tfn'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'NO') ? "CHECKED" : ""; $question->{'qim0'} = ($question->{'qim'} eq '0') ? "SELECTED" : ""; $question->{'qim1'} = ""; $question->{'qim2'} = ""; my $illus = join($pathsep, $testgraphic, "$clid.$question->{'id'}"); my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'}); my $illusfile = &file_exists_with_extension($illus, $supportedmedia); $question->{'illustration'} = ""; $question->{'defthumbnail'} = ""; if ($question->{'qim'} eq '1') { $question->{'qim1'} = "SELECTED"; } elsif ($question->{'qim'} eq '2') { $question->{'qim2'} = "SELECTED"; } elsif ($question->{'qim'} eq '3' ) { $question->{'qim3'} = "SELECTED"; $question->{'illustration'} = "{'flr'}\" TARGET=\"illustrated\">Reference Page"; } if ($illusfile ne '') { my @filesegs = split(/\./, $illusfile); my $fext = $filesegs[$#filesegs]; @filesegs = () ; if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) { if ($question->{'qim'} eq '1') { $question->{'illustration'} = "{'id'}.$fext\" TARGET=\"illustrated\">Illustration"; $question->{'defthumbnail'} = "{'id'}.$fext\" TARGET=\"illustrated\">{'id'}.$fext\" width=100 BORDER=0>"; } else { $question->{'illustration'} = "{'id'}.$fext\" BORDER=0>"; $question->{'defthumbnail'} = "{'id'}.$fext\" TARGET=\"illustrated\">{'id'}.$fext\" width=100 BORDER=0>"; } } elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) { $question->{'illustration'} = "{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" CONTROLS=\"console\" HIDDEN=\"false\">"; } elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) { $question->{'illustration'} = "{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"300\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">"; } } #if ($question->{'qnxt'} eq '' ) { #$question->{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs; #} else { #if ($question->{'qnxt'} > $#qrecs) { #$question->{'qnxt'} = $#qrecs; #} #} #if ($question->{'qprv'} eq '' ) { #$question->{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1; #} else { #if ($question->{'qprv'} > $#qrecs) { #$question->{'qprv'} = $#qrecs; #} #} $question->{'totdef'} = $#qrecs; $question->{'chkobs'} = ($question->{'qil'} eq 'Y') ? "CHECKED" : ""; if ($question->{'qtx'} =~ /:::/) { ($question->{'qtx'}, $question->{'left_be'}, $question->{'right_be'}) = split(/:::/, $question->{'qtx'}); } if ($question->{'layout'} =~ /:/) { ($question->{'layout'}, $question->{'anslay'}) = split(/:/, $question->{'layout'}); $question->{'anslayhchk'} = ($question->{'anslay'} eq 'h') ? "CHECKED" : ""; } else { $question->{'anslay'} = ""; } $question->{'anslayvchk'} = ($question->{'anslay'} ne 'h') ? "CHECKED" : ""; $question->{'layout2chk'} = ($question->{'layout'} eq '2') ? "CHECKED" : ""; $question->{'layout3chk'} = ($question->{'layout'} eq '3') ? "CHECKED" : ""; $question->{'layout4chk'} = ($question->{'layout'} eq '4') ? "CHECKED" : ""; $question->{'layout5chk'} = ($question->{'layout'} eq '5') ? "CHECKED" : ""; $question->{'layout1chk'} = ($question->{'layout'} eq '1') ? "CHECKED" : ""; if ($question->{'layout'} eq '') { $question->{'layout'} = '1'; $question->{'layout1chk'} = "CHECKED"; } # sac v start addition for comment input support my @qflags = split(/\./,$question->{'flags'}); $question->{'qcmtprmpt'} = $qflags[0]; $question->{'chkqccmt'} = ($qflags[0] eq 'Y') ? "CHECKED" : ""; $question->{'qcprmpt'} = ($qflags[0] eq 'Y') ? $qflags[1] : ""; $question->{'promptcomments'}=""; if ($qflags[0] eq 'Y') { $question->{'promptcomments'}="
$qflags[1]

\n"; if (($question->{'layout'} eq '4') || ($question->{'layout'} eq '5') || ($question->{'qtyp'} eq 'nrt')) { $question->{'promptcomments'}=join('',"\ 
",$question->{'promptcomments'}); } else { $question->{'promptcomments'}=join('',"",$question->{'promptcomments'},""); } } # sac ^ end addition for comment input support #return; push @$questions, $question; } return $questions; }