#!/usr/bin/perl
use CGI;
use DBI;
use Digest::MD5 qw(md5 md5_hex md5_base64);
$DB = "dbi:mysql:demoOne:silo.cs.indiana.edu:port=14358";
$username = "ddkelley";
$password = "passw0rd";
$DB_TABLE = "hwfive";
$SECRET = "something secret";
$EXPIRE = 30 * 60 * 60 * 24; # one month
$MAX_TRIES = 10;
$ID_LENGTH = 8;
$q = new CGI;
# Open the database --------------------------------------------------------
$DBH = DBI->connect($DB, $username, $password, {PrintError => 0}) || die "Couldn't open database: ", $DBI::errstr;
# get the current session ID, or make one ----------------------------------
my ($session_id, $note) = &get_session_id();
# retrieve the state -------------------------------------------------------
my $state = &get_state($session_id) unless $q->param('clear');
# report the state, and get ready for more input
print $q->header, $q->start_html, qq{
}, $q->end_html;
# then save the hash table in the database ---------------------------------
&save_state($state, $session_id);
$DBH->disconnect;
#-------------(end of program, the rest are just supporting procedures)-----
# save the state in the database ------------------------------save_state---
sub save_state {
my ($state, $id) = @_;
my $sth = $DBH->prepare(<errstr;
UPDATE $DB_TABLE
SET message=?,score=?, total=?,anskey=?
WHERE session_id='$id'
END
$sth->execute(@{$state}{qw(score message total anskey)})
|| die "execute: ", $DBH->errstr;
$sth->finish;
}
# get the state from the database ------------------------------get_state---
sub get_state {
my $id = shift;
my $query =
"SELECT * FROM $DB_TABLE WHERE session_id = '$id'";
my $sth = $DBH->prepare($query) || die "Prepare: ", $DBH->errstr;
$sth->execute || die "Execute: ", $sth->errstr;
my $state = $sth->fetchrow_hashref;
$sth->finish;
return $state;
}
# retrieve the session ID from the path info. if it's -----get_session_id---
# not already there, add it to the path info (more or less) with a redirect
sub get_session_id {
my (@result);
&expire_old_sessions();
my ($id) = $q->path_info() =~ m:^/([a-h0-9]{$ID_LENGTH}):o;
return @result if $id and @result = &check_id($id);
# if we get here, there's not already an ID in the path info
my $session_id = &generate_id();
die "Couldn't make a new session id" unless $session_id;
print $q->redirect($q->script_name() . "/$session_id");
exit 0;
}
# find a new unique ID and insert it into the database -------generate_id---
sub generate_id {
# create a new session id
my $tries = 0;
my $id = &hash($SECRET . rand());
while ($tries++ < $MAX_TRIES) {
last if $DBH->do("INSERT INTO $DB_TABLE (session_id) VALUES ('$id')");
$id = &hash($id);
}
return undef if $tries >= $MAX_TRIES; # we failed
return $id;
}
# check to see that an old ID is valid --------------------------check_id---
sub check_id {
my $id = shift;
return ($id, '')
if $DBH->do("SELECT 1 FROM $DB_TABLE WHERE session_id = '$id'") > 0;
return ($id, 'The record of your game may have expired. Restarting.')
if $DBH->do("INSERT INTO $DB_TABLE (session_id) VALUES ('$id')");
return ();
}
# generate a hash value ---------------------------------------------hash---
sub hash {
my $value = shift;
return substr(md5_hex($value), 0, $ID_LENGTH);
}
sub expire_old_sessions { # --------------------------expire_old_sessions---
$DBH->do(< $EXPIRE
END
}