#!/usr/bin/perl use CGI; use DBI; use MD5; $DB = "DBI:mysql:a348"; $username = "a348"; $password = "a348AG"; $DB_TABLE = "dgerman_mar4"; $SECRET = "something secret"; $EXPIRE = 30 * 60 * 60 * 24; # one month $MAX_TRIES = 10; $ID_LENGTH = 8; $q = new CGI; $DBH = DBI->connect($DB, $username, $password, { PrintError => 0 }) || die "Couldn't open database: ", $DBI::errstr; my ($session_id) = &get_session_id(); print $q->header, $q->start_html; my $state = &get_state($session_id); if (! $state->{one}) { $state = &initialize($state); } $state = &calculate($state); &save_state($state, $session_id); &status($state); &show_form(); print $q->end_html; $DBH->disconnect; #--------------------------------(end of main program)------ sub show_form { print $q->start_form(), "When done please press ", $q->submit(-value=>'Proceed'), $q->end_form(); } #--------------------------------(this was our basic form)--- sub get_session_id { &expire_old_sessions(); my ($id) = $q->path_info =~ m:^/([a-h0-9]{$ID_LENGTH}):o; return $id if $id and &check_id($id); 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); } #--------------------------------(needed above)-------------- sub expire_old_sessions { $DBH->do(<<END); DELETE FROM $DB_TABLE WHERE (unix_timestamp() - unix_timestamp(modified)) > $EXPIRE END } #--------------------------------(also needed above)--------- sub generate_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($SECRET . rand()); } return undef if $tries >= $MAX_TRIES; return $id; } sub hash { my $value = shift; return substr(MD5->hexhash($value), 0, $ID_LENGTH); } #--------------------------------(last one needed)----------- sub check_id { my $id = shift; return $id if $DBH->do("SELECT 1 FROM $DB_TABLE WHERE session_id = '$id'") > 0; return $id if $DBH->do("INSERT INTO $DB_TABLE (session_id) VALUES ('$id')"); return ''; } #--------------------------------(retrieve acc)-------------- 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; } #--------------------------------(calculate new acc)--------- sub calculate { my $state = shift; $state->{one} = $state->{two}; $state->{two} = $state->{three}; $state->{three} = $state->{one} + $state->{two}; return $state; } #--------------------------------(store new acc)------------- sub save_state { my ($state, $id) = @_; my $sth = $DBH->prepare(<<END) || die "Prepare: ", $DBH->errstr; UPDATE $DB_TABLE SET one = ?, two = ?, three = ? WHERE session_id = '$id' END $sth->execute(@{$state}{qw(one two three)}) || die "Execute: ", $DBH->errstr; $sth->finish; } #--------------------------------(print current acc)--------- sub status { my ($state) = @_; print qq{ One: $state->{one} <p> Two: $state->{two} <p> Three: $state->{three} <p> }; } sub initialize { my $state = shift; $state = {} unless $state; $state->{one} = 1; $state->{two} = 1; $state->{three} = 2; return $state; }