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.

225 lines
6.3 KiB

#!/usr/bin/perl
#
# $Id: qlib.pl,v 1.4 2004/10/08 17:38:09 ddoughty Exp $
# Source File: qlib.pl
use CGI qw/:standard/;
sub build_question_select_list {
$questionlist = "";
@questions=&get_question_list($TEST{'id'}, $SESSION{'clid'});
$qflds = $questions[0];
chop($qflds);
@qflds = split(/&/, $qflds);
for (0 .. $#qflds) {
$QFIELDS{$qflds[$_]} = $_;
}
$idxid = $QFIELDS{'id'};
$idxqtp = $QFIELDS{'qtp'};
$idxqil = $QFIELDS{'qil'};
$idxsub = $QFIELDS{'subj'};
$idxtxt = $QFIELDS{'qtx'};
@qflds = ();
$qflds="";
for (1 .. $#questions) {
$qflds = $questions[$_];
chop ($qflds);
@qdata = split(/&/, $qflds);
($trash, $qnum) = split(/\./, $qdata[$idxid]);
$qobsind=($qdata[$idxqil] eq 'Y') ? '*' : "\ ";
### DED 9/11/02 Added marker for entry questions
$qentind=($TEST{'qent'} =~ /$qnum/) ? '>' : "\ ";
$qtext = substr($qdata[$idxtxt],0,20);
$listtext = sprintf("%s %3s %10s : %20s", $qnum, $qdata[$idxqtp], $qdata[$idxsub], $qtext);
$questionlist = join('', $questionlist, "<OPTION VALUE=\"$qdata[$idxid]\">$qobsind$qentind $listtext</OPTION>\n");
}
@qdata = ();
@questions = ();
$TEST{'questionlist'} = $questionlist;
}
sub build_question_answer_list {
$quesid = "";
$questxt = "";
$quesans = "";
$numans = 0;
@questions=&get_question_list($TEST{'id'}, $SESSION{'clid'});
$qflds = $questions[0];
chop($qflds);
@qflds = split(/&/, $qflds);
for (0 .. $#qflds) {
$QFIELDS{$qflds[$_]} = $_;
}
$idxid = $QFIELDS{'id'};
$idxqtp = $QFIELDS{'qtp'};
$idxtxt = $QFIELDS{'subj'};
$idxqtx = $QFIELDS{'qtx'};
$idxqca = $QFIELDS{'qca'};
$idxqia = $QFIELDS{'qia'};
@qflds = ();
$qflds="";
for (1 .. $#questions) {
$qflds = $questions[$_];
chop ($qflds);
@qdata = split(/&/, $qflds);
($trash, $qnum) = split(/\./, $qdata[$idxid]);
$quesid=join('&',$quesid,$qdata[$idxid]);
$questxt=join('&',$questxt,$qdata[$idxqtx]);
if ($qdata[$idxqtp] eq 'mcs' || $qdata[$idxqtp] eq 'mca' || $qdata[$idxqtp] eq 'tf' || $qdata[$idxqtp] eq 'esa') {
if ($qdata[$idxqca] eq '') {
$ansdata=$qdata[$idxqia];
} elsif ($qdata[$idxqia] eq '') {
$ansdata=$qdata[$idxqca];
} else {
$ansdata=join('\;',$qdata[$idxqca],$qdata[$idxqia]);
}
} elsif ($qdata[$idxqtp] eq 'mcm') {
if ($qdata[$idxqca] eq '') {
$ansdata=$qdata[$idxqia];
} elsif ($qdata[$idxqia] eq '') {
$ansdata=$qdata[$idxqca];
} else {
$ansdata=join('',$qdata[$idxqca],$qdata[$idxqia]);
}
} else {
$ansdata="";
}
$ansdata =~ s/^\;//;
$ansdata =~ s/\;$//;
@ansdata=split('\;',$ansdata);
if ($#ansdata > $numans) { $numans = $#ansdata }
$quesans=join('&',$quesans,$ansdata);
}
$quesid=substr($quesid,1);
$questxt=substr($questxt,1);
$quesans=substr($quesans,1);
@qdata = ();
@questions = ();
@ansdata=();
}
#($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'})
sub put_question_image {
my ($clid,$qid,$upfilename) = @_;
my $upfile;
my $msg;
my $chmodok;
if ($upfilename eq '') {
$upfilename = "$clid.$qid";
}
my $upimg = upload($upfilename);
my @fileparts = split(/\./, param($upfilename));
my $question_image_ext = $fileparts[$#fileparts];
@fileparts = ();
if ($question_image_ext ne "" && $SYSTEM{'supportedimagemedia'} =~ /$question_image_ext/i ) {
# remove any old images for this question
&remove_question_image($clid, $qid);
# write the uploaded file
$upfile = join($pathsep, $testgraphic, "$clid.$qid.$question_image_ext");
open (OUTFILE, ">$upfile") or $msg="failed";
if ($msg ne "failed") {
binmode(OUTFILE);
while ($bytesread=read($upimg,$buffer,1024)) {
print OUTFILE $buffer;
}
close OUTFILE;
$chmodok = chmod 0666, $upfile;
}
}
}
#($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'})
sub remove_question_image {
my ($clid,$qid) = @_;
my $prefile;
my $existingfile;
my $cnt;
my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
foreach $suext (@suexts) {
$prefile = join($pathsep, $testgraphic, "$clid.$qid");
$existingfile=&file_exists_with_extension($prefile, $suext);
if ($existingfile ne '') {
$cnt = unlink $existingfile;
}
}
}
sub copy_question_image {
my ($clid,$newqid,$qid) = @_;
my $prefile;
my $existingfile;
my $imgdata;
my $fsize;
my $chmodok;
my $msg;
my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
foreach $suext (@suexts) {
$prefile = join($pathsep, $testgraphic, "$clid.$newqid");
$existingfile=&file_exists_with_extension($prefile, $suext);
if ($existingfile ne '') {
$prefile = $existingfile;
$prefile =~ s/$newqid/$qid/g;
open (IMGFILE, "<$existingfile");
binmode(IMGFILE);
$fsize = (stat(IMGFILE))[7];
read(IMGFILE, $imgdata, $fsize);
close IMGFILE;
open (IMGFILE, ">$prefile") or $msg="failed";
if ($msg ne "failed") {
binmode(IMGFILE);
print IMGFILE $imgdata;
close IMGFILE;
$chmodok = chmod 0666, $prefile;
}
}
}
}
sub set_thumbnail {
$htmlreference="";
if ($QUESTION{'new'} eq "Y") {
if ($QUESTION{'qim'} ne '0') {
$imgfile = $FORM{'localimg'};
if ($_[0] eq '1') {
$htmlreference = "<A NAME=\"qimage\" HREF=\"file:///$imgfile\" TARGET=\"illustrated\">View</A>\n";
} elsif ($_[0] eq '2') {
$htmlreference = "<IMG NAME=\"qimage\" SRC=\"file:///$imgfile\">\n";
}
}
} else {
&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $QUESTION{'id'});
if ($QUESTION{'qim'} ne '0') {
if ($FORM{'localimg'} ne '') {
if ($QUESTION{'qim'} ne '0') {
$imgfile = $FORM{'localimg'};
if ($_[0] eq '1') {
$htmlreference = "<A NAME=\"qimage\" HREF=\"file:///$imgfile\" TARGET=\"illustrated\">View</A>\n";
} elsif ($_[0] eq '2') {
$htmlreference = "<IMG NAME=\"qimage\" SRC=\"file:///$imgfile\">\n";
}
}
} else {
$imgbase = join($pathsep, $testgraphic, "$SESSION{'clid'}.$QUESTION{'id'}");
$imgextopts = join('', $SYSTEM{'supportedimagemedia'},
$SYSTEM{'supportedaudiomedia'},
$SYSTEM{'supportedvideomedia'});
$imgfile = &file_exists_with_extension($imgbase, $imgextopts);
$imgfile =~ s/$testgraphic//g;
$imgfile =~ s/\///g;
if ($_[0] eq '1') {
$htmlreference = "<A NAME=\"qimage\" HREF=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$imgfile\" TARGET=\"illustrated\">View</A>\n";
} elsif ($_[0] eq '2') {
$htmlreference = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$imgfile\">\n";
}
}
}
}
return $htmlreference;
}
# end with True because this is a require file
1