#!/usr/local/bin/perl
# ---------------------------------------------------
# PERL program "qa.pl". This CGI script processes
# multiple choice questions and answers through
# a forms interface. This program ("qa.pl") handles
# the answer. It works in conjunction with
# "questioner.pl", which produces the questions
# forms interface.
# --- Mike Guidry Jan 6, 1996 ---
# ----------------------------------------------------
# ---------------------------------------
# Use backquotes to grab the date from
# the UNIX shell for possible later use.
# The "chop" command removes the newline
# from the end of $date.
# ---------------------------------------
chop($date=`date`);
# ------------------------------------------
# Flush buffers and print MIME Content-type
# Header for the output HTML file
# ------------------------------------------
# flush STDOUT buffer
$| = 1;
# write MIME data Content-type header
print "Content-type: text/html\n\n";
# -----------------------------
# Initialize the answer field
# -----------------------------
$contents{'ANSWER'}="noanswer";
# ---------------------------------------------------
# Now receive and parse client data. First check for
# POST and then for GET method. Parse accordingly.
# Method adapted from Ch. 8, "Foundations of
# World Wide Web Programming with HTML and
# CGI", E. Tittel, M. Gaither, S. Hassinger &
# M. Erwin (http://www.outer.net/twf/twf.html).
# ---------------------------------------------------
# check for the POST method
if ($ENV{'REQUEST_METHOD'} eq 'POST')
{
# How many bytes are we supposed to receive?
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# make a list of keyword/value pairs
@pairs = split(/&/, $buffer);
# cycle through each pair and decipher the values
foreach $pair (@pairs)
{
# get the name/value pair strings
($name, $value) = split(/=/, $pair);
# translate "+" to a space
$value =~ tr/+/ /;
# decipher ASCI hexidecimal escaped characters, if any
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# add the pair to a list keyed on the name of the variable
$contents{$name} = $value;
}
}
# Check for GET method
if ($ENV{'REQUEST_METHOD'} eq 'GET')
{
# make a list of keyword/value pairs
@pairs = split(/&/, $ENV{QUERY_STRING});
# cycle through each pair and decipher the values
foreach $pair (@pairs)
{
# get the name/value pair strings
($name, $value) = split(/=/, $pair);
# translate "+" to a space
$value =~ tr/+/ /;
# decipher ASCI hexidecimal escaped characters, if any
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# add the pair to a list keyed on the name of the variable
$contents{$name} = $value;
}
}
# --------------------------------------------
# The name-value pairs now in array $contents.
# After some book-keeping we will begin
# processing these name-value pairs.
# --------------------------------------------
# --------------------------------------------
# Set the values of some variable strings.
# Customize for your application by changing
# the values of these strings.
# --------------------------------------------
# Set following variable "true" to invoke diagnostics output,
# "false" to suppress (the default).
$diagnose="false";
# URL address for page initiating the quiz
# Note that the relative address /address ... means
# relative to the directory "htmldocs" on this server
$home="/mcguffey/quiz/quiz.html";
# String $quizurl holds url address of the script
# that produces the questions forms document
$quizurl="/cgi-bin/mcguffey/quiz/questioner.pl";
# String $helpfile holds url address of "helpfile.html"
$helpfile="/guidry/quiz/quizhelp.html";
# -------------------------------
# Output HTML <head> information
# -------------------------------
######### Output Verbatim Down to the Tag HTML #########
print <<"HTML";
<html>
<head>
<title> The Answer</title>
</head>
<BODY BGCOLOR="#101010" TEXT="#00ffff" LINK="#ffff00" VLINK="#ffff00"
ALINK="#ff0000">
<b>
<p>
<hr size=5pt>
HTML
######### End Block of Verbatim Output #########
# ----------------------------------------------------------------
# DIAGNOSTICS: If $diagnose="true" a set of shell environmental
# variables will be output to the www browser at this point that
# show technical details concerning the server, client, and
# CGI script. Normally $diagnose should be set "false". Note
# that $ENV{svar} is PERL's way of accessing the UNIX shell
# variable "svar".
# ----------------------------------------------------------------
if ($diagnose eq 'true')
{
print "<hr> <em> Environmental Diagnostics</em> - Invoked when
\$diagnose=\"true\". <hr>";
print "SERVER_SOFTWARE = $ENV{SERVER_SOFTWARE} \n <br>";
print "SERVER_NAME = $ENV{SERVER_NAME} \n <br>";
print "GATEWAY_INTERFACE = $ENV{GATEWAY_INTERFACE} \n <br>";
print "SERVER_PROTOCOL = $ENV{SERVER_PROTOCOL} \n <br>";
print "SERVER_PORT = $ENV{SERVER_PORT} \n <br>";
print "REQUEST_METHOD = $ENV{REQUEST_METHOD} \n <br>";
print "HTTP_ACCEPT = $ENV{HTTP_ACCEPT} \n <br>";
print "PATH_INFO = $ENV{PATH_INFO} \n <br>";
print "PATH_TRANSLATED = $ENV{PATH_TRANSLATED} \n <br>";
print "SCRIPT_NAME = $ENV{SCRIPT_NAME} \n <br>";
print "QUERY_STRING = $ENV{QUERY_STRING} \n <br>";
print "REMOTE_HOST = $ENV{REMOTE_HOST} \n <br>";
print "REMOTE_ADDR = $ENV{REMOTE_ADDR} \n <br>";
print "REMOTE_USER = $ENV{REMOTE_USER} \n <br>";
print "CONTENT_TYPE = $ENV{CONTENT_TYPE} \n <br>";
print "CONTENT_LENGTH = $ENV{CONTENT_LENGTH} \n <br>";
print "STANDARD INPUT = $buffer \n <br>";
}
# End optional diagnostics output
# ----------------------------------------
# Begin output of HTML <body> information
# ----------------------------------------
# ----------------------------------------------------------------
# Use hidden variable "qnumber" passed through forms to determine
# the original question number and identify the appropriate question
# file.
# ----------------------------------------------------------------
$qfile="/usr/local/etc/httpd/cgi-bin/mcguffey/quiz/questions/q".$contents{qnumber};
# -------------------------------------------------
# Open question file and read question into $line
# concatenating a line at a time until finished.
# -------------------------------------------------
open(QFILE,"$qfile") || die "can't open $qfile";
while (<QFILE>) # while lines to read
{
$line=$line.$_; # concatenate with next line
}
close(QFILE);
# ----------------
# remove newlines
# ----------------
$_=$line;
tr/\n/\ /;
$line=$_;
# -------------------------------------------------------------------------
# split on @ to separate "question", "answer choices", "correct answer",
# "amplification on correct answer", and "links to review material" fields.
# -------------------------------------------------------------------------
($question,$answers,$coran,$amp,$link)=split(/@/,$line);
# ----------------------------------------------
# Strip off the number of the question into
# the variable $qnum and the question without
# the number into $question and print question
# ----------------------------------------------
($qnum, $question)=split(/\$/, $question);
print "<img align=\"left\"
src=\"/guidry/quiz/Q-A.gif\">
<font size=\"+2\"><em>
QUESTION $qnum: </em> $question </font>
<br clear=\"all\">
<hr size=5pt> <font size=\"+1\">";
# ---------------------------------------------
# Spit the answer string on $ to separate the
# multiple choices and print them.
# ---------------------------------------------
@answers=split(/\$/,$answers); # split on $ as delimiter
foreach $one (@answers)
{
$x=index($one,".");
$la=substr($one,0,$x); # The letters A,B,C,D, ...
$ra=substr($one,$x+1); # Answer with A,B, ... stripped off
#-----------------------------------------------#
# remove blank spaces around $la #
# See p173 in Llama book (Learning Perl-Schwarz)#
#-----------------------------------------------#
$la=~ tr/\ //d;
print "$la. $ra <br>\n";
}
print "<hr>\n";
# -----------------------------------------------
# Decide whether answer is correct or incorrect
# and respond appropriately.
# -----------------------------------------------
$_=$coran; # First, remove any blank spaces around $coran
tr/\ //d; # See page 173 in Llama book (Learning Perl-Schwarz)
$coran=$_; # (Longer version of $coran=~ tr/\ //d; construction)
if ($contents{'ANSWER'} eq "noanswer")
{
print "<em>YOU DIDN'T CHOOSE AN ANSWER</em> !!\n Be sure to click a box
by one of the choices before clicking the \"Submit Forms\"
button.\n
Click the \"Back\" button on the browser to try again,
or click \"Next Question\" below to continue.\n"
}
else
{
if ($contents{'ANSWER'} eq $coran)
{
print "<p><em>CORRECT,</em> the answer is $coran.
$amp <br>" # Add amplification statement #
}
else
{
print "<p> Sorry, $contents{'ANSWER'}
is <em>INCORRECT.</em> The correct answer is
$coran.<br>"
}
}
if($contents{'ANSWER'} ne "noanswer")
{
print "<p>$link<p> \n"
}
#---------------------------------
# Output HTML footer information
#---------------------------------
print "<hr><a href=\"$quizurl\"><img border=\"0pt\" align=\"center\"
src=\"/guidry/quiz/Qbutton.gif\">
Next Question?</a>\n";
print " <a href=\"$home\"><img border=\"0pt\" align=\"center\"
src=\"/guidry/quiz/quitbutton.gif\">End Quiz?</a>\n";
print "<a href=\"$helpfile\"><img border=\"0pt\" align=\"center\"
src=\"/guidry/quiz/helpbutton.gif\">Help</a>\n ";
print "</font>\n";
######### Output Verbatim Down to the Tag HTML #########
print <<"HTML";
<hr size=10pt>
<a href=
"http://csep1.phy.ornl.gov/guidry/mwgprofile.html"><b>Mike Guidry:</b></a>
<i><a href="mailto:[email protected]"[email protected]</a>
<a
href="http://csep1.phy.ornl.gov/guidry/mwg-root.html">http://csep1.phy.ornl.gov/guidry/mwg-root.html</a></i>
</b>
<hr size=10pt>
</body>
</html>
HTML
######### End Block of Verbatim Output #########
# ----------------------------------------------
# That completes the HTML going back to client
# ----------------------------------------------
exit;