This is the project which I've commented on several times here, and I wish to submit it to brutal peer review.
OK.module : Optional, but highly recommended. A page's perl code can be split out into several modules, and whatever's in the file specified by the module key will be pushed into the MAIN namespace. description : A string of questionable value traverse_list : hash where the keys are pagenames, and the values are true/ false to indicate if post-submit processing is needed when traversing to this page. traverse_sub : reference to a sub used to determine which member of traverse list to access. validator : sub reference used to validate data on the current page. errorhandler : Not currently implemented. template : String containing filepath to a TT2 template Contains the HTML that will actually be displayed. preprocess : Sub reference run before the page is displayed. postsubmit : Sub reference run after the page is displayed. params : Determines which CGI params are to be kept alive between invocations.
The first two statements add two HTML pages and the subroutines and arrays required to automate the page's upkeep.#!e:\perl\bin\perl.exe use strict; use Framework; use CGI; use DBI; use Date::Manip; use constant BASEPATH => 'c:/progra~1/apache~1/apache/cgi-bin/'; InsertPage_hashref ( { pagename=> "Entry", module => BASEPATH . 'entry.pl', description => "Entrance to the journal", traverse_list => {Entry=>0, writejournal => 0, readjournal => 0, editjournal => 0}, traverse_sub => \&entry_trav, validator => undef, errorhandler => undef, template => 'templates/JEntry.html', preprocess => undef, postsubmit => undef, params => ["read.x","write.x","edit.x"]}); InsertPage_hashref ( { pagename=> "writejournal", module => BASEPATH . 'jwrite.pl', description => "write a new journal entry", traverse_list => {Entry=>0, writejournal => 1, readjournal => 0}, traverse_sub => \&entry_trav, validator => \&write_valid, errorhandler => undef, template => 'templates/Jwrite.html', preprocess => undef, postsubmit => \&write_sub, params => []}); RunPages;
More or less straightforward, I hope. But where does the errorcode come from, and what it tell us?sub write_sub { my $vars = shift; my $errorcode = shift; if (&get_errorlevel) {return} # don't write anything to the +database if something's errored out on us. my $dbh = DBI->connect("DBI:CSV:f_dir=c:/journal/"); my $sth = $dbh->prepare ("SELECT id FROM entries") || die "$! and +$DBI::errstr"; $sth->execute; my $maxid; while (my $thisrow = $sth->fetchrow_arrayref) { if ($$thisrow[0] > $maxid) {$maxid = $$thisrow[0]} }; $maxid++; my $title = $dbh->quote ($$$vars{params}{title}); my $date = $dbh->quote (scalar localtime); my $entry = $dbh->quote (unpack ("H*",$$$vars{params}{entry})); + # Hi, Tye! $sth = $dbh->prepare ("INSERT INTO entries (id, date, title, entry +) VALUES ($maxid, $date,$title, $entry)")|| die "$! and $DBI::errstr" +; $sth->execute; }
This shows one particular segment of how the framework is used. It segments common tasks into automatable subroutines, and allows the programmer to decide how to build upon the framework.sub write_valid { my $vars = shift; my $error = shift; my $ret_code; my @t = param ("title"); my @e = param ("entry"); unless ($t[-1]){$ret_code |= 1}; unless ($e[-1]){$ret_code |= 2}; return $ret_code; }
package Framework; #!/usr/bin/perl -w # In nomine Ad Signo, et Percentus, et Dollar Signo Sancti. Amen. use strict; require Exporter; use Template; use DBI; use CGI::Carp qw(fatalsToBrowser); use CGI qw(:all); use constant DEBUG => 0; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use vars qw($defaultpage $Current_Page %pages); my $vars; my $errorlevel; @ISA = qw(Exporter); @EXPORT = qw(%pages &InsertPage_hashref &InsertPage_arrayref &Run +Pages $defaultpage &dump_struct &set_errorlevel &get_errorlevel &set_var &get_var); # # inserts a page into the hash via an array. # # sub InsertPage_arrayref ($) { my @_parms=@{@_[0]}; # Make sure there's the right # of keys to do the job. if (scalar @_parms == 11) { unless ($defaultpage) {$defaultpage = $_parms[0]}; if (defined $_parms[1]){ load_lib ($_parms[1],"main")}; $pages {$_parms[0]} = { description => $_parms[1], traverse_list => $_parms[3], traverse_sub => $_parms[4], validator => $_parms[5], errorhandler => $_parms[6], template => $_parms[7], preprocess => $_parms[8], postsubmit => $_parms[9], params => $_parms[10], } } else { die "wrong number of elements passed to InsertPage_arrayref. E +xpected 11, got ". (scalar @_parms) } } # # inserts a page into the %pages hash via a hash. # # sub InsertPage_hashref ($) { my %_parms= %{@_[0]}; # Make sure there's the right keys to do the job. if (CheckKeys (\%_parms,["pagename","description","traverse_list", "traverse_sub","validator","errorhandler", "template","preprocess","postsubmit","params" +])) { # # ok, all the parameters are there, what about the default p +age? # # unless ($defaultpage) {$defaultpage = $_parms{pagename}}; # # check to see if we should load a module for this page. # # if (defined $_parms{module}){ load_lib ($_parms{module},"main" +)}; #eval "require \"$_parms{module}\""|| die "no module"; $pages {$_parms{pagename}} = { description => $_parms{description }, traverse_list => $_parms{traverse_list}, traverse_sub => $_parms{traverse_sub }, validator => $_parms{validator }, errorhandler => $_parms{errorhandler }, template => $_parms{template }, preprocess => $_parms{preprocess }, postsubmit => $_parms{postsubmit }, params => $_parms{params }, } } } # # Checks a hash to make sure a set of keys exist. # # sub CheckKeys (\%\@) { my %hash = %{$_[0]}; my @keys = @{$_[1]}; foreach (@keys) { if (! exists ($hash{$_})) { return 0} } return 1; } # # This sub is the meat of this module... # it uses information to display HTML pages from # %pages. Verifies parameters, and contains logic to # perform pre and post display functions. # # sub RunPages { print header (-type=>'text/html'); print start_html; print start_form; # remember that all hidden fields need to be w +ithinthe form, they're input! debugprint ( "checking Current_page ".br); # # separate into sub # # # # Current_Page is a parameter that will be set immediately befor +e a page is displayed. # Inside of the program, it is analogous to $Current_Page, and i +s used to determine # what set of subroutines should be run. # If param ("Current_Page") exists, that means that the user's C +GI script has run through at least once. # We'll grab it's contents and stuff it into $Current_Page. # But if param ("Current_Page") doesn't exist, then we set $Curr +ent_Page to the # contents of $defaultpage, which is typically the first page in +serted. # Note that $defaultpage is exported, so that users can set it t +o whichever page they prefer. # to display as their first. # if (param ("Current_Page")){ debugprint ("found Current_page set to ".param ("Current_Page" +).br); $Current_Page = param ("Current_Page"); debugprint ("Checking Current_Page for validator<BR>"); # # Here, we are checking to see if the current page has a validat +or defined. # If it does, run it and store the result in $errorlevel. # $errorlevel is then passed to all other subs as a way of deter +mining state. # 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; } debugprint ("printing parameters<BR>"); # # Here we go through each page, and see what its params are. # Note that I rarely use param lists, so I only write each # parameter's last value. # This prevents duplication of parameters when pages refer back # to themselves. # I consider this to be a problem, but I'm not sure how to fix i +t :| # foreach my $thispage (keys %pages){ foreach (@{$pages{$thispage}{params}}) { debugprint ("looking at param $_"); my @temp_param = param($_); if ((param($_))){print hidden ($_, $temp_param[-1])} $$vars{params}{$_}= $temp_param[-1]; debugprint ("Parameter '$_' set to '$temp_param[-1]'<B +R>"); } } debugprint ("Done printing parameters<BR>"); debugprint ("Checking traversal list<BR>"); my $nextpage; # # Here we check the current page's traversal list. # As a default, if it has no traverse_sub, it'll loop back to $C +urrent_Page. # Right now, the traverse_sub is called with references to $vars + and $errorlevel, but # this should be unneeded with the introduction of (get|set)_(va +r|errorlevel|param) # I'm leaving it in right now. # # As a side effect of the order of processing things, it becomes + convenient to # check for param("Current_Page") in the default page's validato +r, and have it return itself # if param("Current_Page") doesn't exist. # if ($pages{$Current_Page}{traverse_sub} ne "") { debugprint ("Traversal list found... <BR>"); $nextpage = $pages{$Current_Page}{traverse_sub}->(\$vars,\$err +orlevel); } else { debugprint ("No traverse_sub for page 'Current_Page'. Are you +sure about that? Setting next_page to 'Current_Page'"); $nextpage = $Current_Page; } debugprint ("Traverse_sub returns '$nextpage'<BR>"); # # Paranoia? # if (defined $nextpage) { # # make sure that $nextpage is in the current page's traverse + list. # unless (defined ($pages{$Current_Page}{traverse_list}{$nextpag +e})){ debugprint ("tried to access undefined key in $Current_Pag +e traverse_list : $nextpage"); #die; } # # SO we survived that. # Now we check the value of $nextpage 's entry in traverse_l +ist. # If it's true, we check for and execute $Current_Page's pos +tsubmit. # debugprint ("Checking for '$Current_Page' traverse for post su +bmit <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, \$errorlev +el); debugprint ("Done with '$Current_Page' post submit<BR> +"); } else { debugprint ("No post submit found, but traversal post +submit set to 1!<BR>"); } } else { debugprint ("No post submit found, but traversal post subm +it set to 1!<BR>"); }; # # OK. # At this point in the game, the previous page has been disp +layed, # or the default page has been queued up. # # debugprint ("Setting Current_Page to '$nextpage'<BR>"); $Current_Page = $nextpage; } else { debugprint ("Nextpage is not defined... what happened here?<BR +>"); } # # These are 4 special vars that will get loaded for any page. # $$vars{pagetitle} is a reference to the description, I use # it to define titles in my html templates. # Will probably go away once I come to my sense. # # $$vars{current_page} is used to drive the RunPages subroutine. # very much needed. # # $$vars{error_level} is a way to pass the errorlevel onto the # HTML templates. This way you can have blocks like : # [% IF error_level %] Don't do that again! [% END %] # and so on. # # related to this is get_bit, which really should be unnecessary +, but # I can't seem to get tt2 to recognize bitwise ops. # having get_bit available to the HTML Template will allow users # to define bitflags in their errorcodes and check for them in # templates. # 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) & +(scalar shift))}}; # why doesn't TT2 recognize bitwise ops? :( debugprint ("Hiding current_page -- $Current_Page<BR>"); param('Current_Page',$Current_Page); print hidden ("Current_Page", $Current_Page); debugprint ("Setting Template<BR>"); debugprint ("Checking for preprocess sub<BR>\n"); # # And now prepare to do any preprocessing for the real current p +age. # if (defined $pages{$Current_Page}{preprocess}) { $pages{$Current_Page}{preprocess}->(\$vars, \$errorlevel); } else { debugprint ("no preprocess sub found<BR>\n"); } # # show the 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 ("<BR>Done printing template<BR>\n"); debugprint ("Cleaning up<BR>"); print end_form; print end_html; } sub set_errorlevel { $errorlevel = $_[0]; } sub get_errorlevel { return $errorlevel; } sub set_var { my $_key = shift; my $_val = shift; print "setting \$\$vars {$_key} to $_val"; $$vars {$_key} = $_val; } sub get_var { if (exists $$vars{$_[0]}) {return \$$vars{$_[0]}} else {return undef} } sub get_param { if (exists $$vars{params}{$_[0]}) {return \$$vars{params}{$_[0]}} else {return undef} } sub set_param { $$vars{params}{$_[0]} } # #this will print an html table showing # the structure of the assembled %pages # currently broken for pages that have # recursive references. :( # # sub dump_struct{ my $cp = $defaultpage; print "<CENTER>"; print "<TABLE BORDER=1>"; print "<TH>Page Name</TH><TH>children</TH><TH>Verified?</TH>"; dump_line ($cp); print "</TABLE>"; } sub dump_line{ my $cp=shift; if (keys %{$pages{$cp}{traverse_list}}){ foreach (sort keys %{$pages{$cp}{traverse_list}}) { print "<TR><TD>$cp</TD><TD>", ($_ eq $cp)?"<I>self</I> +":$_,"</TD><TD>", $pages{$cp}{traverse_list}{$_}?"yes":"no","</TD> +"; } foreach (sort keys %{$pages{$cp}{traverse_list}}) { unless ($_ eq $cp) {dump_line ($_)} } } else { print "<TR><TD>$cp</TD><TD COLSPAN=3>no children</td>"; } } # # Loads a file into a package. # # Courtesy Ben Tilly. # # node_id=52229 # sub load_lib { my $file = shift; my $pkg = shift; my $ret = eval "package $pkg; do '$file';"; if (not defined($ret)) { $@ and confess("Cannot parse '$file': $@"); $! and confess("Cannot load '$file': $!"); $@ and debugprint ("Cannot parse '$file': $@"); $! and debugprint ("Cannot load '$file': $!"); warn("Loading '$file' did not return a defined value"); } $ret; } sub debugprint { if (DEBUG) {print scalar localtime , " : ", @_, "\n"}; }
I encourage you to post any comments you have. I want to develop this into a professional quality module -- I've come up with some changes I want to make just explaining this, and I'd appreciate suggestions from the community at large.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re (tilly) 1: Framework.pm 0.01a
by tilly (Archbishop) on May 06, 2001 at 05:12 UTC | |
by boo_radley (Parson) on May 06, 2001 at 21:42 UTC | |
|
Re: Framework.pm 0.01a
by nop (Hermit) on May 11, 2001 at 16:20 UTC |