#!/bin/perl

# triviaa.pl --> processes input from form created by triviaq.pl
# Updated Feb 8 by agw: Now compares 2 e-mail addresses submitted by the user
#to avoid typos.


$date = `/bin/date`;
@date = split(/ +/,$date); # note the + after the space delimiter
# with a single-digit day, UNIX prints Fri Dec  1 10:43:57 CST 1995
# which has an extra space in front of the day. That would create
# an empty field unless multiple consecutive delimitors were treated
# as one

# note that the elements of @date are:
# 0. Day of Week (ie Wed)
# 1. Month (ie Nov)
# 2. Number of day (ie 29)
# 3. Time (ie 11:50:01)
# 4. Time Zone (ie EST)
# 5. Year (ie 1995)

$qnum = $date[2];
$month = $date[1];

$displaydate = "$date[2] $date[1] $date[5]";

open(QFILE,"../data/nmc/nmctrivia/$month.txt") || die "Cannot read nmctrivia/$month.txt";
$inline = <QFILE>;
until ($inline =~ m#^$qnum/#) {
    $inline = <QFILE>;
}
$qin = $inline;
chop($qin);
$inline = <QFILE>;
until ($inline =~ m#^\d{1,2}/#) {
    $qin = $qin . $inline;
    chop($qin);
    $inline = <QFILE>;
}

@qbits = split(/\//,$qin);
$qques = $qbits[1];
$letters{"a"} = $qbits[2];
$letters{"b"} = $qbits[3];
$letters{"c"} = $qbits[4];
$letters{"d"} = $qbits[5];
$qans = $qbits[6];

$val{"a"} = "w";
$val{"b"} = "w";
$val{"c"} = "w";
$val{"d"} = "w";

if ($letters{"a"} =~ s/\*//) {
    $val{"a"} = "r";
}
if ($letters{"b"} =~ s/\*//) {
    $val{"b"} = "r";
}
if ($letters{"c"} =~ s/\*//) {
    $val{"c"} = "r";
}
if ($letters{"d"} =~ s/\*//) {
    $val{"d"} = "r";
}

$querystring = "$ENV{QUERY_STRING}";
@fields = split(/&/,$querystring);
foreach $entry (@fields) {
    @qanda = split(/=/,$entry);
    $key = $qanda[0];
    $data = $qanda[1];
    $answers{$key} = $data;
}

$useremail = $answers{"email"};
&tidy($useremail); #calls the tidy subroutine to fix some html codes
                   #and remove spaces (so that only entering spaces
                   #produces $useremail eq ""

if ($useremail eq "") {
    &diemail;
} elsif ($useremail=~/%/) {
&diemail;
}


#Checks $useremail2 and tidys.
$useremail2 = $answers{"email2"};
&tidy($useremail2);

if ($useremail2 eq "") {
    &diemail;
} elsif ($useremail2=~/%/) {
&diemail;
}

#compares $useremail1 and $useremail2 and die if they are different

if ($useremail ne $useremail2) {
&die_notsame
}

$userresp = $answers{"answer"};

if ($userresp eq "") {
    &dieresp;
}

$finalanswer = $letters{"$userresp"};
$rightwrong = $val{"$userresp"};

# *** player update begins ***

chdir ("../data/nmc/nmctrivia/$month") || die "could not find trivia dir";
$userfile = $useremail;

# these next few lines were a primitive way of checking the
# existence of a file named for the user's e-mail. The glob
# construct overflows and fails to return all filenames when
# the directory gets too full, so $foundfile ends up with
# a "no" erroneously.
# $foundfile = "no";
# $userfile = "../data/nmc/nmctrivia/$month/$useremail";
# while ($infile = <../data/nmc/nmctrivia/$month/*>) {
#     if ($userfile eq $infile) {
#         $foundfile = "yes";
#     }
# }
# if ($foundfile eq "no") {
# if ($foundfile eq "yes") {

if (-e "$userfile") {
    open(IN,"$userfile") || die "Cannot read $userfile";
    $logtxt = <IN>; #only one line in the file, so only one line to read
    close(IN);
    @logarray = split(/#/,$logtxt);
    if ($logarray[$qnum] eq "n") {
        $logarray[$qnum] = "$rightwrong";
        $logtxt = "";
        foreach $logentry (@logarray) {
            unless ($logtxt) {
                $logtxt = "$useremail"; 
            } else {
                $logtxt = $logtxt . "#$logentry";
            }
        }
        open(OUT,">$userfile") || die "Cannot write to $userfile";
        print OUT "$logtxt";
        close(OUT);
    } else {
        $rightwrong = "a";
    }
} else {
    open(OUT,">$userfile") || die "Cannot create $userfile";
    $logtxt = "$useremail#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n#n";
    @logarray = split(/#/,$logtxt);
    $logarray[$qnum] = "$rightwrong";
    $logtxt = "";
    foreach $logentry (@logarray) {
        unless ($logtxt) {
            $logtxt = "$useremail"; 
        } else {
            $logtxt = $logtxt . "#$logentry";
        }
    }
    print OUT "$logtxt";
    close(OUT);
}    

# *** user update ends ***

print <<"EndPrn";
Content-TYPE:  text/html

<HTML>
<HEAD>
<TITLE>Trivia Answer for $useremail</TITLE>
</HEAD>
<BODY BACKGROUND="/nmc/design/triviabg.gif">
<IMG SRC="/nmc/design/triv@can.gif">
<H4>Trivia Answer for $useremail</H4>
<P>You answered $finalanswer</P>
EndPrn

if ($rightwrong eq "r") {
    print "<P>That answer is correct: $qans</P>\n";
    print "<P>Your answer has been tabulated. ";
    print "Please play again tomorrow.</P>\n";
} elsif ($rightwrong eq "w") {
    print "<P>Sorry, your answer is wrong. The correct answer is: ";
    print "$qans But you can always ";
    print "play tomorrow!</P>\n";
} else {
print "<P>You have already played the game today. ";
    print "Please play again tomorrow.</P>";
}

print <<"EndPrnTwo";
<P>[ <A HREF="/nmc/index.html">@canada</A> | 
<A HREF="/cgi-bin/triviat.pl">Who's Ahead in the Contest?</A> | 
<A HREF="/cgi-bin/triviaq.pl">Return to Today's Question</A> ]</P>
</BODY>
</HTML>
EndPrnTwo

close (QFILE);

sub tidy {
    $_[0] =~ s/\+/ /g;
    $_[0] =~ s/%0D%0A/\n/g;
    $_[0] =~ s/%2C/,/g;
    $_[0] =~ s/%27/'/g;
    $_[0] =~ s/%23/#/g;
    $_[0] =~ s/%21/!/g;
    $_[0] =~ s/%26/&/g;
    $_[0] =~ s/ //g; # will remove spaces
}

sub diemail {

    print <<"EndPrn";
Content-TYPE:  text/html

<HTML>
<HEAD>
<TITLE>Trivia Error - No E-Mail</TITLE>
</HEAD>
<BODY BACKGROUND="/nmc/design/triviabg.gif">
<IMG SRC="/nmc/design/triv@can.gif">
<H4>Trivia Error - No E-Mail</H4>
<P>You have entered an invalid e-mail address. Please try again so that we can tabulate your answer
and contact you if you win.</P>
<P>[ <A HREF="/nmc/index.html">@canada</A> | 
<A HREF="/cgi-bin/triviaq.pl">Return to Today's Question</A> ]</P>
</BODY>
</HTML>
EndPrn

    die;
}

sub dieresp {

    print <<"EndPrn";
Content-TYPE:  text/html

<HTML>
<HEAD>
<TITLE>Trivia Error - No Answer</TITLE>
</HEAD>
<BODY BACKGROUND="/nmc/design/triviabg.gif">
<IMG SRC="/nmc/design/triv@can.gif">
<H4>Trivia Error - No Answer</H4>
<P>Please enter an answer to the trivia question... If you don't, you
can't win!</P>
<P>[ <A HREF="/nmc/index.html">@canada</A> | 
<A HREF="/cgi-bin/triviaq.pl">Return to Today's Question</A> ]</P>
</BODY>
</HTML>
EndPrn

    die;
}


sub die_notsame {

    print <<"EndPrn";
Content-TYPE:  text/html

<HTML>
<HEAD>
<TITLE>Trivia Error - E-Mails are not the same</TITLE>
</HEAD>
<BODY BACKGROUND="/nmc/design/triviabg.gif">
<IMG SRC="/nmc/design/triv@can.gif">
<H4>Trivia Error - E-Mails Are Not the Same</H4>
<P>We asked you to type in your e-mail address twice. Once for scoring, the second time to confirm.
They do not match. Please try again.</P>
<P>[ <A HREF="/nmc/index.html">@canada</A> | 
<A HREF="/cgi-bin/triviaq.pl">Return to Today's Question</A> ]</P>
</BODY>
</HTML>
EndPrn

    die;
}