Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

CGI framework test 1.

by boo_radley (Parson)
on Apr 25, 2001 at 20:08 UTC ( #75514=perlquestion: print w/replies, xml ) Need Help??

boo_radley has asked for the wisdom of the Perl Monks concerning the following question:

I've finished round one of my CGI framework.

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.

framework.pl :
#!/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 , " : ", @_}; }
first.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">
second.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>
secret.html :
<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
    Hey There!

    As a CGI developer almost exclusively myself, I have been working on an "end-all" solution like this for some time - when I saw your last post I immediately became interested. I am glad to see that it has come to frution, and it is very well done as well.

    However, I am wondering: your %pages array - is that necessary? What exactly are you using it for? Because it seems to me that it is somewhat counter-productive: to add any new pages to the site you have to edit the code - I would think that you would want a script that would not have to be fiddled with at all, that ran without almost any intervention and that was extensible from the outside. Am I missing the point of your script (I may be way off)? It was just a simple question because I am very interested in this same subject and it seems that you have done a very good job.

    r. j o s e p h
    "Violence is a last resort of the incompetent" - Salvor Hardin, Foundation by Issac Asimov
Re: CGI framework test 1.
by skazat (Chaplain) on Apr 26, 2001 at 03:48 UTC

    I've actually been working on something similar at work, although the template system is just one small part of it. The other part is a web-based database/form designer - pretty much, I made some tools that allow you to design a database - what fields you want and then create a form to capture those fields - should this be a select box, a text area, an image upload? You can then populate a website directory with the information you capture.

    part of the templating system features a templating language, where you have special tokens that are then parsed to their $real_value. Part of the language includes basic looping, so I could say:

    [loop Company isnot Microsoft] [if foo] <blink> we have foo! - <b>[foo]</b></blink> [else] <p><i>no foo found for [name] :( [/if] [/loop]

    I could also say something like:

    [perl] my $var = 'yadda yadda.. bing!'; return $var [/perl]

    to do things that are too complicated for the templating language.

    I must say, the template parsing was a quite a challenge, I didn't use any outside modules, accept one's i created. Everything melds together quite nicely. We can now design, create, and build an entire dynamic section of a website in about an hour, something that would take me at least 2-3 days to hard code and debug.

    After we're all set, we can give our client a simple for to manage the section.

     

    -justin simoni
    !skazat!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://75514]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2021-10-28 04:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (95 votes). Check out past polls.

    Notices?