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
225 lines
6.3 KiB
4 months ago
|
#!/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
|