#!/usr/bin/perl # statemach.cgi # a simple state-machine example # constants $CRLF = "\x0d\x0a"; $servername = $ENV{'SERVER_NAME'}; # this server $scriptname = $ENV{'SCRIPT_NAME'}; # this program's URI # how to call back $callback = "http://$servername$scriptname"; # need this at the top of all CGI progs print "Content-type: text/html$CRLF$CRLF"; # get the query vars, if any %query = getquery(); # if there's no data, assume this is the first iteration $state = 'first' unless %query; # make variables from query hash while(($qname, $qvalue) = each %query) { $$qname = $qvalue; } # the main jump table if ($state eq 'first' ) { first() } elsif ($state eq 'validate') { validate() } else { unknown() } exit; # STATE SCREENS
sub first { print <<FIRST; <title>First Time</title> <h1>Is this your first time?</h1> <form method=POST action="$scriptname"> <p> This is your first time through the state-machine. <p> Are you having fun yet? <input type=checkbox name=fun> <input type=hidden name=state value=validate> <input type=submit value=" tell me about it "> </form> </html> FIRST } sub validate{ if ($fun) { isfun() } else { notfun() } } sub isfun{ print <<ISFUN; <title>Having Fun</title> <h1>Glad you are having fun!</h1> ISFUN }
sub notfun{ print <<NOTFUN; <title>Sorry</title> <h1>Sorry, that's the wrong answer</h1> <h3>Come back when you are having fun!</h3> NOTFUN }
sub unknown{ print <<UNK <title>Huh?</title> <h1>Error: Confused</h1> <p> Um...I do not know how I got here. Sorry. UNK }
# UTILITY ROUTINES # getquery # returns hash of CGI query strings sub getquery{ my $method = $ENV{'REQUEST_METHOD'}; my ($query_string, $pair); my %query_hash; $query_string = $ENV{'QUERY_STRING'} if $method eq 'GET'; $query_string = <STDIN> if $method eq 'POST'; return undef unless $query_string; foreach $pair (split(/&/, $query_string)) { $pair =~ s/\+/ /g; $pair =~ s/%([\da-f]{2})/pack('c',hex($1))/ieg; ($_qsname, $_qsvalue) = split(/=/, $pair); $query_hash{$_qsname} = $_qsvalue; } return %query_hash; } # printvars # diagnostic to print the environment and CGI variables sub printvars{ print "<p>Environment:<br>\n"; foreach $e (sort keys %ENV) { print "<br><tt>$e => $ENV{$e}</tt>\n"; } print "<p>Form Vars:<br>\n"; foreach $name (sort keys %query) { print "<br><tt>$name => [$query{$name}]</tt>\n"; } }