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.
769 lines
24 KiB
769 lines
24 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: qdef.pl,v 1.7 2006/01/23 21:39:30 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: qdef.pl
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
require 'sitecfg.pl';
|
||
|
|
require 'sbalib.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
require 'qlib.pl';
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
|
||
|
|
print "Content-Type: text/html\n\n";
|
||
|
|
|
||
|
|
if (&get_session($FORM{'tid'})) {
|
||
|
|
my $show_template = undef;
|
||
|
|
&LanguageSupportInit();
|
||
|
|
$FORM{'respmsg'} = "";
|
||
|
|
$QUESTION{'reload'} = "N";
|
||
|
|
if ($FORM{'frm'} eq '0') {
|
||
|
|
if ($SESSION{'browserapp'} eq 'MSIE') {
|
||
|
|
$FORM{'alert100'} = "Y";
|
||
|
|
}
|
||
|
|
$show_template = "selectpg";
|
||
|
|
} elsif ($FORM{'frm'} eq '3') {
|
||
|
|
#
|
||
|
|
# Preview question...
|
||
|
|
#
|
||
|
|
$TEST{'id'} = $FORM{'tstid'};
|
||
|
|
&get_test_profile($SESSION{'clid'}, $TEST{'id'});
|
||
|
|
$SUBJAREA{'testlist'} = &get_subjarea_masters ($SESSION{'clid'}, $TEST{'id'},"id,id");
|
||
|
|
&preview_question();
|
||
|
|
} else {
|
||
|
|
$TEST{'id'} = $FORM{'tstid'};
|
||
|
|
$SUBJAREA{'testlist'} = &get_subjarea_masters ($SESSION{'clid'}, $TEST{'id'},"id,id");
|
||
|
|
&get_test_profile($SESSION{'clid'}, $TEST{'id'});
|
||
|
|
if ($FORM{'frm'} eq '1') {
|
||
|
|
&build_question_select_list();
|
||
|
|
$show_template = "qdefhdr";
|
||
|
|
} elsif ($FORM{'frm'} eq '2') {
|
||
|
|
#
|
||
|
|
# Save question...
|
||
|
|
#
|
||
|
|
if ($FORM{'qid'} eq "$TEST{'id'}.000") {
|
||
|
|
$QUESTION{'id'} = &get_question_number($TEST{'id'}, $SESSION{'clid'});
|
||
|
|
$QUESTION{'qtp'} = $FORM{'qtp'};
|
||
|
|
$QUESTION{'new'} = "Y";
|
||
|
|
$QUESTION{'qim'} = "0";
|
||
|
|
$QUESTION{'layout1chk'} = $TEST{'layout1chk'};
|
||
|
|
$QUESTION{'layout2chk'} = $TEST{'layout2chk'};
|
||
|
|
$QUESTION{'layout3chk'} = $TEST{'layout3chk'};
|
||
|
|
$QUESTION{'layout4chk'} = $TEST{'layout4chk'};
|
||
|
|
$QUESTION{'layout5chk'} = $TEST{'layout5chk'};
|
||
|
|
$QUESTION{'layout'} = $TEST{'layout'};
|
||
|
|
$specialtypes = "mcs\;mcm\;mch\;ord\;mca\;";
|
||
|
|
if ($specialtypes =~ /$FORM{'qtp'}/ ) {
|
||
|
|
$QUESTION{'qca'} = "";
|
||
|
|
$QUESTION{'qia'} = "";
|
||
|
|
$choicecount = int($FORM{'numanswers'});
|
||
|
|
for (1 .. $choicecount) {
|
||
|
|
$QUESTION{'qia'} = join('', $QUESTION{'qia'} ,"$_\n");
|
||
|
|
}
|
||
|
|
if (($FORM{'qtp'} eq 'ord') || ($FORM{'qtp'} eq 'mch')) {
|
||
|
|
$QUESTION{'qca'} = $QUESTION{'qia'};
|
||
|
|
$QUESTION{'qia'} = "";
|
||
|
|
}
|
||
|
|
} elsif ($FORM{'qtp'} eq "mtx" || $FORM{'qtp'} eq "mtr") {
|
||
|
|
$QUESTION{'qca'} = "";
|
||
|
|
$rowcount = int($FORM{'numarows'});
|
||
|
|
$colcount = int($FORM{'numacols'});
|
||
|
|
if ($FORM{'lblall'} eq "Y") {
|
||
|
|
$lblcount = $rowcount * $colcount;
|
||
|
|
$QUESTION{'qia'} = $rowcount."::".$colcount."::";
|
||
|
|
for (1 .. $lblcount) {
|
||
|
|
$QUESTION{'qia'} = join('', $QUESTION{'qia'} ,"$_\n");
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$QUESTION{'qia'} = "";
|
||
|
|
for (1 .. $rowcount) {
|
||
|
|
$QUESTION{'qia'} = join('', $QUESTION{'qia'} ,"$_\n");
|
||
|
|
}
|
||
|
|
$QUESTION{'qia'} .= "::".$rowcount."::".$colcount."::";
|
||
|
|
for (1 .. $colcount) {
|
||
|
|
$QUESTION{'qia'} = join('', $QUESTION{'qia'} ,"$_\n");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} elsif ($FORM{'savechanges'} eq "Y") {
|
||
|
|
if (($FORM{'qim'} eq '0') || ($FORM{'qim'} eq '3')) {
|
||
|
|
&remove_question_image($SESSION{'clid'}, $FORM{'qid'});
|
||
|
|
} else {
|
||
|
|
&put_question_image($SESSION{'clid'}, $FORM{'qid'}, "upimg");
|
||
|
|
}
|
||
|
|
&put_question_definition($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'});
|
||
|
|
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'});
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Saved Qid $FORM{'qid'}");
|
||
|
|
$QUESTION{'new'} = "N";
|
||
|
|
$FORM{'respmsg'} = "Changes saved";
|
||
|
|
$QUESTION{'id'} = $FORM{'qid'};
|
||
|
|
$QUESTION{'reload'} = "Y";
|
||
|
|
} else {
|
||
|
|
$QUESTION{'new'} = "N";
|
||
|
|
$QUESTION{'id'} = $FORM{'qid'};
|
||
|
|
}
|
||
|
|
$QUESTION{'thumbnail'} = &set_thumbnail(1);
|
||
|
|
### DED 9/09/02 reversed order of 2 below
|
||
|
|
&build_question_select_list();
|
||
|
|
$QUESTION{'choices'} = &build_choices();
|
||
|
|
$show_template = "qdef";
|
||
|
|
} elsif ($FORM{'frm'} eq '4') {
|
||
|
|
# replace question
|
||
|
|
$FORM{'respmsg'}="";
|
||
|
|
if ($FORM{'archival'} eq 'Y') {
|
||
|
|
&archive_test_results($TEST{'id'},$SESSION{'clid'});
|
||
|
|
}
|
||
|
|
if (substr($FORM{'newqid'},0,1) eq '*') {
|
||
|
|
# new question type
|
||
|
|
my $qtyp=$FORM{'qtp'};
|
||
|
|
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'});
|
||
|
|
$QUESTION{'qtp'} = $qtyp;
|
||
|
|
$QUESTION{'qim'} = "0";
|
||
|
|
$QUESTION{'layout1chk'} = $TEST{'layout1chk'};
|
||
|
|
$QUESTION{'layout2chk'} = $TEST{'layout2chk'};
|
||
|
|
$QUESTION{'layout3chk'} = $TEST{'layout3chk'};
|
||
|
|
$QUESTION{'layout4chk'} = $TEST{'layout4chk'};
|
||
|
|
$QUESTION{'layout5chk'} = $TEST{'layout5chk'};
|
||
|
|
$QUESTION{'layout'} = $TEST{'layout'};
|
||
|
|
$QUESTION{'qca'} = "";
|
||
|
|
$QUESTION{'qia'} = "";
|
||
|
|
$specialtypes = "mcs\;mcm\;mch\;ord\;mca\;";
|
||
|
|
if ($specialtypes =~ /$qtyp/ ) {
|
||
|
|
$choicecount = int($FORM{'numanswers'});
|
||
|
|
for (1 .. $choicecount) {
|
||
|
|
$QUESTION{'qia'} = join('', $QUESTION{'qia'} ,"$_\n");
|
||
|
|
}
|
||
|
|
if (($qtyp eq 'ord') || ($qtyp eq 'mch')) {
|
||
|
|
$QUESTION{'qca'} = $QUESTION{'qia'};
|
||
|
|
$QUESTION{'qia'} = "";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
for (keys %QUESTION) {
|
||
|
|
$FORM{$_}=$QUESTION{$_};
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# from existing question
|
||
|
|
©_question_image($SESSION{'clid'}, $FORM{'newqid'}, $FORM{'qid'});
|
||
|
|
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $FORM{'newqid'});
|
||
|
|
for (keys %QUESTION) {
|
||
|
|
$FORM{$_}=$QUESTION{$_};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$QUESTION{'id'}=$FORM{'qid'};
|
||
|
|
&put_question_definition($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'});
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Saved Qid $FORM{'qid'}");
|
||
|
|
$QUESTION{'new'} = "N";
|
||
|
|
$FORM{'respmsg'} = join('',$FORM{'respmsg'},"Question replaced.");
|
||
|
|
$QUESTION{'id'} = $FORM{'qid'};
|
||
|
|
$QUESTION{'reload'} = "Y";
|
||
|
|
$QUESTION{'thumbnail'} = &set_thumbnail(1);
|
||
|
|
&build_question_select_list();
|
||
|
|
$QUESTION{'choices'} = &build_choices();
|
||
|
|
$show_template = "qdef";
|
||
|
|
} elsif ($FORM{'frm'} eq '5') {
|
||
|
|
# clone question
|
||
|
|
my $baseqid=$FORM{'qid'};
|
||
|
|
my $firstcloneid=&get_question_number($TEST{'id'}, $SESSION{'clid'});
|
||
|
|
my $cloneid="";
|
||
|
|
my $i;
|
||
|
|
my $n=$FORM{'clonecnt'};
|
||
|
|
for $i (1 .. $n) {
|
||
|
|
$cloneid=&get_question_number($TEST{'id'}, $SESSION{'clid'});
|
||
|
|
©_question_image($SESSION{'clid'}, $baseqid, $cloneid);
|
||
|
|
$FORM{'qid'}=$baseqid;
|
||
|
|
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $baseqid);
|
||
|
|
for (keys %QUESTION) {
|
||
|
|
$FORM{$_}=$QUESTION{$_};
|
||
|
|
}
|
||
|
|
$FORM{'qid'}=$cloneid;
|
||
|
|
$QUESTION{'id'}=$cloneid;
|
||
|
|
$FORM{'new'} = 'Y';
|
||
|
|
&put_question_definition($TEST{'id'}, $SESSION{'clid'}, $cloneid);
|
||
|
|
$FORM{'new'} = 'N';
|
||
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Saved Qid $FORM{'qid'}");
|
||
|
|
$cloneid=&get_question_number($TEST{'id'}, $SESSION{'clid'});
|
||
|
|
}
|
||
|
|
$FORM{'qid'}=$firstcloneid;
|
||
|
|
$QUESTION{'id'}=$firstcloneid;
|
||
|
|
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $firstcloneid);
|
||
|
|
$QUESTION{'id'}=$FORM{'qid'};
|
||
|
|
$QUESTION{'new'} = "N";
|
||
|
|
$FORM{'respmsg'} = "Question cloned.";
|
||
|
|
$QUESTION{'id'} = $FORM{'qid'};
|
||
|
|
$QUESTION{'reload'} = "Y";
|
||
|
|
$QUESTION{'thumbnail'} = &set_thumbnail(1);
|
||
|
|
&build_question_select_list();
|
||
|
|
$QUESTION{'choices'} = &build_choices();
|
||
|
|
$show_template = "qdef";
|
||
|
|
} else {
|
||
|
|
&show_illegal_access_warning;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ( $show_template ) {
|
||
|
|
&show_template($show_template);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub archive_test_results {
|
||
|
|
my ($testid,$clid) = @_;
|
||
|
|
my $coredir = $testcomplete;
|
||
|
|
my $treebranches=$testcomplete;
|
||
|
|
$treebranches=~ s/^$docroot//g;
|
||
|
|
my $archdir="$archiveroot$treebranches";
|
||
|
|
|
||
|
|
&opendebug();
|
||
|
|
print DBGFILE "archival:$coredir:$archdir\n";
|
||
|
|
&closedebug();
|
||
|
|
|
||
|
|
# create the archive tree if it doesn't already exist
|
||
|
|
&make_tree($archdir);
|
||
|
|
|
||
|
|
# get the files to archive
|
||
|
|
opendir (TMPDIR, "$coredir");
|
||
|
|
my @dots=readdir(TMPDIR);
|
||
|
|
closedir TMPDIR;
|
||
|
|
my $test="^$clid\.(.*)\.$testid";
|
||
|
|
my @tests=grep( /$test/ , @dots);
|
||
|
|
|
||
|
|
my $fsize;
|
||
|
|
my $filedata;
|
||
|
|
my $chmodok;
|
||
|
|
for $i (0 .. $#tests) {
|
||
|
|
$test=$tests[$i];
|
||
|
|
$copyfm=join($pathsep,$coredir,$test);
|
||
|
|
$copyto=join($pathsep,$archdir,$test);
|
||
|
|
|
||
|
|
open (IMGFILE, "<$copyfm");
|
||
|
|
binmode(IMGFILE);
|
||
|
|
$fsize = (stat(IMGFILE))[7];
|
||
|
|
read(IMGFILE, $filedata, $fsize);
|
||
|
|
close IMGFILE;
|
||
|
|
&opendebug();
|
||
|
|
print DBGFILE "archival:$copyfm\n";
|
||
|
|
&closedebug();
|
||
|
|
open (IMGFILE, ">$copyto") or $msg="failed";
|
||
|
|
if ($msg ne "failed") {
|
||
|
|
binmode(IMGFILE);
|
||
|
|
print IMGFILE $filedata;
|
||
|
|
close IMGFILE;
|
||
|
|
$chmodok = chmod 0666, $prefile;
|
||
|
|
}
|
||
|
|
&opendebug();
|
||
|
|
print DBGFILE "archival:$copyto:$chmodok\n";
|
||
|
|
&closedebug();
|
||
|
|
}
|
||
|
|
&purge_tests($clid,$testid);
|
||
|
|
$FORM{'respmsg'} = "$testid results archived and ";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub purge_tests {
|
||
|
|
my ($clid, $testid) = @_;
|
||
|
|
my $rmfile;
|
||
|
|
my $ulinkfile;
|
||
|
|
my $cnt;
|
||
|
|
my @dots=();
|
||
|
|
my @purgedirs=('$testpending','$testinprog','$testcomplete');
|
||
|
|
for $i (0 .. $#purgedirs) {
|
||
|
|
opendir(DIR, "$purgedirs[$i]");
|
||
|
|
@dots = readdir(DIR);
|
||
|
|
closedir DIR;
|
||
|
|
foreach $rmfile (@dots) {
|
||
|
|
if ($rmfile =~ /^$clid\.(.*)\.$testid/ ) {
|
||
|
|
$ulinkfile = join($pathsep, $purgedirs[$i], $rmfile);
|
||
|
|
&opendebug();
|
||
|
|
print DBGFILE "purging:$ulinkfile\n";
|
||
|
|
&closedebug();
|
||
|
|
$cnt = unlink $ulinkfile;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@dots = ();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
### DED 10/24/2002 Moved to qlib.pl so can also be accessed by creports.pl
|
||
|
|
#sub build_question_select_list {
|
||
|
|
### DED 09/06/2007 Moved to qlib.pl so can also be accessed by upimage.pl
|
||
|
|
#sub put_question_image {
|
||
|
|
#sub remove_question_image {
|
||
|
|
#sub copy_question_image {
|
||
|
|
#sub set_thumbnail {
|
||
|
|
|
||
|
|
sub build_choices {
|
||
|
|
$formatted_html="";
|
||
|
|
if ($QUESTION{'qtp'} eq 'mca') {
|
||
|
|
$formatted_html=&format_choices("qca","qia", 0);
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'mcs') {
|
||
|
|
$formatted_html=&format_choices("qca","qia", 0, "RADIO");
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'mcm') {
|
||
|
|
$formatted_html=&format_choices("qca","qia", 0, "CHECKBOX");
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'mtx') {
|
||
|
|
$formatted_html=&format_matrix("qca","qia", "CHECKBOX");
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'mtr') {
|
||
|
|
$formatted_html=&format_matrix("qca","qia", "RANK");
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'mch') {
|
||
|
|
$formatted_html=&format_matches("qca","qia", 0);
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'ord') {
|
||
|
|
$formatted_html=&format_ordered("qca", 0);
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'tf') {
|
||
|
|
$FORM{'numanswers'} = 2;
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'esa') {
|
||
|
|
$FORM{'numanswers'} = 1;
|
||
|
|
} elsif ($QUESTION{'qtp'} eq 'nrt') {
|
||
|
|
$FORM{'numanswers'} = 1;
|
||
|
|
}
|
||
|
|
return $formatted_html;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_ordered {
|
||
|
|
$choiceno = 0;
|
||
|
|
$choicehtml="";
|
||
|
|
$choicelist = $QUESTION{$_[0]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist = split(/\n/, $choicelist);
|
||
|
|
foreach (0 .. $#choicelist) {
|
||
|
|
if ($_[1] == 1) {
|
||
|
|
$imgstring = "<INPUT TYPE=FILE NAME=\"filchoice$_\" SIZE=\"35\">";
|
||
|
|
} else {
|
||
|
|
$imgstring = "<INPUT TYPE=TEXT NAME=\"txtchoice$choiceno\" SIZE=\"50\" VALUE=\"$choicelist[$_]\" onKeyPress=\"languagesupport(this)\" onFocus=\"return tGotFocus(this)\" onBlur=\"return onConvert(this)\">";
|
||
|
|
}
|
||
|
|
$item_html="
|
||
|
|
<TR>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
\ \;
|
||
|
|
</TD>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
$imgstring
|
||
|
|
</TD>
|
||
|
|
</TR>\n";
|
||
|
|
$choicehtml = join('', $choicehtml, $item_html);
|
||
|
|
$choiceno++;
|
||
|
|
}
|
||
|
|
@choicelist=();
|
||
|
|
$FORM{'numanswers'} = $choiceno;
|
||
|
|
return $choicehtml;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_matches {
|
||
|
|
$choiceno = 0;
|
||
|
|
$choicehtml="";
|
||
|
|
$choicelist = $QUESTION{$_[0]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist = split(/\n/, $choicelist);
|
||
|
|
$choicelist = $QUESTION{$_[1]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist2 = split(/\n/, $choicelist);
|
||
|
|
foreach (0 .. $#choicelist) {
|
||
|
|
$item_html=&make_matchhtml($choiceno,$choicelist[$_], $choicelist2[$_], $_[2]);
|
||
|
|
$choicehtml = join('', $choicehtml, $item_html);
|
||
|
|
$choiceno++;
|
||
|
|
}
|
||
|
|
@choicelist=();
|
||
|
|
$FORM{'numanswers'} = $choiceno;
|
||
|
|
return $choicehtml;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub make_matchhtml {
|
||
|
|
my $value;
|
||
|
|
if ($_[3] == 1) {
|
||
|
|
$imgstring = "<INPUT TYPE=FILE NAME=\"filchoice$_[0]\" SIZE=\"35\"><BR>";
|
||
|
|
} else {
|
||
|
|
$value = escape_special_chars( $_[2] );
|
||
|
|
$imgstring = "<INPUT TYPE=TEXT NAME=\"txtchoice$_[0]\" SIZE=\"35\" VALUE=\"$value\" onKeyPress=\"languagesupport(this)\" onFocus=\"return tGotFocus(this)\" onBlur=\"return onConvert(this)\"><BR>";
|
||
|
|
}
|
||
|
|
$value = escape_special_chars( $_[1] );
|
||
|
|
$retstring = "
|
||
|
|
<TR>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
<INPUT TYPE=TEXT NAME=\"choice$_[0]\" SIZE=\"20\"VALUE=\"$value\" onKeyPress=\"languagesupport(this)\" onFocus=\"return tGotFocus(this)\" onBlur=\"return onConvert(this)\">
|
||
|
|
</TD>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
$imgstring
|
||
|
|
</TD>
|
||
|
|
</TR>\n";
|
||
|
|
return $retstring;
|
||
|
|
}
|
||
|
|
|
||
|
|
# input: qca, qia, type (CHECKBOX or RANK)
|
||
|
|
sub format_matrix {
|
||
|
|
if ($_[2] eq "CHECKBOX") {
|
||
|
|
# Initialize choice matrix to blanks
|
||
|
|
for ($i=0; $i<$FORM{'numarows'}; $i++) {
|
||
|
|
for ($j=0; $j<$FORM{'numacols'}; $j++) {
|
||
|
|
$chmatrix[$i][$j]="";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# For each qca entry, put a "CHECKED" in choice matrix
|
||
|
|
$choicelist = $QUESTION{$_[0]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist = split(/\n/, $choicelist);
|
||
|
|
foreach (0 .. $#choicelist) {
|
||
|
|
($chrow,$chcol) = split("-", $choicelist[$_]);
|
||
|
|
$chmatrix[$chrow][$chcol] = "CHECKED";
|
||
|
|
}
|
||
|
|
@choicelist=();
|
||
|
|
}
|
||
|
|
|
||
|
|
# Split qia into row and col headers or individual labels
|
||
|
|
$hdrlist = $QUESTION{$_[1]};
|
||
|
|
$hdrlist =~ s/\r//g;
|
||
|
|
@hdrlist = split(/::/, $hdrlist);
|
||
|
|
if ($hdrlist[0] =~ /\n/) {
|
||
|
|
@rowlist = split(/\n/, $hdrlist[0]);
|
||
|
|
@collist = split(/\n/, $hdrlist[3]);
|
||
|
|
$rowcount = $hdrlist[1];
|
||
|
|
$colcount = $hdrlist[2];
|
||
|
|
} else {
|
||
|
|
$rowcount = $hdrlist[0];
|
||
|
|
$colcount = $hdrlist[1];
|
||
|
|
@lbllist = split(/\n/, $hdrlist[2]);
|
||
|
|
}
|
||
|
|
@hdrlist = ();
|
||
|
|
|
||
|
|
# Build matrix html
|
||
|
|
$choicehtml = "<table border=2>\n";
|
||
|
|
if ($#lbllist == -1) {
|
||
|
|
$choicehtml .= " <tr>\n <td> </td>\n";
|
||
|
|
foreach (0 .. $colcount-1) {
|
||
|
|
$choicehtml .= " <td><input type=text name=col$_ value=\"$collist[$_]\" size=12></td>\n";
|
||
|
|
}
|
||
|
|
$choicehtml .= "</tr>\n";
|
||
|
|
}
|
||
|
|
$ilbl = 0;
|
||
|
|
foreach $row (0 .. $rowcount-1) {
|
||
|
|
$choicehtml .= "<tr>";
|
||
|
|
if ($#lbllist == -1) {
|
||
|
|
$choicehtml .= " <td><input type=text name=row$row value=\"$rowlist[$row]\"></td>\n";
|
||
|
|
}
|
||
|
|
foreach (0 .. $colcount-1) {
|
||
|
|
$choicehtml .= " <td align=center>";
|
||
|
|
if ($#lbllist != -1) {
|
||
|
|
$choicehtml .= "<nobr><input type=text name=lbl$row$_ value=\"$lbllist[$ilbl]\"> ";
|
||
|
|
}
|
||
|
|
if ($_[2] eq "CHECKBOX") {
|
||
|
|
$choicehtml .= "<input type=checkbox name=ch$row$_ $chmatrix[$row][$_]>";
|
||
|
|
} else {
|
||
|
|
$choicehtml .= "<select name=ch$row$_>";
|
||
|
|
$choicehtml .= "<option value=''>\ \;</option>";
|
||
|
|
$choicehtml .= &build_number_select_list($QUESTION{'rankmin'},$QUESTION{'rankmax'},$QUESTION{'rankstep'});
|
||
|
|
$choicehtml .= "</select>";
|
||
|
|
}
|
||
|
|
if ($#lbllist != -1) {
|
||
|
|
$choicehtml .= "</nobr>";
|
||
|
|
}
|
||
|
|
$choicehtml .= "</td>\n";
|
||
|
|
$ilbl++;
|
||
|
|
}
|
||
|
|
$choicehtml .= "</tr>\n";
|
||
|
|
}
|
||
|
|
$choicehtml .= "</table>\n";
|
||
|
|
$FORM{'numarows'} = $rowcount;
|
||
|
|
$FORM{'numacols'} = $colcount;
|
||
|
|
@rowlist = ();
|
||
|
|
@collist = ();
|
||
|
|
@lbllist = ();
|
||
|
|
return $choicehtml;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_choices {
|
||
|
|
$forcetoend = "";
|
||
|
|
$forcetolast = "";
|
||
|
|
$choiceno = 0;
|
||
|
|
$choicehtml="";
|
||
|
|
$choicelist = $QUESTION{$_[0]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist = split(/\n/, $choicelist);
|
||
|
|
foreach (0 .. $#choicelist) {
|
||
|
|
$choice = $choicelist[$_];
|
||
|
|
if ($choice ne '') {
|
||
|
|
$item_html=&make_choicehtml($choiceno,$choice, "CHECKED", $_[2], $_[3]);
|
||
|
|
if ($choice =~ /none of/i ) {
|
||
|
|
$forcetolast = $item_html;
|
||
|
|
} elsif ($choice =~ /all of/i ) {
|
||
|
|
$forcetoend = $item_html;
|
||
|
|
} else {
|
||
|
|
$choicehtml = join('', $choicehtml, $item_html);
|
||
|
|
}
|
||
|
|
$choiceno++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@choicelist=();
|
||
|
|
$choicelist = $QUESTION{$_[1]};
|
||
|
|
$choicelist =~ s/\r//g;
|
||
|
|
@choicelist = split(/\n/, $choicelist);
|
||
|
|
foreach (0 .. $#choicelist) {
|
||
|
|
$choice = $choicelist[$_];
|
||
|
|
if ($choice ne '') {
|
||
|
|
$item_html=&make_choicehtml($choiceno, $choice, "", $_[2], $_[3]);
|
||
|
|
if ($choice =~ /none of/i ) {
|
||
|
|
$forcetolast = $item_html;
|
||
|
|
} elsif ($choice =~ /all of/i ) {
|
||
|
|
$forcetoend = $item_html;
|
||
|
|
} else {
|
||
|
|
$choicehtml = join('', $choicehtml, $item_html);
|
||
|
|
}
|
||
|
|
$choiceno++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($forcetoend ne '') {
|
||
|
|
$choicehtml = join('', $choicehtml, $forcetoend);
|
||
|
|
}
|
||
|
|
if ($forcetolast ne '') {
|
||
|
|
$choicehtml = join('', $choicehtml, $forcetolast);
|
||
|
|
}
|
||
|
|
$FORM{'numanswers'} = $choiceno;
|
||
|
|
return $choicehtml;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub make_choicehtml {
|
||
|
|
$txtlength=50;
|
||
|
|
$SYSTEM{'txtlength'} = $txtlength;
|
||
|
|
my $value;
|
||
|
|
if ($_[3] == 1) {
|
||
|
|
$imgstring = "<INPUT TYPE=FILE NAME=\"filchoice$_[0]\" SIZE=\"35\">";
|
||
|
|
} else {
|
||
|
|
$imgstring = "";
|
||
|
|
}
|
||
|
|
if ($_[4] eq 'TEXT') {
|
||
|
|
$txtlength=25;
|
||
|
|
$value = escape_special_chars( $_[1] );
|
||
|
|
$inptypstring="<INPUT TYPE=TEXT NAME=\"choice$_[0]\" SIZE=\"$txtlength\" VALUE=\"$value\" onKeyPress=\"languagesupport(this)\" onFocus=\"return tGotFocus(this)\" onBlur=\"return onConvert(this)\">";
|
||
|
|
} elsif ($_[4] eq 'RADIO') {
|
||
|
|
$inptypstring="<INPUT TYPE=RADIO NAME=\"choice\" VALUE=\"$_[0]\" $_[2]>";
|
||
|
|
} elsif ($_[4] eq 'CHECKBOX') {
|
||
|
|
$inptypstring="<INPUT TYPE=CHECKBOX NAME=\"choice$_[0]\" $_[2]>";
|
||
|
|
} else {
|
||
|
|
$inptypstring="";
|
||
|
|
}
|
||
|
|
$value = escape_special_chars( $_[1] );
|
||
|
|
if ($QUESTION{'qtp'} eq 'mca') {
|
||
|
|
$retstring = "
|
||
|
|
<TR>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
<INPUT TYPE=TEXT NAME=\"txtchoice$_[0]\" SIZE=\"$txtlength\" VALUE=\"$value\" onKeyPress=\"languagesupport(this)\" onFocus=\"return tGotFocus(this)\" onBlur=\"return onConvert(this)\"><BR>
|
||
|
|
$imgstring\n";
|
||
|
|
} else {
|
||
|
|
$pxlength = ($txtlength * 7) + 28;
|
||
|
|
$retstring = "
|
||
|
|
<TR>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
$inptypstring
|
||
|
|
</TD>
|
||
|
|
<TD align\"center\" valign=\"top\">
|
||
|
|
<TEXTAREA style=\"height: 22px; width: $pxlength;\" NAME=\"txtchoice$_[0]\" WRAP=\"SOFT\" onKeyUp=\"changeTextarea(document.form1.txtchoice$_[0])\">$value</TEXTAREA><BR>
|
||
|
|
$imgstring\n";
|
||
|
|
}
|
||
|
|
if ($QUESTION{'qtp'} eq 'mca') {
|
||
|
|
$retstring2 = "
|
||
|
|
<FONT SIZE=2>
|
||
|
|
$xlatphrase[288]
|
||
|
|
<SELECT NAME=qnxt$_[0]>
|
||
|
|
<OPTION>$TEST{'questionlist'}
|
||
|
|
</SELECT>
|
||
|
|
</FONT>\n";
|
||
|
|
$retstring = join('',$retstring,$retstring2);
|
||
|
|
}
|
||
|
|
$retstring3 = "
|
||
|
|
</TD>
|
||
|
|
</TR>\n";
|
||
|
|
$retstring = join('',$retstring,$retstring3);
|
||
|
|
return $retstring;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub preview_question {
|
||
|
|
print "<!-- Previewing -->\n";
|
||
|
|
$QUESTION{'id'} = $FORM{'qid'};
|
||
|
|
$QUESTION{'tstid'} = $FORM{'tstid'};
|
||
|
|
$QUESTION{'new'} = $FORM{'new'};
|
||
|
|
$QUESTION{'qtx'} = $FORM{'qtx'};
|
||
|
|
$QUESTION{'qtx'} =~ s/\;/<BR>/g;
|
||
|
|
$QUESTION{'qtx'} =~ s/\n/<BR>/g;
|
||
|
|
$QUESTION{'qrm'} =~ s/\;/<BR>/g;
|
||
|
|
$QUESTION{'qrm'} =~ s/\n/<BR>/g;
|
||
|
|
$QUESTION{'qca'} = $FORM{'qca'};
|
||
|
|
$QUESTION{'qia'} = $FORM{'qia'};
|
||
|
|
$QUESTION{'flr'} = $FORM{'flr'};
|
||
|
|
print "<!-- $FORM{'layout'} $QUESTION{'layout'} -->\n";
|
||
|
|
print "<!-- $FORM{'qim'} $QUESTION{'flr'} -->\n";
|
||
|
|
if ($FORM{'qim'} ne '0') {
|
||
|
|
if ($FORM{'qim'} eq '1') {
|
||
|
|
$QUESTION{'illustration'} = &set_thumbnail(1);
|
||
|
|
} elsif ($FORM{'qim'} eq '2') {
|
||
|
|
$QUESTION{'illustration'} = &set_thumbnail(2);
|
||
|
|
} elsif ($FORM{'qim'} eq '3') {
|
||
|
|
$QUESTION{'illustration'} = "<A NAME=\"qimage\" HREF=\"$QUESTION{'flr'}\" TARGET=\"referencepage\">Reference Page</A>";
|
||
|
|
} else {
|
||
|
|
$QUESTION{'illustration'} = "";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "<!-- $FORM{'qtp'} $QUESTION{'illustration'} -->\n";
|
||
|
|
if ($FORM{'qtp'} eq 'tf' ) {
|
||
|
|
$cmpare1 = lc($FORM{'qca'});
|
||
|
|
$cmpare2 = lc($xlatphrase[437]);
|
||
|
|
$cmpare3 = lc($xlatphrase[209]);
|
||
|
|
$cmpare4 = lc($xlatphrase[465]);
|
||
|
|
$cmpare5 = lc($xlatphrase[466]);
|
||
|
|
if (($cmpare1 eq $cmpare2) || ($cmpare1 eq $cmpare3)) {
|
||
|
|
$qanst=($cmpare1 eq $cmpare2) ? "CHECKED" : "";
|
||
|
|
$qansf=($cmpare1 eq $cmpare3) ? "CHECKED" : "";
|
||
|
|
$qanstftf = 1; $qanstfyn = 0;
|
||
|
|
} else {
|
||
|
|
$qanst=($cmpare1 eq $cmpare4) ? "CHECKED" : "";
|
||
|
|
$qansf=($cmpare1 eq $cmpare5) ? "CHECKED" : "";
|
||
|
|
$qanstftf = 0; $qanstfyn = 1;
|
||
|
|
}
|
||
|
|
print "<!-- $FORM{'qca'} $xlatphrase[437] $qanstftf $qanstfyn -->\n";
|
||
|
|
$qansphrt = ($qanstftf == 1) ? "$xlatphrase[437]" : "$xlatphrase[465]";
|
||
|
|
$qansphrf = ($qanstftf == 1) ? "$xlatphrase[209]" : "$xlatphrase[466]";
|
||
|
|
$qanslist = "
|
||
|
|
<INPUT TYPE=RADIO NAME=\"qan\" $qanst>$qansphrt<BR>
|
||
|
|
<INPUT TYPE=RADIO NAME=\"qan\" $qansf>$qansphrf<BR>
|
||
|
|
";
|
||
|
|
$tmpfile = "qtf";
|
||
|
|
} else {
|
||
|
|
if ($FORM{'qtp'} eq 'esa' ) {
|
||
|
|
$anslen = (length($FORM{'qca'}) * 2);
|
||
|
|
if ($anslen < 5) { $anslen = 5;}
|
||
|
|
$qanslist = "<INPUT TYPE=TEXT NAME=\"qan\" VALUE=\"$FORM{'qca'}\" SIZE=\"$anslen\">\n";
|
||
|
|
if ($QUESTION{'qtx'} =~ /<box>/ ) {
|
||
|
|
$QUESTION{'qtx'} =~ s/<box>/$qanslist/g;
|
||
|
|
$qanslist="";
|
||
|
|
}
|
||
|
|
$tmpfile = "qesa";
|
||
|
|
} elsif ($FORM{'qtp'} eq 'nrt' ) {
|
||
|
|
$qanslist = "<TEXTAREA NAME=\"qrs\" ROWS=12 COLS=50 onKeyPress=\"ta_onKeyPress(this.form)\" WRAP=ON></TEXTAREA><BR>\n";
|
||
|
|
$tmpfile = "qnrt";
|
||
|
|
} elsif (($FORM{'qtp'} eq 'mcs' ) || ($FORM{'qtp'} eq 'mca')) {
|
||
|
|
&build_answer_list("RADIO");
|
||
|
|
$tmpfile = "qmcs";
|
||
|
|
} elsif ($FORM{'qtp'} eq 'mcm' ) {
|
||
|
|
&build_answer_list("CHECKBOX");
|
||
|
|
$tmpfile = "qmcm";
|
||
|
|
} elsif ($FORM{'qtp'} eq 'mch' ) {
|
||
|
|
&build_matching_answer_list;
|
||
|
|
$tmpfile = "qmch";
|
||
|
|
} elsif ($FORM{'qtp'} eq 'ord' ) {
|
||
|
|
&build_answer_list("TEXT");
|
||
|
|
$tmpfile = "qord";
|
||
|
|
} else {
|
||
|
|
$Error = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$QUESTION{'anslist'} = $qanslist;
|
||
|
|
$TEST_SESSION{'navbuttons'} = "<input type=button name=\"button\" value=\"$xlatphrase[3]\" onClick=\"window.close()\">\n";
|
||
|
|
$QUESTION{'layout'} = $FORM{'layout'};
|
||
|
|
unless ($Error) {
|
||
|
|
@lines = &get_template($tmpfile);
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
foreach $line (@lines) {
|
||
|
|
# $srch = "<%=QUESTION.anslist%>";
|
||
|
|
# if ( $line =~ m/$srch/i) {
|
||
|
|
# print "$qanslist";
|
||
|
|
# } else {
|
||
|
|
$line = &xlatline($line);
|
||
|
|
# }
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub build_answer_list {
|
||
|
|
my ($btntyp) = @_;
|
||
|
|
my @albls=();
|
||
|
|
$forcetoend = "";
|
||
|
|
$qanslist="";
|
||
|
|
@qca = split(/\;/, $FORM{'qca'});
|
||
|
|
@qia = split(/\;/, $FORM{'qia'});
|
||
|
|
if ($btntyp eq 'TEXT') {
|
||
|
|
for (0 .. $#qca) {
|
||
|
|
push @qans, "$qca[$_]\&$_";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if ($FORM{'qalb'} eq 'a') { push @albls, ('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y');}
|
||
|
|
if ($FORM{'qalb'} eq 'A') { push @albls, ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y');}
|
||
|
|
if ($FORM{'qalb'} eq 'n') { push @albls, (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);}
|
||
|
|
if ($FORM{'qalb'} eq 'r') { push @albls, (i,ii,iii,iv,v,vi,vii,viii,ix,x,xi,xii,xiii,xiv,xv,xvi,xvii,xviii,xix,xx,xxi,xxii,xxiii,xxiv,xxv);}
|
||
|
|
if ($FORM{'qalb'} eq 'R') { push @albls, (I,II,III,IV,V,VI,VII,VIII,IX,X,XI,XII,XIII,XIV,XV,XVI,XVII,XVIII,XIX,XX,XXI,XXII,XXIII,XXIV,XXV);}
|
||
|
|
for (0 .. $#qca) {
|
||
|
|
if (($qca[$_] =~ /all of/i ) || ($qca[$_] =~ /none of/i )) {
|
||
|
|
$forcetoend="$qca[$_]\&CHECKED";
|
||
|
|
} else {
|
||
|
|
push @qtans, "$qca[$_]\&CHECKED";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
for (0 .. $#qia) {
|
||
|
|
if (($qia[$_] =~ /all of/i ) || ($qia[$_] =~ /none of/i )) {
|
||
|
|
$forcetoend="$qia[$_]\&";
|
||
|
|
} else {
|
||
|
|
push @qtans, "$qia[$_]\&";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
### DED 9/18/02 Don't want to sort answers on svy or dmg!!
|
||
|
|
if (($TEST{'seq'} eq 'svy') || ($TEST{'seq'} eq 'dmg')) {
|
||
|
|
@qans = @qtans;
|
||
|
|
} else {
|
||
|
|
@qans = sort @qtans;
|
||
|
|
}
|
||
|
|
if ($forcetoend ne '') {
|
||
|
|
push @qans, $forcetoend;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$i = 0;
|
||
|
|
for (0 .. $#qans) {
|
||
|
|
($qans, $checked) = split(/&/, $qans[$_]);
|
||
|
|
if ($btntyp eq 'TEXT') {
|
||
|
|
$i++;
|
||
|
|
$qanslistline = "<INPUT TYPE=TEXT SIZE=\"2\" NAME=\"qan\" VALUE=\"$i\"> $qans<BR>\n";
|
||
|
|
} else {
|
||
|
|
$qans = join(') ', $albls[$i++], $qans);
|
||
|
|
if ($btntyp eq 'RADIO') {
|
||
|
|
$qanslistline = "<INPUT TYPE=RADIO NAME=\"qan\" $checked> $qans<BR>\n";
|
||
|
|
} else {
|
||
|
|
$qanslistline = "<INPUT TYPE=CHECKBOX NAME=\"qan\" $checked> $qans<BR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$qanslist = join('', $qanslist, $qanslistline);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub build_matching_answer_list {
|
||
|
|
$qanslist="";
|
||
|
|
@qca = split(/\;/, $FORM{'qca'});
|
||
|
|
@qia = split(/\;/, $FORM{'qia'});
|
||
|
|
if ($FORM{'qalb'} eq 'a') { push @albls, ('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y');}
|
||
|
|
if ($FORM{'qalb'} eq 'A') { push @albls, ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y');}
|
||
|
|
if ($FORM{'qalb'} eq 'n') { push @albls, (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);}
|
||
|
|
if ($FORM{'qalb'} eq 'r') { push @albls, (i,ii,iii,iv,v,vi,vii,viii,ix,x,xi,xii,xiii,xiv,xv,xvi,xvii,xviii,xix,xx,xxi,xxii,xxiii,xxiv,xxv);}
|
||
|
|
if ($FORM{'qalb'} eq 'R') { push @albls, (I,II,III,IV,V,VI,VII,VIII,IX,X,XI,XII,XIII,XIV,XV,XVI,XVII,XVIII,XIX,XX,XXI,XXII,XXIII,XXIV,XXV);}
|
||
|
|
|
||
|
|
$qanslist = "<TABLE border=0>\n";
|
||
|
|
foreach (0 .. $#qca) {
|
||
|
|
$qtblrow = "<TR>
|
||
|
|
<TD align=\"left\">
|
||
|
|
<INPUT TYPE=TEXT SIZE=\"2\" NAME=\"qan$_\" VALUE=\"\">\ \;\ \;$qca[$_]\ \;
|
||
|
|
</TD>
|
||
|
|
<TD align=\"left\" WIDTH=80>\ \;\ \;</TD>
|
||
|
|
<TD align=\"left\">
|
||
|
|
<B>$albls[$_]\)</B> $qia[$_]
|
||
|
|
</TD>
|
||
|
|
</TR>\n";
|
||
|
|
$qanslist = join('', $qanslist, $qtblrow);
|
||
|
|
}
|
||
|
|
$qanslist = join('', $qanslist, "</TABLE>\n");
|
||
|
|
@qca=(); @qia=();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_question_number {
|
||
|
|
@qrecs = &get_question_list( $_[0], $_[1]);
|
||
|
|
$lastrec = $#qrecs;
|
||
|
|
if ($lastrec > 0) {
|
||
|
|
$qrec = $qrecs[$lastrec];
|
||
|
|
($lastid, $trash) = split(/&/, $qrec);
|
||
|
|
($lastt, $lastq) = split(/\./, $lastid);
|
||
|
|
$lastq++;
|
||
|
|
$lastid = join('.', $lastt, $lastq);
|
||
|
|
return $lastid;
|
||
|
|
} else {
|
||
|
|
return "$_[0].001";
|
||
|
|
}
|
||
|
|
}
|