#!/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, "\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 = (); my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'}); # if ($question_image_ext ne "" && $SYSTEM{'supportedimagemedia'} =~ /$question_image_ext/i ) if ($question_image_ext ne "" && $supportedmedia =~ /$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 $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'}); # my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'}); my @suexts = split(/\;/, $supportedmedia); 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 $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'}); # my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'}); my @suexts = split(/\;/, $supportedmedia); 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 = "View\n"; } elsif ($_[0] eq '2') { $htmlreference = "\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 = "View\n"; } elsif ($_[0] eq '2') { $htmlreference = "\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 = "View\n"; } elsif ($_[0] eq '2') { $htmlreference = "\n"; } } } } return $htmlreference; } # end with True because this is a require file 1