#!/usr/local/bin/perl # # quiz - Choose a random selection of questions from a pool of questions # and conduct a quiz, calculating and displaying a score at the end. # # Written by Earl Fogel, March 1996 # # Changelog: # Apr 1996 - strip special characters from responses before comparing # - record answers on server to prevent cheating # Aug 1996 - use POST method for forms # - display credits at end of results page # Sep 1996 - make tmpdir configurable # - more detailed error messages # Feb 1997 - configurable HEADER, FOOTER and CREDITS for each quiz # # Feb 2002 - allow submit buttons of type 'image' #push(@INC,"/usr/local/etc/httpd/cgi-bin"); require "cgi-lib.pl"; # Configuration # most configuration is handled in the form which invokes this script $tmpdir = "/tmp"; # write temp files in a central location # $tmpdir = "."; # write temp files in the quiz directory # Read in all the variables set by the form if (&ReadParse(*input)) { $quizdir = purify($input{'quizdir'}); $quizhome = purify($input{'quizhome'}); $nquestions = purify($input{'nquestions'}); $choice = purify($input{'choice'}); $key = purify($input{'key'}); $debug = $input{'debug'} if defined($input{'debug'}); @questions = split(/ /, purify($input{'questions'})) if defined($input{'questions'}); @results = split(/ /, purify($input{'results'})) if defined($input{'results'}); } else { $quizdir = "/www/history/quiz.canada"; $quizhome = "http://www.usask.ca/cgi-bin/cgiwrap/history/quiz"; $nquestions = 10; # &Usage; } print &PrintHeader; chdir $quizdir || CgiDie("Can't find $quizdir quiz directory: $!\n"); # print a standard page header if (open(IN,'HEADER')) { @stuff = ; print @stuff; close(IN); } else { print <<'EOF'; Quiz EOF } # # maybe it's a button of type 'image' # if (!defined $choice) { foreach $field (keys %input) { if ($field =~ m/^(.*)\.x$/) { $choice = purify($1); } } } print "quizdir: $quizdir
\n" if $debug; print "quizhome: $quizhome
\n" if $debug; print "nquestions: $nquestions
\n" if $debug; print "choice: $choice
\n" if $debug; # first time through if (!defined(@results) && !defined(@questions)) { &ChooseQuestions; } print "questions: @questions
\n" if $debug; print "results: @results
\n" if $debug; if (!defined($key)) { &ChooseKey; } print "key: $key
\n" if $debug; if ($#questions>=0) { if ($choice) { &AnswerQuestion; } else { &AskQuestion; } } else { &ShowScore; } # print a standard page footer if (open(IN,'FOOTER')) { @stuff = ; print @stuff; close(IN); } else { print <<'EOF' EOF } # # Select a random set of questions out of a question pool # sub ChooseQuestions { srand; # list of html files in $quizdir @pool = <*.html>; # # pick a random set of questions # for ($i=0; $i<$nquestions; $i++) { $pick = int rand $#pool+1; push(@questions,$pool[$pick]); splice(@pool,$pick,1); } } # # Select a unique key for this user to prevent cheating. # Keyfiles are kept for two hours after the last question was answered. # Each keyfile contains a list of questions answered during this # quiz session. # sub ChooseKey { $key = ".quiz.$$"; # list of key files @keys = <$tmpdir/.quiz.*>; # # delete any old keyfiles # $now = time(); foreach $keyfile (@keys) { next if ($keyfile !~ /\d$/); ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($keyfile); unlink $keyfile if ($now > $mtime + 7200); } } # # Read a question and display it # (display everything up to the first named anchor). # sub AskQuestion { $question = @questions[$#questions]; open(HTML,$question) || CgiDie("Can't read $question question: $!\n"); print "Question ", $nquestions - $#questions, ":

"; while() { if (/]+)"/i) { s//

/; print $_ unless $skipping; if (//i) { print <<"EOF"; EOF } } close(HTML); } # # Display a question and the selected answer # (display the question and the selected named anchor). # sub AnswerQuestion { $question = @questions[$#questions]; $firsttime = 1; # foil those cheaters open(KEYFILE,"$tmpdir/$key"); while() { chop; $cheater = 1 if (/^$question /); } close(KEYFILE); if (defined $cheater) { print "

Sorry, you've already answered this question.

\n"; } else { open(KEYFILE,">>$tmpdir/$key") || CgiDie("Can't write $key keyfile: $!\n"); print KEYFILE "$question $choice\n"; close(KEYFILE); open(HTML,$question) || CgiDie("Can't read $question question: $!\n"); print "Question ", $nquestions - $#questions, "

"; while() { if (s/(.*<\/FORM>)//i) { print $1; print "

You replied: $choice

\n"; } s/type=\"?submit\"?/type="reset"/i; # disable submit buttons s/input\s+type="?image"?/img/i; # disable image buttons # be nice to lynx users if ($ENV{'HTTP_USER_AGENT'} =~ /^Lynx/i) { if (/]*value=\"?([^">]*)\"?[^>]*>/i) { $prev = $`; $next = $'; ($text = $1) =~ s/ / /g; $_ = $prev . $text . $next; } # s/]*value=\"?([^">]*)\"?[^>]*>/\1/i; } $skipping = 0 if /^\s*$/; if (/]+)"/i) { # see if this is the right answer (not case-sensitive # and ignoring leading & trailing spaces) $name = $1; # remove junk before matching $name =~ s/&[^;]+;//g; # html special codes, eg é $name =~ s/\W//g; # spaces, punctuation, 8 bit chars. $choice =~ s/&[^;]+;//g; # html special codes, eg é $choice =~ s/\W//g; # spaces, punctuation, 8 bit chars. if ("$name" eq "$choice") { $skipping = 0; if ($firsttime) { # the correct answer always comes first push(@results,$question); print "*** Correct ***
\n" if $debug; } } else { s/

EOF if ($#questions>=0) { print <<"EOF";

EOF } else { print <<"EOF";

That's all! Now I'll add up your score to see how well you did. EOF } } # # Add up the score and display it # sub ShowScore { $score = $#results + 1; if ($score == 0) { $heading = "

Sorry

"; $response = "You didn't answer any of the questions correctly. " . "But I hope you had fun and learned a lot about history."; } elsif ($score < ($nquestions/2) ) { $heading = "

Not Bad

"; $response = "You answered $score out of $nquestions questions correctly. " . "I hope you had fun and learned a lot about history."; } elsif ($score == $nquestions) { $heading = "

Congratulations!

"; $response = "You correctly answered all $nquestions questions."; } else { $heading = "

Good Try!

"; $response = "You answered $score out of $nquestions questions correctly. " . "I hope you had fun and learned a lot about history."; } print <<"EOF"; $heading

$response
Thank you for participating in the Quiz. If you like, you can try the quiz again.

EOF # and now the credits if (open(IN,'CREDITS')) { @stuff = ; print @stuff; close(IN); } else { print <<"EOF";

EOF if ($quizhome =~ m#www.usask.ca/history#) { print <<"EOF"; Quiz contents developed by Professor Dave De Brou of the University of Saskatchewan Department of History. EOF } else { print <<"EOF"; This quiz was inspired by the Open House Quiz Show at the University of Saskatchewan Department of History. EOF } print <<"EOF"; Quiz software developed by Earl Fogel, based on Sheila ffolliott's original Hypercard "Open House Quiz". EOF } } # strip potentially dangerous characters from a string sub purify { my($str) = @_; $str =~ s/[^A-Za-z0-9\-\_\.\,\/\+\:\;\%\@ ]+/ /g; $str =~ /(.*)/; # Tell perl that it's ok now return $1; }