From a8620142ba0dcda3f0c5f102f791df944ed2245e Mon Sep 17 00:00:00 2001 From: Paul Seamons Date: Wed, 31 May 2006 00:00:00 +0000 Subject: [PATCH] CGI::Ex 2.01 --- Changes | 7 +++- META.yml | 2 +- lib/CGI/Ex.pm | 2 +- lib/CGI/Ex/App.pm | 81 ++++++++++++++++++++++--------------- lib/CGI/Ex/App.pod | 89 +++++++++++++++++++++++++++++++++-------- lib/CGI/Ex/Auth.pm | 2 +- lib/CGI/Ex/Conf.pm | 2 +- lib/CGI/Ex/Dump.pm | 2 +- lib/CGI/Ex/Fill.pm | 2 +- lib/CGI/Ex/Template.pm | 2 +- lib/CGI/Ex/Template.pod | 2 +- lib/CGI/Ex/Validate.pm | 2 +- lib/CGI/Ex/Var.pm | 2 +- 13 files changed, 138 insertions(+), 59 deletions(-) diff --git a/Changes b/Changes index f7bb39d..f11632b 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,9 @@ -2.00 +2.01 2006-05-31 + * Added App refine_path hook. + * Added App destroy method. + * Fix CGI::Ex::Template perldoc. + +2.00 2006-05-30 * Added CGI::Ex::Template and test suites * Allow for CGI::Ex::Template to be fully TT2 syntax compliant * Re-implementation of CGI::Ex::Auth diff --git a/META.yml b/META.yml index 42b202a..8eeae39 100644 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: CGI-Ex -version: 2.00 +version: 2.01 version_from: lib/CGI/Ex.pm installdirs: site requires: diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm index 03d0f02..952bf7a 100644 --- a/lib/CGI/Ex.pm +++ b/lib/CGI/Ex.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.00'; + $VERSION = '2.01'; $PREFERRED_CGI_MODULE ||= 'CGI'; @EXPORT = (); @EXPORT_OK = qw(get_form diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index a177c7f..313baf4 100644 --- a/lib/CGI/Ex/App.pm +++ b/lib/CGI/Ex/App.pm @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION); BEGIN { - $VERSION = '2.00'; + $VERSION = '2.01'; Time::HiRes->import('time') if eval {require Time::HiRes}; } @@ -37,6 +37,8 @@ sub new { sub init {} +sub destroy {} + ###----------------------------------------------------------------### sub navigate { @@ -74,6 +76,8 @@ sub navigate { $self->{'_time'} = time; + $self->destroy; + return $self; } @@ -118,13 +122,20 @@ sub nav_loop { $self->morph($step); ### run the guts of the step - my $status = $self->run_hook('run_step', $step); - - $self->unmorph($step); + my $handled = $self->run_hook('run_step', $step); ### Allow for the run_step to intercept. ### A true status means the run_step took over navigation. - return if $status; + if ($handled) { + $self->unmorph($step); + return; + } + + ### if there are no future steps - allow for this step to designate one to follow + my $is_at_end = $self->{'path_i'} >= $#$path ? 1 : 0; + $self->run_hook('refine_path', $step, $is_at_end); + + $self->unmorph($step); } ### allow for one exit point after the loop @@ -320,31 +331,26 @@ sub step_by_path_index { sub previous_step { my $self = shift; - croak "previous_step is readonly" if $#_ != -1; return $self->step_by_path_index( ($self->{'path_i'} || 0) - 1 ); } sub current_step { my $self = shift; - croak "current_step is readonly" if $#_ != -1; return $self->step_by_path_index( ($self->{'path_i'} || 0) ); } -sub next_step { +sub next_step { # method and hook my $self = shift; - croak "next_step is readonly" if $#_ != -1; return $self->step_by_path_index( ($self->{'path_i'} || 0) + 1 ); } sub last_step { my $self = shift; - croak "last_step is readonly" if $#_ != -1; return $self->step_by_path_index( $#{ $self->path } ); } sub first_step { my $self = shift; - croak "first_step is readonly" if $#_ != -1; return $self->step_by_path_index( 0 ); } @@ -378,7 +384,6 @@ sub run_hook { croak "Could not find a method named ${step}_${hook} or ${hook}"; } - ### record history my $hist = { step => $step, @@ -460,9 +465,9 @@ sub allow_nested_morph { } sub morph { - my $self = shift; - my $step = shift || return; - return if ! (my $allow = $self->allow_morph($step)); + my $self = shift; + my $step = shift || return; + my $allow = $self->allow_morph($step) || return; ### place to store the lineage my $lin = $self->{'__morph_lineage'} ||= []; @@ -474,13 +479,14 @@ sub morph { meth => 'morph', found => 'morph', time => time, - elapsed => 0, + elapsed => 0, + response => 0 }; push @{ $self->history }, $hist; if (ref($allow) && ! $allow->{$step}) { # hash - but no step - record for unbless $hist->{'found'} .= " (not allowed to morph to that step)"; - return; + return 0; } ### make sure we haven't already been reblessed @@ -489,7 +495,7 @@ sub morph { || (ref($allow) && ! $allow->{$step}) # hash - but no step )) { $hist->{'found'} .= $allow ? " (not allowed to nested_morph to that step)" : " (nested_morph disabled)"; - return; # just return - don't die so that we can morph early + return 0; # just return - don't die so that we can morph early } ### if we are not already that package - bless us there @@ -516,6 +522,8 @@ sub morph { } } + $hist->{'response'} = 1; + return 1; } sub unmorph { @@ -533,7 +541,8 @@ sub unmorph { meth => 'unmorph', found => 'unmorph', time => time, - elapsed => 0, + elapsed => 0, + response => 0, }; push @{ $self->history }, $hist; @@ -545,6 +554,7 @@ sub unmorph { $hist->{'found'} .= " (already isa $cur)"; } + $hist->{'response'} = 1; return $self; } @@ -698,6 +708,16 @@ sub run_step { return 0; } +sub refine_path { + my ($self, $step, $is_at_end) = @_; + return 0 if ! $is_at_end; # if we aren't at the end of the path, don't do anything + + my $next_step = $self->run_hook('next_step', $step) || return 0; + $self->run_hook('set_ready_validate', $step, 0); + $self->append_path($next_step); + return 1; +} + sub prepared_print { my $self = shift; my $step = shift; @@ -840,30 +860,27 @@ sub file_val { } sub info_complete { - my $self = shift; - my $step = shift; - + my ($self, $step) = @_; return 0 if ! $self->run_hook('ready_validate', $step); - return 0 if ! $self->run_hook('validate', $step); + return 0 if ! $self->run_hook('validate', $step, $self->form); return 1; } sub ready_validate { - my $self = shift; - my $step = shift; - + my ($self, $step) = @_; return ($ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq 'POST') ? 1 : 0; } -sub set_ready_validate { - my ($self, $ready) = @_; - $ENV{'REQUEST_METHOD'} = ($ready) ? 'POST' : 'GET'; +sub set_ready_validate { # hook and method + my $self = shift; + my ($step, $is_ready) = (@_ == 2) ? @_ : (undef, shift); + $ENV{'REQUEST_METHOD'} = ($is_ready) ? 'POST' : 'GET'; + return $is_ready; } sub validate { - my $self = shift; - my $step = shift; - my $form = shift || $self->form; + my ($self, $step, $form) = @_; + my $hash = $self->run_hook('hash_validation', $step); my $what_was_validated = []; diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod index 7e6fe25..e7c827d 100644 --- a/lib/CGI/Ex/App.pod +++ b/lib/CGI/Ex/App.pod @@ -158,7 +158,7 @@ Now we need to invoke the process: exit; Note: the "exit" isn't necessary - but it is kind of nice to infer -that program flow doesn't go beyond the ->navigate call. +that process flow doesn't go beyond the ->navigate call. The navigate routine is now going to try and "run" through a series of steps. Navigate will call the ->path method which should return an @@ -290,7 +290,7 @@ ready to validate so it prints out the template page. For more of a real world example, it would be good to read the sample recipe db application included at the end of this document. -=head1 DEFAULT PROGRAM FLOW +=head1 DEFAULT PROCESS FLOW The following pseudo-code describes the process flow of the CGI::Ex::App framework. Several portions of the flow @@ -300,6 +300,8 @@ like a lot to follow, but if the process is broken down into the discrete operations of step iteration, data validation, and template printing the flow feels more natural. +=head2 navigate + The process starts off by calling ->navigate. navigate { @@ -309,8 +311,12 @@ The process starts off by calling ->navigate. ->post_navigate } # dying errors will run the ->handle_error method + + ->destroy } +=head2 nav_loop + The nav_loop method will run as follows: nav_loop { @@ -333,6 +339,11 @@ The nav_loop method will run as follows: ->run_step (hook) + ->refine_path (hook) + # only called if run_step returned false (page not printed) + ->next_step (hook) # find next step and add to path + ->set_ready_validate(0) (hook) + ->unmorph # only called if morph worked # ->fixup_before_unmorph if blessed to current package @@ -350,6 +361,8 @@ The nav_loop method will run as follows: } end of nav_loop +=head2 run_step (hook) + For each step of the path the following methods will be run during the run_step hook. @@ -540,6 +553,12 @@ If nav_loop runs of the end of the path (runs out of steps), this method is called, the step is added to the path, and nav_loop calls itself recursively. +=item destroy (method) + +Called at the end of navigate after all other actions have run. Can +be used for undoing things done in the ->init method called during +the ->new method. + =item dump_history (method) Show simplified trace information of which steps were called, the @@ -1161,11 +1180,18 @@ object has been blessed to allow for any other initilizations. my $app = MyApp->new({name_module => 'my_app'}); -=item next_step (method) +=item next_step (hook and method) Returns the next step in the path. If there is no next step, it returns the default_step. +It can be used as a method to return the next step in the path +to pass to a method such as ->jump. + +It is also used as a hook by the refine_path hook. If there is no +more steps, it will call the next_step hook to try and find a step to +append to the path. + =item path (method) Return an arrayref (modifiable) of the steps in the path. For each @@ -1291,6 +1317,23 @@ and check for its presence - such as the following: Changing the behavior of ready_validate can help in making wizard type applications. +=item refine_path (hook) + +Called at the end of nav_loop. Passed a single value indicating +if there are currently more steps in the path. + +The default implementation returns if there are still more steps +in the path. Otherwise, it calls the next_step hook and appends +it to the path with the append_path method, and then calls +the set_ready_validate hook and passes it 0. + +This allows you to simply put + + sub edit_next_step { '_edit_success' } + +In your code and it will automatically do the right thing and +go to the _edit_success step. + =item recurse_limit (method) Default 15. Maximum number of times to allow nav_loop to call itself. @@ -1388,25 +1431,38 @@ begins. This will set the path arrayref to the passed steps. This method is not normally used. -=item set_ready_validate (method) +=item set_ready_validate (hook and method) -Sets that the validation is ready to validate. Should set the value +Sets that the validation is ready (or not) to validate. Should set the value checked by the hook ready_validate. The following would complement the processing flag above: sub set_ready_validate { my $self = shift; - if (shift) { + my ($step, $is_ready) = (@_ == 2) ? @_ : (undef, shift); + if ($is_ready) { $self->form->{'processing'} = 1; } else { delete $self->form->{'processing'}; } + return $is_ready; } Note that for this example the form key "processing" was deleted. This is so that the call to fill in any html forms won't swap in a value of zero for form elements named "processing." +Also note that this method may be called as a hook as in + + $self->run_hook('set_ready_validate', $step, 0) + # OR + $self->set_ready_validate($step, 0); + +Or it can take a single argument and should set the ready status +regardless of the step as in: + + $self->set_ready_validate(0); + =item skip (hook) Ran at the beginning of the loop before prepare, info_complete, and @@ -1474,16 +1530,17 @@ the data before running finalize. =item validate (hook) -Runs validation on the information posted in $self->form. Uses -CGI::Ex::Validate for the default validation. Calls the hook -hash_validation to load validation information. Should return true if -the form passed validation and false otherwise. Errors are stored as -a hash in $self->{hash_errors} via method add_errors and can be -checked for at a later time with method has_errors (if the default -validate was used). - -There are many ways and types to validate the data. Please see the L -module. +Passed the form from $self->form. Runs validation on the information +contained in the passed form. Uses CGI::Ex::Validate for the default +validation. Calls the hook hash_validation to load validation hashref +(an empty hash means to pass validation). Should return true if the +form passed validation and false otherwise. Errors are stored as a +hash in $self->{hash_errors} via method add_errors and can be checked +for at a later time with method has_errors (if the default validate +was used). + +There are many ways and types to validate the data. Please see the +L module. Upon success, it will look through all of the items which were validated, if any of them contain the keys append_path, insert_path, diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index 49c9a19..2169318 100644 --- a/lib/CGI/Ex/Auth.pm +++ b/lib/CGI/Ex/Auth.pm @@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64); use Digest::MD5 qw(md5_hex); use CGI::Ex; -$VERSION = '2.00'; +$VERSION = '2.01'; ###----------------------------------------------------------------### diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 9bd3a00..5bcedfd 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -28,7 +28,7 @@ use vars qw($VERSION ); @EXPORT_OK = qw(conf_read conf_write); -$VERSION = '2.00'; +$VERSION = '2.01'; $DEFAULT_EXT = 'conf'; diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm index c886324..d93a8ca 100644 --- a/lib/CGI/Ex/Dump.pm +++ b/lib/CGI/Ex/Dump.pm @@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION use strict; use Exporter; -$VERSION = '2.00'; +$VERSION = '2.01'; @ISA = qw(Exporter); @EXPORT = qw(dex dex_warn dex_text dex_html ctrace dex_trace); @EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug); diff --git a/lib/CGI/Ex/Fill.pm b/lib/CGI/Ex/Fill.pm index 662c0d9..b90acf9 100644 --- a/lib/CGI/Ex/Fill.pm +++ b/lib/CGI/Ex/Fill.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.00'; + $VERSION = '2.01'; @EXPORT = qw(form_fill); @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key); }; diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index a285902..f326155 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -36,7 +36,7 @@ use vars qw($VERSION ); BEGIN { - $VERSION = '2.00'; + $VERSION = '2.01'; $PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception'; $PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator'; diff --git a/lib/CGI/Ex/Template.pod b/lib/CGI/Ex/Template.pod index 832a57b..e0ea842 100644 --- a/lib/CGI/Ex/Template.pod +++ b/lib/CGI/Ex/Template.pod @@ -1,4 +1,4 @@ -=head1 +=head1 NAME CGI::Ex::Template - Fast and lightweight TT2/3 template engine diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index e76695d..b0de244 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -22,7 +22,7 @@ use vars qw($VERSION @UNSUPPORTED_BROWSERS ); -$VERSION = '2.00'; +$VERSION = '2.01'; $DEFAULT_EXT = 'val'; $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; diff --git a/lib/CGI/Ex/Var.pm b/lib/CGI/Ex/Var.pm index 10bf7e0..c7b1d08 100644 --- a/lib/CGI/Ex/Var.pm +++ b/lib/CGI/Ex/Var.pm @@ -2,7 +2,7 @@ package CGI::Ex::Var; =head1 NAME -CGI::Ex::Var - Variable and expression parsing and execution for CGI::Ex::Template (and other takers) +CGI::Ex::Var - Variable and expression parsing (exprimental) =head1 DESCRIPTION -- 2.43.0