*** /dev/null Sat Nov 23 00:48:20 2024
--- - Sat Nov 23 00:48:25 2024
***************
*** 0 ****
--- 1,700 ----
+ #!/e/epaperwork/sw/bin/perl
+ ##
+ ## OSSP mct - Multiple Choice Test Engine
+ ## Copyright (c) 2002 Ralf S. Engelschall <rse@engelschall.com>
+ ## Copyright (c) 2002 The OSSP Project <http://www.ossp.org/>
+ ## Copyright (c) 2002 Cable & Wireless Deutschland <http://www.cw.com/de/>
+ ##
+ ## This file is part of OSSP mct, a multiple choice test engine
+ ## which can be found at http://www.ossp.org/pkg/tool/mct/.
+ ##
+ ## Permission to use, copy, modify, and distribute this software for
+ ## any purpose with or without fee is hereby granted, provided that
+ ## the above copyright notice and this permission notice appear in all
+ ## copies.
+ ##
+ ## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
+ ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
+ ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+ ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+ ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ ## SUCH DAMAGE.
+ ##
+ ## mct.cgi: multiple choice test CGI engine (language: Perl)
+ ##
+
+ # requirements
+ require 5.006;
+ use IO; # standard in Perl 5.6
+ use POSIX; # standard in Perl 5.6
+ use CGI; # standard in Perl 5.6
+ #use Mail::Sendmail; # standard in OpenPKG's Perl, else: CPAN!
+
+ # program configuration
+ my $MY = {
+ PROG_NAME => 'OSSP mct',
+ PROG_VERS => '1.0.0',
+ PROG_DESC => 'Multiple Choice Test Engine',
+ PROG_HOME => 'http://www.ossp.org/pkg/tool/mct/',
+ MAIL_FROM => 'mct@epaperwork.org',
+ MAIL_HOST => 'mail.epaperwork.org',
+ TEMPLATE => "<html>\n<head>\n\@HEAD\@\n</head>\n<body>\n\@BODY\@\n</body></html>"
+ };
+
+ # switch to unbuffered output
+ $|++;
+
+ # establish CGI object
+ my $CGI = new CGI;
+
+ # generate an HTTP response
+ sub http_response {
+ my ($head, $body) = @_;
+
+ # fill in template page
+ my $response = $MY->{TEMPLATE};
+ $response =~ s|\@HEAD\@|$head|sg;
+ $response =~ s|\@BODY\@|$body|sg;
+
+ # prepend with HTTP header
+ $response = $CGI->header(
+ -type => 'text/html',
+ -expires => 'now',
+ '-Content-length' => length($response)
+ ) . $response;
+
+ return $response;
+ }
+
+ # activate a general error handler
+ $SIG{__DIE__} = sub {
+ my ($err) = @_;
+
+ $err =~ s|at\s+\S+\s+line\s+(\d+)|(line $1)|s;
+ $err =~ s|\n|<br>\n|sg;
+ print STDOUT &http_response(
+ "<title>ePaperwork :: Multiple Choice Test: ERROR</title>",
+ "<h1>ePaperwork :: Multiple Choice Test: ERROR</h1>\n" .
+ "<pre>$err</pre>\n"
+ );
+ exit(0);
+ };
+
+ # convert Sugar-style markup text to HTML text
+ sub sug2html {
+ my ($text) = @_;
+
+ # escape HTML special characters
+ $text =~ s|&|&|sg;
+ $text =~ s|<|<|sg;
+ $text =~ s|>|>|sg;
+
+ # expand Sugar markup
+ $text =~ s/\|\|(.+?)\|\|/<tt>$1<\/tt>/sg;
+ $text =~ s|//(.+?)//|<i>$1</i>|sg;
+ $text =~ s|\*\*(.+?)\*\*|<b>$1</b>|sg;
+ $text =~ s|->(.+?)::(.+?)<-|<a href="$2" target="mct-extern">$1</a>|sg;
+ $text =~ s|->(.+?)<-|<a href="$1" target="mct-extern">$1</a>|sg;
+
+ return $text;
+ }
+
+ # read and parse MCT specification
+ sub readmct {
+ my ($name) = @_;
+
+ # read MCT specification
+ my $fh = new IO::File "<$name"
+ || die "unable to open MCT specification \"$name\"";
+ my $mct = '';
+ $mct .= $_ while (defined($_ = $fh->getline()));
+ $fh->close();
+
+ # provide line continuation feature
+ $mct =~ s|\s*\\\s*\n\s*| |sg;
+
+ # parse MCT specification
+ my $MCT = {
+ 'HEADER' => {},
+ 'RESULT' => [],
+ 'QUESTION' => []
+ };
+ $mct =~ s|^(.+?\n)\n(.+)$|&parse_header($1), &parse_body($2), ''|sge;
+
+ # parse header lines
+ sub parse_header {
+ my ($mct) = @_;
+ while ($mct =~ s|^([A-Za-z][A-Za-z0-9-]*):\s*(.*?)\n||s) {
+ if (not defined($MCT->{HEADER}->{uc($1)})) {
+ $MCT->{HEADER}->{uc($1)} = $2;
+ }
+ else {
+ $MCT->{HEADER}->{uc($1)} .= $2;
+ }
+ }
+ }
+
+ # parse body blocks
+ sub parse_body {
+ my ($mct) = @_;
+ $mct = "\n" . $mct . "\n";
+ $mct =~ s|\n\?\?\s+(.+?)\n(.+?\n)(?=\n)|&parse_question($1, $2), ''|sge;
+ $mct =~ s|\n==\s+(.+?)\n(.+?\n)(?=\n)|&parse_result($1, $2), ''|sge;
+ }
+
+ # parse a single question block
+ sub parse_question {
+ my ($title, $mct) = @_;
+ my $e = {
+ 'TITLE' => $title,
+ 'HINT' => '',
+ 'CHOICES' => []
+ };
+ foreach my $line (split(/\n/, $mct)) {
+ if ($line =~ m/^((?:!!))\s+(.+)$/s) {
+ $e->{HINT} = $2;
+ }
+ elsif ($line =~ m/^((?:--|\+\+))\s+(.+)$/s) {
+ my $c = { 'TYPE' => $1, 'TEXT' => $2 };
+ push(@{$e->{CHOICES}}, $c);
+ }
+ }
+ push(@{$MCT->{QUESTION}}, $e);
+ }
+
+ # parse a single result block
+ sub parse_result {
+ my ($title, $mct) = @_;
+ my $e = {
+ 'TITLE' => $title,
+ 'CHOICES' => []
+ };
+ foreach my $line (split(/\n/, $mct)) {
+ if ($line =~ m/^((?:--))\s+(\d+)-(\d+)\s+(.+)$/s) {
+ my $c = {
+ 'TYPE' => $1,
+ 'RANGE' => [$2, $3],
+ 'TEXT' => $4 };
+ push(@{$e->{CHOICES}}, $c);
+ }
+ }
+ push(@{$MCT->{RESULT}}, $e);
+ }
+
+ return $MCT;
+ }
+
+ # deterministically permutate an array
+ sub permute {
+ my ($k, @a) = @_;
+
+ my @b = ();
+ $k = ($k * ($#a+1)) / 9;
+ $k = 1 if ($k < 1);
+ $k = ($k % ($#a+1));
+ $k = 1 if ($k < 1);
+
+ my $i = $k/2;
+ while ($#a > -1) {
+ for (my $j = 0; $j < ($#a+1); $j++) {
+ my $x = shift(@a);
+ if (($i % $k) == 0) {
+ push(@b, $x);
+ }
+ else {
+ push(@a, $x);
+ }
+ $i++;
+ }
+ $k-- if ($k > 1);
+ }
+
+ return @b;
+ }
+
+ # adjust CGI environment to make sure that self-referencing
+ # URLs go again through the direct URL of the MCT file!!
+ $ENV{SCRIPT_NAME} = $ENV{PATH_INFO};
+ delete $ENV{REQUEST_URI};
+
+ # fetch CGI parameters
+ my $name = $CGI->path_translated();
+ my $form = $CGI->param('form') || '';
+ my $perm = $CGI->param('perm') || '';
+ my $hint = $CGI->param('hint') || '';
+ my $note = $CGI->param('note') || '';
+ my $serial = $CGI->param('serial') || '';
+
+ # sanity checks on CGI parameters
+ if ($name !~ m|\.mct$|) {
+ die "MCT specification \"$name\": invalid path name";
+ }
+ if (not -f $name) {
+ die "MCT specification \"$name\": file not found";
+ }
+ if ($perm ne '' and $perm !~ m/^[1-9]$/) {
+ die "Invalid \"perm\" parameter value \"$perm\"";
+ }
+ if ($hint ne '' and $hint !~ m/^[01]$/) {
+ die "Invalid \"hint\" parameter value \"$hint\"";
+ }
+ if ($note ne '' and $note !~ m/^[01]$/) {
+ die "Invalid \"note\" parameter value \"$note\"";
+ }
+ if ($serial ne '' and $serial !~ m/^\d+$/) {
+ die "Invalid \"serial\" parameter value \"$serial\"";
+ }
+
+ # read MCT specification
+ my $MCT = &readmct($name);
+
+ # XXX
+
+ # optionally read HTML page template
+ my $template = $name;
+ $template =~ s|\.mct$|.html|s;
+ my $fh = new IO::File "<$template" || die;
+ $MY->{TEMPLATE} = '';
+ $MY->{TEMPLATE} .= $_ while (<$fh>);
+ $fh->close();
+
+ # make sure the serial numbers match
+ if ($serial ne '') {
+ if ($serial ne $MCT->{HEADER}->{SERIAL}) {
+ die "Sorry, serial in request (#$serial) does not match current MCT serial (#".$MCT->{HEADER}->{SERIAL}.")";
+ }
+ }
+ $serial = $MCT->{HEADER}->{SERIAL};
+
+ # calculate query summary
+ my $summary = '';
+ sub summarynum {
+ my ($num) = @_;
+ return $num if ($num < 10);
+ return "{$num}";
+ }
+ my $nq = 0;
+ foreach my $q (@{$MCT->{QUESTION}}) {
+ $summary .= "," if ($summary ne '');
+ $summary .= &summarynum($nq);
+ $question = $CGI->param("q$nq");
+ my $nc = 0;
+ foreach my $c (@{$q->{CHOICES}}) {
+ my $choice = ($CGI->param("q$nq.c$nc") || ($question eq "c$nc"));
+ if ($choice) {
+ $summary .= &summarynum($nc);
+ }
+ $nc++;
+ }
+ $nq++;
+ }
+
+ # support Submit button
+ if ($form eq 'Send Notes') {
+ my $body = '';
+ $body .= "Dear author of the Multiple Choice Test \"".$MCT->{HEADER}->{NAME}."\",\n" .
+ "my current choice (".$CGI->url(-full => 1)."?choice=$summary)\n" .
+ "resulted in the following annotation notes for you.\n" .
+ "\n";
+ $nq = 0;
+ foreach my $q (@{$MCT->{QUESTION}}) {
+ my $an = ($CGI->param("q${nq}.an") || "");
+ if ($an ne '') {
+ $body .= "Question:\n" .
+ "| ".$q->{TITLE}."\n";
+ $an =~ s/^/| /mg;
+ $body .= "Note:\n".$an;
+ $body .= "\n\n";
+ }
+ $CGI->param("q${nq}.an", "");
+ $nq++;
+ }
+ my %mailcfg = (
+ 'To' => $MCT->{HEADER}->{"REPLY-TO"},
+ 'From' => $MY->{MAIL_FROM},
+ 'Subject' => "Notes on MCT \"".$MCT->{HEADER}->{NAME}."\"",
+ 'Message' => $body,
+ 'smtp' => $MY->{MAIL_HOST}
+ );
+ sendmail(%mailcfg) or die $Mail::Sendmail::error;
+ $CGI->param('note', 0);
+ $note = 0;
+ $form = " Rate! ";
+ }
+
+ # support Mail button
+ if ($form eq 'Mail') {
+ sub urlescape {
+ my ($text) = @_;
+ $text =~ s|([ \t&+?:/=\n\r])|sprintf("%%%02x", ord($1))|sge;
+ return $text;
+ }
+ my $subject = &urlescape("Result in MCT \"".$MCT->{HEADER}->{NAME}."\"");
+ my $body = &urlescape("Result: ".$CGI->url(-full => 1)."?choice=$summary");
+ print STDOUT $CGI->redirect(-uri => "mailto:".$MCT->{HEADER}->{"REPLY-TO"}."?subject=$subject&body=$body", -type => "text/plain");
+ exit(0);
+ }
+
+ # support Restart button by redirecting via GET
+ if ($form eq 'Restart') {
+ print STDOUT $CGI->redirect(-uri => $CGI->url(-full => 1), -type => "text/html");
+ exit(0);
+ }
+
+ # support Note button
+ if ($form eq 'Show Notes') {
+ $CGI->param('note', 1);
+ $note = 1;
+ }
+ elsif ($form eq 'Hide Notes') {
+ $CGI->param('note', 0);
+ $note = 0;
+ }
+
+ # support Hint button
+ if ($form eq 'Show Hints') {
+ $CGI->param('hint', 1);
+ $hint = 1;
+ }
+ elsif ($form eq 'Hide Hints') {
+ $CGI->param('hint', 0);
+ $hint = 0;
+ }
+
+ # calculate new permution index
+ if ($perm eq '') {
+ $perm = int((rand 8) + 1);;
+ $CGI->param('perm', $perm);
+ }
+
+ # support Bookmark button
+ if ($form eq 'Bookmark') {
+ # redirect to bookmark URL
+ # XXX print STDOUT $CGI->redirect($CGI->url(-full => 1)."?name=$name&perm=$perm&choice=$summary");
+ print STDOUT $CGI->redirect(-uri => $CGI->url(-full => 1)."?serial=$serial&perm=$perm&choice=$summary", -type => "text/plain");
+ exit(0);
+ }
+ if ($CGI->param('choice') ne '') {
+ # import choice from bookmark URL
+ my $choice = $CGI->param('choice');
+ sub nextnum {
+ my ($str) = @_;
+ my $num = '';
+ if ($str =~ m|^\{(\d+)\}(.*)$|s) {
+ ($num, $str) = ($1, $2);
+ }
+ elsif ($str =~ m|^(\d)(.*)$|s) {
+ ($num, $str) = ($1, $2);
+ }
+ elsif ($str =~ m|^.(.*)$|s) {
+ $str = $1;
+ }
+ return ($num, $str);
+ }
+ foreach $str (split(/,/, $choice)) {
+ my ($nq, $str) = &nextnum($str);
+ if ($nq ne '') {
+ if (defined($MCT->{QUESTION}->[$nq])) {
+ $q = $MCT->{QUESTION}->[$nq];
+ my $multichoice = 0;
+ foreach my $c (@{$q->{CHOICES}}) {
+ if ($c->{TYPE} eq '++') {
+ $multichoice++;
+ }
+ }
+ $multichoice = 0 if ($multichoice <= 1);
+ if ($multichoice) {
+ my $nc;
+ while ($str ne '') {
+ ($nc, $str) = &nextnum($str);
+ $CGI->param("q$nq.c$nc", "1");
+ }
+ }
+ else {
+ my ($nc, $str) = &nextnum($str);
+ $CGI->param("q$nq", "c$nc");
+ }
+ }
+ }
+ }
+ $form = " Rate! ";
+ }
+
+ # start generating the web page
+ my $head = '';
+ my $body = '';
+
+ $head .= "<title>ePaperwork :: Multiple Choice Test: ".
+ $MCT->{HEADER}->{TITLE}."</title>";
+
+ # import CSS
+ sub addcss {
+ my ($file) = @_;
+ $head .= "<style type=\"text/css\"><!--\n";
+ my $fh = new IO::File "<$file" || die;
+ $head .= $_ while (<$fh>);
+ $fh->close();
+ $head .= "--></style>\n";
+ }
+ my $css = $name;
+ $css =~ s|\.mct$|.css|s;
+ if (-f "$css") {
+ &addcss("$css");
+ }
+ if (-f "mct.css") {
+ &addcss("mct.css");
+ }
+
+ $body .= "<table width=100% cellspacing=0 cellpadding=1 border=0>";
+ $body .= "<tr><td colspan=2 class=mct-border>";
+ # XXX $body .= $CGI->startform(-method => "POST", -action => $CGI->url(-full => 1)."?name=$name");
+ $body .= $CGI->startform(-method => "POST", -action => $CGI->url(-full => 1));
+ #$body .= $CGI->hidden(-name => 'name', -default => [$name]);
+ $body .= $CGI->hidden(-name => 'perm', -default => [$perm]);
+ $body .= $CGI->hidden(-name => 'hint', -default => [$hint]);
+ $body .= $CGI->hidden(-name => 'note', -default => [$note]);
+ $body .= $CGI->hidden(-name => 'serial', -default => [$serial]);
+
+ $body .= "<table width=100% cellspacing=0 cellpadding=4 border=0>";
+ $body .= "<tr><td colspan=2 class=\"mct-header\">\n";
+ $body .= "<blockquote>\n";
+ $body .= &sug2html($MCT->{HEADER}->{TITLE});
+ $body .= "</blockquote>\n";
+ $body .= "</td></tr>";
+
+ # determine whether to enable cheat mode
+ my $cheat = 0;
+ if ($MCT->{HEADER}->{PASSWORD} ne '') {
+ $nq = 0;
+ foreach my $q (@{$MCT->{QUESTION}}) {
+ my $an = ($CGI->param("q${nq}.an") || "");
+ if (index($an, $MCT->{HEADER}->{PASSWORD}) > -1) {
+ $cheat = 1;
+ last;
+ }
+ $nq++;
+ }
+ }
+
+ my $r_questions = 0;
+ my $r_score = 0;
+
+ $nq = 0;
+ foreach my $q (@{$MCT->{QUESTION}}) {
+ $r_questions++;
+ my $col0 = ($nq % 2);
+ $body .= "<tr>\n";
+ $body .= "<td width=40% valign=top class=mct-qt$col0>" .
+ "<span class=\"mct-qt\">".&sug2html($q->{TITLE})."</span>";
+ my $multichoice = 0;
+ foreach my $c (@{$q->{CHOICES}}) {
+ if ($c->{TYPE} eq '++') {
+ $multichoice++;
+ }
+ }
+ if ($multichoice <= 1) {
+ $multichoice = 0;
+ }
+ if ($multichoice) {
+ $body .= "<br>($multichoice answers expected)";
+ }
+ if ($hint) {
+ if ($q->{HINT} ne '') {
+ $body .= "<br><span class=\"mct-hint\">Hint: ".&sug2html($q->{HINT})."</span>\n";
+ }
+ }
+ if ($note) {
+ $body .= "<br>" .
+ $CGI->textarea(-name => "q${nq}.an",
+ -default => ($CGI->param("q${nq}.an") || ""),
+ -rows => 3, -columns => "30%");
+ }
+ else {
+ $body .= $CGI->hidden(-name => "q${nq}.an", -default => [($CGI->param("q${nq}.an") || "")]);
+ }
+ $body .= "<p></td>\n";
+ $body .= "<td width=60% valign=top class=mct-qt$col0>" .
+ "<span class=\"mct-qc\">\n";
+ $body .= "<table width=100% cellspacing=0 cellpadding=0 border=0>\n";
+ my $nc = 0;
+ my $q_choices = 0;
+ my $q_score = 0;
+ my $q_ok = 0;
+ my @cells = ();
+ foreach my $c (@{$q->{CHOICES}}) {
+ $q_choices++;
+ my $choice = $CGI->param("q$nq.c$nc");
+ if (not $multichoice) {
+ $choice = $CGI->param("q$nq");
+ if ($choice eq "c$nc") {
+ $choice = 1;
+ }
+ else {
+ $choice = 0;
+ }
+ }
+ my $class = '';
+ if ($choice) {
+ if ($c->{TYPE} eq '++') {
+ $class = "OK";
+ $q_score++;
+ }
+ else {
+ $class = "BAD";
+ $q_score--;
+ }
+ }
+ else {
+ if ($c->{TYPE} eq '++') {
+ $class = "CHEAT" if ($form ne '' && $cheat);
+ }
+ }
+ if ($c->{TYPE} eq '++') {
+ $q_ok++;
+ }
+ my $cell = '';
+ if ($multichoice) {
+ $cell .= "<input ".($choice ? "checked " : "").
+ "type=\"checkbox\" name=\"q$nq.c$nc\" value=\"1\">";
+ }
+ else {
+ $cell .= "<input ".($choice ? "checked " : "").
+ "type=\"radio\" name=\"q$nq\" value=\"c$nc\">";
+ }
+ $cell .= " ".&sug2html($c->{TEXT})."<br>\n";
+ my $c = {
+ 'CLASS' => $class,
+ 'HTML' => $cell,
+ 'LENGTH' => length($c->{TEXT})
+ };
+ push(@cells, $c);
+ $nc++;
+ }
+
+ @cells = &permute($perm, @cells);
+
+ my $maxlen = 0;
+ foreach my $cell (@cells) {
+ if ($maxlen < $cell->{LENGTH}) {
+ $maxlen = $cell->{LENGTH};
+ }
+ }
+ my $cols = 1;
+ $cols = 2 if ($maxlen < 30);
+ $cols = 3 if ($maxlen < 10);
+ $cols = 4 if ($maxlen < 5);
+ my $rows = sprintf("%d", (($#cells+1) + ($cols - 1)) / $cols);
+ for (my $i = 0; $i < $rows; $i++) {
+ $body .= "<tr>\n";
+ for (my $j = 0; $j < $cols; $j++) {
+ my $cell = ($cells[$i+($j*$rows)] || { 'CLASS' => '', 'HTML' => ' '});
+ my $class = $cell->{CLASS};
+ if ($class eq '' or $class eq 'OK') {
+ my $col1 = ($i % 2);
+ $class = "$col0$col1";
+ }
+ $body .= "<td class=mct-qc$class>";
+ $body .= $cell->{HTML};
+ $body .= "</td>";
+ }
+ $body .= "</tr>\n";
+ }
+ $q_score = 0 if ($q_score < 0);
+ my $q_score = sprintf("%d", (($q_score / $q_ok) * 100));
+ $r_score += $q_score;
+ $body .= "</table>\n";
+ $body .= "</span><p></td>\n";
+ $body .= "</tr>\n";
+ $nq++;
+ }
+ $body .= "</table>\n";
+ my $result = sprintf("%d", ($r_score / $r_questions));
+
+ $body .= "</td></tr>";
+ $body .= "<tr>";
+ $body .= "<td align=left class=\"mct-button\">";
+ if ($form ne '') {
+ if ($note) {
+ $body .= "<span class=\"mct-button-switchnotes\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Hide Notes") . "\n";
+ $body .= "</span>";
+ $body .= "<span class=\"mct-button-sendnotes\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Send Notes") . "\n";
+ $body .= "</span>";
+ }
+ else {
+ $body .= "<span class=\"mct-button-switchnotes\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Show Notes") . "\n";
+ $body .= "</span>";
+ }
+ if ($hint) {
+ $body .= "<span class=\"mct-button-hints\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Hide Hints") . "\n";
+ $body .= "</span>";
+ }
+ else {
+ $body .= "<span class=\"mct-button-hints\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Show Hints") . "\n";
+ $body .= "</span>";
+ }
+ $body .= "<span class=\"mct-button-bookmark\">";
+ $body .= $CGI->submit(-name => 'form', -value => "Bookmark") . "\n";
+ $body .= "</span>";
+ $body .= "<span class=\"mct-button-mail\">" .
+ $CGI->submit(-name => 'form', -value => "Mail") .
+ "</span>\n";
+ }
+ $body .= ' ';
+ $body .= "</td>";
+ $body .= "<td align=right class=\"mct-button\">";
+ if ($form ne '') {
+ $body .= "<span class=\"mct-button-restart\">" .
+ $CGI->submit(-name => 'form', -value => "Restart") .
+ "</span>\n";
+ }
+ $body .= "<span class=\"mct-button-undo\">" .
+ $CGI->reset(-value => "Undo") .
+ "</span>\n";
+ $body .= "<b><span class=\"mct-button-rate\">" . $CGI->submit(-name => 'form', -value => " Rate! ") . "</span></b>\n";
+ #$body .= " ";
+ $body .= $CGI->endform;
+ $body .= "</td>";
+ $body .= "</tr>";
+ if ($form ne '') {
+ # display results
+ $body .= "<tr>";
+ $body .= "<td colspan=2 align=left class=\"mct-result\">";
+ $body .= "<p><blockquote>";
+ $body .= "You have achieved <span class=\"mct-result-percent\">${result}%</span> success in this multiple choice test.\n";
+ foreach my $r (@{$MCT->{RESULT}}) {
+ $body .= $r->{TITLE} . " ";
+ foreach my $c (@{$r->{CHOICES}}) {
+ if ($c->{RANGE}->[0] <= $result and $result <= $c->{RANGE}->[1]) {
+ $body .= &sug2html($c->{TEXT});
+ last;
+ }
+ }
+ $body .= "\n";
+ }
+ $body .= "<br><br></blockquote>";
+ $body .= "</td></tr>";
+ }
+ $body .= "<tr>";
+ $body .= "<td colspan=2 align=center class=\"mct-footer\">";
+ $body .= "<a href=\"".$MY->{PROG_HOME}."\">".$MY->{PROG_NAME}."</a> ".
+ $MY->{PROG_VERS}." - ".$MY->{PROG_DESC}."<br>\n";
+ $body .= "</td>";
+ $body .= "</tr>";
+ $body .= "</table>\n";
+ $body .= "\n";
+
+ print STDOUT &http_response($head, $body);
+
+ exit(0);
+
|
