#! /usr/bin/perl -w use English; use strict; use CGI; use FileHandle; my $q = new CGI; my $headerprinted = 0; # array of hash containing: # question - string, question text # tick - boolean, true=tick false=radio box # tiebreak - optional array containing list of names this is a tiebreaker for # answers - array of hash containing: # text: answer text # scores: array of answer scores my @questions = ( ); # non-question things encountered in quiz. # header - header text # footer - footer text my %metadata = ( ); # hash of: # count - current score # text - result text my %results; my $ScriptName = "http://www.toothycat.net/cgi/quiz.pl"; my $quiz; # ------------ sub main { $quiz = $q->param("quiz"); ensureheader(); if(defined($quiz)) { $quiz =~ /([A-Za-z]+)/; $quiz = $1; } (defined($quiz) && length($quiz)) or $quiz = "retro"; # default quiz $ScriptName .= "?quiz=$quiz"; parsequiz("data/" . $quiz); if($q->param("Submit")) { if ( countquiz() ) { print <

Please answer all the questions!


ENDMOAN } } else { printquiz(); } print <


Generated by MoonShadow's quiz script - source; parts contributed by Kazuhiko.

ENDHTML ; } # ------------------------ sub addtoscore { my ($aindex, $question) = @_; foreach my $score(@{$question->{'answers'}->[$aindex - 1]->{'scores'}}) { if ($score =~ /^([+-])([0-9]*)(.*)/) { my $amount = 1; if($2) { $amount = $2; } if($1 eq '-') { $amount = -$amount; } if(defined($results{$3})) { $results{$3}->{'count'} += $amount; } } } } sub countquiz { my $qindex = 0; foreach my $question(@questions) { $qindex++; if($question->{"tick"}) { my $aindex = 0; foreach my $answer(@{$question->{'answers'}}) { $aindex++; if($q->param($qindex . "." . $aindex)) { addtoscore($aindex, $question); } } } else { my $aindex = $q->param($qindex); if(defined($aindex) && $aindex =~ /^([0-9]+)$/) { addtoscore($aindex, $question); } else { if(!defined($q->param("tiebreak")) && !defined($question->{"tiebreak"})) { return 1; } } } } # index results by count my %countindex = ( ); foreach my $result(keys %results) { my $count = $results{$result}->{'count'}; my $lastcount = $q->param("t_" . $result); if(defined($lastcount) && ($lastcount =~ /(-?[0-9]+)/)) { $count += $1; $results{$result}->{'count'} = $count; } if(!defined($countindex{$count})) { $countindex{$count} = [ ] ; } push (@{$countindex{$count}}, $result); } my @counts = sort {$b <=> $a} keys %countindex; my $c = shift @counts; if($#{$countindex{$c}} > 0) { # we have a tie if(!($q->param("tiebreak"))) { # Try to display tiebreakers for the tied results if (printquiz($countindex{$c})) { return 0; } } # Couldn't display tiebreaker questions for some reason displayresult($countindex{$c}, 1); } else { displayresult($countindex{$c}, 0); } return 0; } sub displayresult { my ($c, $tie) = @_; if($tie) { print "The verdict is tied!

"; } if(defined($metadata{'title'})) { print "\n

$metadata{'title'}

\n"; } foreach my $result(@$c) { print $results{$result}->{'text'} . "

"; } } sub ensureheader { if($headerprinted) { return; } $headerprinted = 1; my $text = "Content-Type: text/html; charset=utf-8\x0D\x0A\x0D\x0A"; $text .= < CGISTUFF ; $text .= "Quiz Server - " . ucfirst($quiz) . "\n"; $text .= <
h o m e  |   s t r i p  |   w i k i  |   s t o r e  |   m o r e 

HEADER ; print $text; } sub printquiz { my ($tiebreaklist) = @_; print "
"; print $q->startform("POST", "$ScriptName", "application/x-www-form-urlencoded"); print ""; if (defined($tiebreaklist)) { # -- debug # print "Tiebreak: "; # foreach my $tied_result(@$tiebreaklist) # { # print $tied_result . " "; # } # print "
"; # -- print ''; #dump current scores foreach my $result(keys %results) { print ''; } } my $qindex = 0; my $qcount = 0; foreach my $question(@questions) { my $aindex = 0; $qindex++; if(defined($question->{'tiebreak'})) { defined($tiebreaklist) or next; my $match = 0; foreach my $tied_result(@$tiebreaklist) { foreach my $tiebreak_affects(@{$question->{'tiebreak'}}) { if($tied_result eq $tiebreak_affects) { $match++; } } } ($match > 1) or next; } else { # skip non-tiebreak questions in tiebreak mode; defined($tiebreaklist) and next; } if(!$qcount) { if(defined($metadata{'title'})) { print "\n

$metadata{'title'}

\n"; } if(defined($metadata{'header'})) { print $metadata{'header'}."
\n"; } } $qcount++; print "\n
"; print $question->{'question'}; print "
\n
\n"; foreach my $answer(@{$question->{'answers'}}) { print "\n"; $aindex++; if ($question->{'tick'}) { print "\n"; print "\n"; } else { print "\n"; print "\n"; } print "\n"; } print "
" . $answer->{'text'} . "" . $answer->{'text'} . "
\n"; } if($qcount) { if (defined($metadata{'footer'})) { print "
".$metadata{'footer'}."
\n"; } print "
\n"; if (defined($metadata{'submit'})) { print $q->submit(-name=>'Submit',-value=>$metadata{'submit'}); } else { print $q->submit(-name=>'Submit',-value=>'Submit'); } } print $q->endform(); return $qcount; } sub parsequiz { my ($text) = @_; my $fh = new FileHandle("<" . $text) or &ErrorExit("Couldn't open: $text.\n"); my $inbuf = ''; my $question; for(<$fh>) { s/\#.*$//; chomp; chomp; /[^ ]/ or next; # print $_ . "
"; if(/^results\: +(.+)/i) { my $rlist = $1; # parse results line $rlist =~ s/ //g; foreach my $item (split(/,/, $rlist)) { $results{$item} = { 'count'=>0 }; } } elsif(/^(header|footer|title|submit)\: +(.+)/i) { $metadata{lc($1)} = $2; } elsif(/^(question|tick)\: +(.+)/i) { # parse question spec if (defined($question)) { # print $question->{'question'} . "
"; push @questions, $question; } $question = { 'answers' => [ ] }; $question->{'question'} = $2; if($1 =~ /tick/i) { $question->{'tick'} = 1; } } elsif(/^(question|tick) *\(([^,]+(?:,[^,]+)*)\) *\: +(.+)/i) { # parse tiebreaker spec if (defined($question)) { push @questions, $question; } $question = { 'answers' => [ ] }; my $names = $2; $question->{'question'} = $3; if($1 =~ /tick/i) { $question->{'tick'} = 1; } $names =~ s/ //g; $question->{'tiebreak'} = [ split(/,/, $names) ]; } elsif(/([A-Za-z]+)\: +(.*)/) { # parse result spec if (defined($results{$1})) { # print "$1: $2\n
"; $results{$1}->{'text'} = $2; } else { moan ("Trying to give text for result $1, which hasn't been defined."); } } elsif(/(.*\.) +([^.]*?)$/) { # parse question my $text = $1; my $answers = $2; $answers =~ s/ //g; # print "$text - $answers.\n
"; push (@{$question->{'answers'}}, { 'text' => $text, 'scores' => [ split(/,/,$answers) ] }); } else { moan ("Don't understand line $_."); } } if (defined($question)) { push @questions, $question; } } sub moan { my ($text) = @_; ensureheader; print $text; print $q->end_html; exit(0); } # ------------------------ &main();