#!/usr/local/bin/perl
#
# World Wide Web Treasure Hunt
# CGI Safeperl Script v1.10
# (c)1996 Mark Rigby-Jones for mrjsw
#

# Variable initialisation

$huntnum = "III";		# Treasure hunt number
$endtime = 847443600;		# Time it ends (as returned by perl's time command)
$gamelength = 1440;		# Game length in minutes
$begins = "9am Thursday";	# When the game begins

# Read input from form

if ($ENV{REQUEST_METHOD} eq "GET") {

    $data = $ENV{QUERY_STRING};

} elsif ($ENV{REQUEST_METHOD} eq "POST") {

    for ($i = 0; $i < $ENV{CONTENT_LENGTH}; $i++) {

	$data .=getc;

    }

}

# Process, decode and split input data

@data = split(/&/, $data);
@data0 = split(/=/, $data[0]);
@data1 = split(/=/, $data[1]);
@input = (@data0,$data1[1]);

foreach $item (0..2) {

    $input[$item] = substr($input[$item], index($input[$item], '=') + 1);
    $input[$item] =~ s/\+/ /g;
    $input[$item] =~ s/%(..)/pack("c",hex($1))/ge;
    $input[$item] =~ tr/:/;/s;

}

# Load the teams information

open(TEAMS, "out/hunt.t");
$nteams = 0;
$tnum = -1;
$tchange = 0;

while ($team = <TEAMS>) {

    ($tnum[$nteams],$tname[$nteams],$temail[$nteams],$tans[$nteams],$tpass[$nteams],$tnext[$nteams],$tinc[$nteams]) = split(/:/, $team);

    if ($input[1] == $tnum[$nteams]) {

	$tnum = $nteams;

    }

    $nteams++;

}

# Check time

$secs = ($endtime - time);
$mins = ($secs - ($secs % 60)) / 60;
$scoreline = "Scores with $mins Minutes Remaining";

if ($mins > $gamelength) {	# Output: Before game has started

    $scoreline = '';
    $startsin = $mins - $gamelength;

    &header("Not Yet!");

    print(<<BACK_TO_PERL);
<h2 align=center>Registation does not begin until $begins!<br>(In $startsin minutes, to be precise)</h2>
BACK_TO_PERL

    &log("Too early warning");

} elsif ($mins < 0) {		# Output: After game has ended

    $scoreline = "Final Scores";

    &header("Game Over!");

    print(<<BACK_TO_PERL);
<h2 align=center>Game Over!</h2>
<p align=center>Final scores are listed below</p>
BACK_TO_PERL

    &log("Final scores given out");

} elsif ($input[0] eq 'name') {	# Output: Team registration

    &header("Registration");

    # Check that this is a new team name and email address

    $dupemail = 0;
    $dupname = 0;

    for ($i = 0; $i < $nteams; $i++) {

	if ($temail[$i] eq $input[2]) {

	    $dupemail = 1;

	} elsif ($tname[$i] eq $input[1]) {

	    $dupname = 1;

	}

    }

    if (($input[1] eq '') or ($input[2] eq '')) {

	print(<<BACK_TO_PERL);
<h2 align=center>Registration Unuccessful!</h2>
<p align=center>Please fill in both a team name and an email address!</p>
<a href="http://users.ox.ac.uk/~microsoc/hunt/"><h3 align=center>Register Properly!</h3></a>
BACK_TO_PERL

        &log("Incomplete registration: '$input[1]' <$input[2]>");

    } elsif ($dupemail == 1) {	# Previously used email address

    print(<<BACK_TO_PERL);
<h2 align=center>Registration Unuccessful!</h2>
<p align=center>Only one team per email address, please!</p>
<a href="http://users.ox.ac.uk/~microsoc/hunt/"><h3 align=center>Register Properly!</h3></a>
BACK_TO_PERL

        &log("Multi-Registration: <$input[2]>");

    } elsif ($dupname == 1) {	# Previously used team name

    print(<<BACK_TO_PERL);
<h2 align=center>Registration Unuccessful!</h2>
<p align=center>Sorry, but a team with this name has already been registered.</p>
<a href="http://users.ox.ac.uk/~microsoc/hunt/"><h3 align=center>Try Another Name</h3></a>
BACK_TO_PERL

        &log("Multi-Registration: '$input[1]'");

   } else {			# OK: Register the new team

	($tnum[$nteams],$tname[$nteams],$temail[$nteams],$tans[$nteams],$tpass[$nteams],$tnext[$nteams],$tinc[$nteams]) = (($secs + 12345),$input[1],$input[2],0,0,0,0);
	$tnum = $nteams;
	$nteams++;
	open(TEAMS, ">> hunt.t");
	print(TEAMS "$tnum[$tnum]:$tname[$tnum]:$temail[$tnum]:0:0:0:0:\n");
	close(TEAMS);
	mail($temail[$tnum], "WWW Treasure Hunt $huntnum Registation", "Registation for the team '$tname[$tnum]'\n\nYour team number is $tnum[$tnum]\n\nThanks for playing!\n");

	print(<<BACK_TO_PERL);
<h2 align=center>Registration Successful!</h2>
<p align=center>Your team has been successfully registered for the treasure hunt. To get your first question, follow the link below. The URL below is the one which you must return to each time you need to answer or pass on a question. Either follow the link and bookmark the page which it takes you to, or if your browser cannot do that, write it down. <strong>Do not</strong> use 'back' or other history functions of your browser, as this may cause answers to be resubmitted incorrectly, losing you points! If a suggested answer format is given in brackets, you must use this or your answer may not be recognised!</p>
<a href="http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt?team=$tnum[$tnum]"><h3 align=center>http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt?team=$tnum[$tnum]</h3></a>
BACK_TO_PERL

        &log("'$tname[$tnum]' <$temail[$tnum]> registered as $tnum");

    }

} elsif ($input[0] eq 'team') {	# Output: Question request or answer

    # Find team details

    for ($i = 0; $i < $nteams; $i++) {

	if ($input[1] == $tnum[$i]) {

	    $tnum = $i;

	}

    }

    if ($tnum == -1) {		# Team doesn't exist

	&header("Illegal Team");

	print(<<BACK_TO_PERL);
<h2 align=center>Illegal Team Number!</h2>
<p align=center>Looks like you've mistyped the team number - unless you're trying to cheat, or something...</p>
<center><form method=get action="http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt">
Your Team Number: <input type="text" name="team" size=6> <input type="submit" value="Go!">
</form></center>
BACK_TO_PERL

        &log("Illegal team number $input[1]");

    } else {			# Team OK

	# Read in the question data

	$qnum = $tnext[$tnum] + 1;

	open(QUEST, "out/hunt.q");

	for ($i = 0; $i <= $qnum; $i++) {

	    ($quest,$ans) = split(':', <QUEST>);

	}

	$anst = $ans;
	$anst =~ tr/[A-Z]/[a-z]/s;

	$tans = $input[2];
	$tans =~ tr/[A-Z]/[a-z]/s;
	
	if ($tans eq '') {	# No answer given, so just a question request

	    &header("Your Question");

            &log("'$tname[$tnum]' given question $qnum");

        } elsif ($tans =~ /pass/) { # Question was passed

	    $tans = '';
	    $tnext[$tnum]++;
	    $tpass[$tnum]++;
	    $tinc[$tnum] = 0;
	    $tchange = 1;
	    ($quest,$nans) = split(':', <QUEST>);

	    &header("Passed Question");

	    print(<<BACK_TO_PERL);
<h2 align=center>You Passed the Last Question</h2>
<hr noshade>
BACK_TO_PERL

            &log("'$tname[$tnum]' passed question $qnum");

        } elsif ($tans =~ m~$anst~) { # Correct answer

	    $tnext[$tnum]++;
	    $tans[$tnum]++;
	    $tinc[$tnum] = 0;
	    $tchange = 1;
	    ($quest,$nans) = split(':', <QUEST>);

	    &header("Right Answer");

	    print(<<BACK_TO_PERL);
<h2 align=center>The Right Answer!</h2>
<p align=center>Your answer, "$input[2]" was close enough to the answer we were looking for - "$ans" - to get the point.</p>
<hr noshade>
BACK_TO_PERL

            &log("'$tname[$tnum]' correctly answered question $qnum");

        } else {	       # Incorrect answer

	    $tinc[$tnum]++;
	    $tchange = 1;

	    if ($tinc[$tnum] == 2) { # Second failed attempt - move to next question

		$tnext[$tnum]++;
		$tpass[$tnum]++;
		$tinc[$tnum] = 0;
		$next = "That was your second incorrect attempt at that question, so you have been automatically moved on to the next. If you still think that your answer was correct then send an email to <a href=\"mailto:microsoc\@sable.ox.ac.uk\">microsoc\@sable.ox.ac.uk</a> and we'll check up on it. <strong>You must include your team name and the URL where you found your answer or we cannot give you the point!</strong> Please don't use this unless you really do think we're wrong.";
		($quest,$nans) = split(':', <QUEST>);

	    } else {           # First failed attempt

		$next = "That was your first attempt at that question, you have one more remaining. Make sure that you haven't made any typos.";

	    }

	    &header("Wrong Answer");

	    print(<<BACK_TO_PERL);
<h2 align=center>The Wrong Answer!</h2>
<p align=center>Your answer, "$input[2]" was not close enough to the answer we were looking for to get the point. $next</p>
<hr noshade>
BACK_TO_PERL

            &log("'$tname[$tnum]' answered question $qnum incorrectly. '$tans', should be '$anst'");

        }

	close(QUEST);

	# Rewrite team data, if neccessary

	if ($tchange == 1) {

	    open(TEAMS, "> hunt.t");

	    for ($i = 0; $i < $nteams; $i++) {

		 print(TEAMS "$tnum[$i]:$tname[$i]:$temail[$i]:$tans[$i]:$tpass[$i]:$tnext[$i]:$tinc[$i]:\n");

	     }

	}
    
	if ($quest eq '') {	# All questions answered

	    print("<h2 align=center>No Questions Remaining!</h2>\n<p align=center>However, if you come back later there may be some more. Apologies for any inconvenience.</p>\n");

	} else {		# Give the next question

	print(<<BACK_TO_PERL);
<h2 align=center>Your Next Question:</h2>
<p align=center>$quest</p>
<center><form method=post action="http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt">
<input type="hidden" name="team" value="$tnum[$tnum]">
Your Answer:<br><input type="text" name="answer" size=72><p>
<input type="submit" value="Submit this answer"> <input type="reset" value="Clear your answer">
</form>
<form method=post action="http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt">
<input type="hidden" name="team" value="$tnum[$tnum]">
<input type="hidden" name="answer" value="pass">
<input type="submit" value="Pass on this question">
</form></center>
BACK_TO_PERL

        }

    }

} else {			# Output: Neither registration or question/answer

    &header("Scores");

    print(<<BACK_TO_PERL);
<p align=center>If you want to register for the treasure hunt, the URL you require is:<br>
<a href="http://users.ox.ac.uk/~microsoc/hunt/">http://users.ox.ac.uk/~microsoc/hunt/</a></p>
<p align=center>If you are already participating, you need something of the form:<br>
http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt?team=XXXXX</p>
<center><form method=get action="http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt">
Your Team Number: <input type="text" name="team" size=6> <input type="submit" value="Go!">
</form></center>
BACK_TO_PERL

    &log("Scores given out");

}

close(TEAMS);

if ($scoreline ne '') {		# Display scores

    print(<<BACK_TO_PERL);
<hr noshade>
<h2 align=center>$scoreline</h2>
<center>
<table border cellpadding=5><tr><td><strong><em>Team Name: </em></strong><td><strong><em>Points: </em></strong><td><strong><em>Passes:<br></em></strong>
BACK_TO_PERL

    for ($i = 0; $i < $nteams; $i++) {

	if ($i == $tnum) {

	    print("<tr><td><a href=\"http://users.ox.ac.uk/cgi-bin/safeperl/microsoc/hunt?team=$tnum[$i]\"><strong>$tname[$i] </strong></a><td><strong>$tans[$i] </strong><td><strong>$tpass[$i]<br></strong>\n");

	} else {

	    print("<tr><td><a href=\"mailto:$temail[$i]\">$tname[$i] </a><td>$tans[$i] <td>$tpass[$i]<br>\n");

	}

    }

    print("</table><p>");

}

# Print footer

print(<<BACK_TO_PERL);
<hr size=4 noshade>
<address>
<p align=center><a href="/~microsoc/"><img src="/~microsoc/logos/cs.gif" width=116 height=31 border=0 alt="-- Home --"></a><br>
&copy;1996 Oxford University Computer Society<br>
<a href="mailto:microsoc\@sable.ox.ac.uk">microsoc\@sable.ox.ac.uk</a></p>
</body>
</html>
BACK_TO_PERL

# Print an entry to the logfile with timestamp and remote accesser details

sub log {
    ($text) = @_;
    $localtime = localtime;
    
    open(LOG, ">> hunt.l");
    print(LOG "$localtime $ENV{REMOTE_USER}\@$ENV{REMOTE_HOST}($ENV{REMOTE_ADDR}) $text\n");
    close(LOG);
}

# Pint out the top of a web page with the specified title addendum

sub header {
    ($text) = @_;
    print(<<BACK_TO_PERL);
Content-type: text/html

<html>
<head>
<title>Treasure Hunt - $text</title>
</head>
<body bgcolor=#FFFFFF>
<h1 align=center><img src="/~microsoc/logos/csoc.gif" width=362 height=98 alt="-- CSOC --"></h1>
<h1 align=center>World Wide Web Treasure Hunt $huntnum</h1>
<hr noshade size=4>
BACK_TO_PERL
}

# EOF