boo_radley has asked for the wisdom of the Perl Monks concerning the following question:
I wanted to present it for comments and improvements. Currently, this framework drives 2 web sites that I've developed.
In order to provide a small demonstration, I've prepared the following files. The first is the actual engine, and the other three are html templates that are used in conjunction with the script.
Please give me any feedback you have... thanks.
first.html :#!/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<BR>"); if (defined ($pages{$Current_Page}{validator})) { $errorlevel =$pages{$Current_Page}{validator}->(); debugprint ("validator found, returned '$errorlevel'.<BR>"); } } else { debugprint( "setting Current_Page to default page $defaultpage<BR> +"); $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 withi +n the form, they're input! debugprint ("printing parameters<BR>"); 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]'<BR>") +; } } debugprint ("Done printing parameters<BR>"); debugprint ("Checking traversal list<BR>"); my $nextpage = $pages{$Current_Page}{traverse_sub}->(\$vars, \$errorle +vel); debugprint ("Traverse_sub returns '$nextpage'<BR>"); 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 + <BR>"); if ($pages{$Current_Page}{traverse_list}{$nextpage} ){ if (defined $pages{$Current_Page}{postsubmit}) { debugprint ("Executing '$Current_Page' post submit<BR>"); $pages{$Current_Page}{postsubmit}->(\$vars, \$errorlevel); debugprint ("Done with '$Current_Page' post submit<BR>"); } else { debugprint ("No post submit found, but traversal post subm +it set to 1!<BR>"); } }; debugprint ("Setting Current_Page to '$nextpage'<BR>"); $Current_Page = $nextpage; } else { debugprint ("Nextpage is not defined... what happened here?<BR>"); } debugprint ("Setting \$\$vars info<BR>"); $$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) & (sca +lar shift))}}; # why doesn't TT2 recognize bitwise ops? }:( debugprint ("Hiding current_page<BR>"); print hidden ("Current_Page", $Current_Page); debugprint ("Setting Template<BR>"); my $template; $template= Template->new() || die( "Can't create template $!"); $template->process($pages{$Current_Page}{template}, $vars)|| die ("Tem +plate process failed: ", $template->error(), "\n"); debugprint ("<BR>Done printing template<BR>"); debugprint ("Cleaning up<BR>"); 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 f +irst : error is '$$error';<BR>");return "first"}; if ($$$vars{params}{num}==1616) {return "secret"} return "second"; } sub debugprint { if (DEBUG) {print scalar localtime , " : ", @_}; }
second.html<h2>Hello there.</h2> [% IF error_level %]<CENTER><h3> Read the directions!</h3></CENTER> [% + END %] Please Enter your name here : <INPUT TYPE="text" NAME="name" SIZE=20 MAXLENGTH=80><BR> [% IF get_bit (error_level, 2) %] <FONT COLOR=RED> [% END %] Please Enter a number : [% IF get_bit (error_level, 2) %] </FONT> [% END %] <INPUT TYPE="text" NAME="num" SIZE=20 MAXLENGTH=80> <INPUT TYPE="submit">
secret.html :<CENTER> <H2>Results for [% params.name %]</H2> <TABLE BORDER=1> <TR><TD>name</TD><TD>[% params.name %]</TD> <TR><TD>You entered </TD><TD>[% params.num %]</TD> </TABLE> <CENTER>
<CENTER> <H2>Welcome to the secret page [% params.name %].</H2> <TABLE BORDER=1> <TR><TD>name</TD><TD>[% params.name %]</TD> <TR><TD>You entered </TD><TD>[% params.num %]</TD> <TR><TD>Secret codename </TD><TD>ED</TD> </TABLE> <CENTER>
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: CGI framework test 1.
by r.joseph (Hermit) on Apr 26, 2001 at 02:22 UTC | |
|
Re: CGI framework test 1.
by skazat (Chaplain) on Apr 26, 2001 at 03:48 UTC |