#!/usr/bin/perl -w
# In nomine Ad Signo, et Percentus, et Dollar Signo Sancti. Amen.
use strict;
use Template;
use DBI;
use CGI::Carp;
use CGI qw(:all);
use constant DEBUG => 0;
$|++;
#
#
#
#
#
#PAGENAME => {description =>$desc,
# traverse_list =>{pagename_1 => 1,
# pagename_2 => 0,
# ...},
# traverse_sub =>\&sub,
# validator =>\&sub,
# errorhandler =>\&sub,
# template =>$filepath,
# postsubmit =>\&sub,
# params =>[$param1, $param2...]},
#
#
#
#
my %pages = (
first => {description =>"entry",
traverse_list =>{first=>0,
second=>0,
secret=>0},
traverse_sub =>\&first_trav,
nextpage =>"second",
prevpage =>undef,
validator =>\&first_validate,
errorhandler =>\&first_err,
template =>"first.html",
postsubmit =>undef,
params =>["name","num"]},
second => {description =>"Enter your name",
traverse_list =>{},
traverse_sub =>undef,
nextpage =>"ticket",
prevpage =>undef,
validator =>undef,
errorhandler =>undef,
template =>"second.html",
postsubmit =>undef,
params =>[]},
secret => {description =>"Enter your name",
traverse_list =>{},
traverse_sub =>undef,
nextpage =>"ticket",
prevpage =>undef,
validator =>undef,
errorhandler =>undef,
template =>"secret.html",
postsubmit =>undef,
params =>[]},
);
#
# Begin main loop.
#
#
my $defaultpage = "first";
my $Current_Page;
my $vars;
my $errorlevel;
print header (-type=>'text/html');
debugprint ( "checking Current_page ".br);
if (param ("Current_Page")){
debugprint ("found Current_page set to ".param ("Current_Page").br);
$Current_Page = param ("Current_Page");
#
# check to see if there's an error in the current page
#
debugprint ("Checking Current_Page for validator
");
if (defined ($pages{$Current_Page}{validator})) {
$errorlevel =$pages{$Current_Page}{validator}->();
debugprint ("validator found, returned '$errorlevel'.
");
}
} else {
debugprint( "setting Current_Page to default page $defaultpage
");
$Current_Page = $defaultpage;
}
print start_html (-"TITLE"=>$pages{$Current_Page}{description},
-BODY_TEXT=>"#000000",
-BGCOLOR=>"#EFEFEF",
-LINK=>"#313963",
-VLINK=>"#313963",
-ALINK=>"#313963",
-MARGINHEIGHT=>"0",
-MARGINWIDTH=>"0",
-TOPMARGIN=>"0",
-LEFTMARGIN=>"0");
print start_form; # remember that all hidden fields need to be within the form, they're input!
debugprint ("printing parameters
");
foreach my $thispage (keys %pages){
foreach (@{$pages{$thispage}{params}}) {
my @temp_param = param($_);
if ((param($_))){print hidden ($_, $temp_param[-1])}
$$vars{params}{$_}= $temp_param[-1];
debugprint ("Parameter '$_' set to '$temp_param[-1]'
");
}
}
debugprint ("Done printing parameters
");
debugprint ("Checking traversal list
");
my $nextpage = $pages{$Current_Page}{traverse_sub}->(\$vars, \$errorlevel);
debugprint ("Traverse_sub returns '$nextpage'
");
if (defined $nextpage) {
unless (defined ($pages{$Current_Page}{traverse_list}{$nextpage})){
print "tried to access undefined key in $Current_Page traverse_list : $nextpage";
die;
}
debugprint ("Checking for '$Current_Page' traverse for post submit
");
if ($pages{$Current_Page}{traverse_list}{$nextpage} ){
if (defined $pages{$Current_Page}{postsubmit}) {
debugprint ("Executing '$Current_Page' post submit
");
$pages{$Current_Page}{postsubmit}->(\$vars, \$errorlevel);
debugprint ("Done with '$Current_Page' post submit
");
} else {
debugprint ("No post submit found, but traversal post submit set to 1!
");
}
};
debugprint ("Setting Current_Page to '$nextpage'
");
$Current_Page = $nextpage;
} else {
debugprint ("Nextpage is not defined... what happened here?
");
}
debugprint ("Setting \$\$vars info
");
$$vars{pagetitle} =$pages{$Current_Page}{description};
$$vars{current_page}= $Current_Page;
$$vars{error_level} = $errorlevel;
$$vars{get_bit}=sub {if ($_[0] && $_[1]){return ((scalar shift) & (scalar shift))}}; # why doesn't TT2 recognize bitwise ops? }:(
debugprint ("Hiding current_page
");
print hidden ("Current_Page", $Current_Page);
debugprint ("Setting Template
");
my $template;
$template= Template->new() || die( "Can't create template $!");
$template->process($pages{$Current_Page}{template}, $vars)|| die ("Template process failed: ", $template->error(), "\n");
debugprint ("
Done printing template
");
debugprint ("Cleaning up
");
print end_form;
print end_html;
exit;
################################################################################
#
# MAIN LOOP ENDS HERE
#
################################################################################
sub first_validate {
my @name = param("name");
my @num = param("num");
if ($name[-1] eq "") {return 1};
if ($num[-1] < 25) {return 2};
return 0;
}
sub first_trav{
my $vars = shift;
my $error = shift;
if ($$error || ! param ("Current_Page")) {debugprint ("returning first : error is '$$error';
");return "first"};
if ($$$vars{params}{num}==1616) {return "secret"}
return "second";
}
sub debugprint {
if (DEBUG) {print scalar localtime , " : ", @_};
}