#!/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{
How are yopu: $session_id
}, $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 }