From ba92ea5b36cbcd9c03016491dfb06dfc74baf409 Mon Sep 17 00:00:00 2001 From: Paul Seamons Date: Fri, 22 Jun 2007 00:00:00 +0000 Subject: [PATCH] CGI::Ex 2.16 --- Changes | 5 ++ META.yml | 4 +- Makefile.PL | 2 +- README | 6 +-- lib/CGI/Ex.pm | 10 ++-- lib/CGI/Ex/App.pm | 80 +++++++++++++++++--------------- lib/CGI/Ex/App.pod | 102 ++++++++++++++++++++++------------------- lib/CGI/Ex/Auth.pm | 8 +++- lib/CGI/Ex/Conf.pm | 10 ++-- lib/CGI/Ex/Die.pm | 8 +++- lib/CGI/Ex/Dump.pm | 8 +++- lib/CGI/Ex/Fill.pm | 4 +- lib/CGI/Ex/JSONDump.pm | 8 +++- lib/CGI/Ex/Template.pm | 12 ++--- lib/CGI/Ex/Validate.pm | 10 ++-- 15 files changed, 155 insertions(+), 122 deletions(-) diff --git a/Changes b/Changes index d3f9bcd..334aab4 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +2.16 + 2007-06-21 + * Add default __error step which is called by default handle_error method. + * Default base_dir_abs to '.' + 2.15 2007-06-20 * Fix some warning issues with the Recipe sample in App diff --git a/META.yml b/META.yml index 9025e12..6b82f0c 100644 --- a/META.yml +++ b/META.yml @@ -1,11 +1,11 @@ # 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.15 +version: 2.16 version_from: lib/CGI/Ex.pm installdirs: site requires: - Template::Alloy: 1.003 + Template::Alloy: 1.004 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01 diff --git a/Makefile.PL b/Makefile.PL index 6b47c5a..5acd84f 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -12,7 +12,7 @@ WriteMakefile( VERSION_FROM => "lib/CGI/Ex.pm", INSTALLDIRS => 'site', PREREQ_PM => { - 'Template::Alloy' => '1.003', + 'Template::Alloy' => '1.004', }, dist => { diff --git a/README b/README index 8fd2d39..fcafd52 100644 --- a/README +++ b/README @@ -332,9 +332,9 @@ MODULES See also CGI::Ex::Validate. -AUTHOR - Paul Seamons - LICENSE This module may be distributed under the same terms as Perl itself. +AUTHOR + Paul Seamons + diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm index 750b5ce..ed1b511 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.15'; + $VERSION = '2.16'; $PREFERRED_CGI_MODULE ||= 'CGI'; @EXPORT = (); @EXPORT_OK = qw(get_form @@ -1038,12 +1038,12 @@ See also L. See also L. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. +=head1 AUTHOR + +Paul Seamons + =cut diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index ec3ff6a..2c7ecee 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.15'; + $VERSION = '2.16'; Time::HiRes->import('time') if eval {require Time::HiRes}; eval {require Scalar::Util}; @@ -54,7 +54,7 @@ sub navigate { ### run the step loop eval { - local $self->{'__morph_lineage_start_index'} = $#{$self->{'__morph_lineage'} || []}; + local $self->{'_morph_lineage_start_index'} = $#{$self->{'_morph_lineage'} || []}; $self->nav_loop; }; if ($@) { @@ -80,8 +80,8 @@ sub nav_loop { my $self = shift; ### keep from an infinate nesting - local $self->{'recurse'} = $self->{'recurse'} || 0; - if ($self->{'recurse'} ++ >= $self->recurse_limit) { + local $self->{'_recurse'} = $self->{'_recurse'} || 0; + if ($self->{'_recurse'}++ >= $self->recurse_limit) { my $err = "recurse_limit (".$self->recurse_limit.") reached"; $err .= " number of jumps (".$self->{'jumps'}.")" if ($self->{'jumps'} || 0) > 1; croak $err; @@ -170,15 +170,22 @@ sub handle_error { my $self = shift; my $err = shift; - die $err; + die $err if $self->{'_handling_error'}; + local $self->{'_handling_error'} = 1; + local $self->{'_recurse'} = 0; # allow for this next step - even if we hit a recurse error + + $self->stash->{'error_step'} = $self->current_step; + $self->stash->{'error'} = $err; + $self->replace_path($self->error_step); + $self->jump; # exits nav loop when finished } ###----------------------------------------------------------------### -sub default_step { shift->{'default_step'} || 'main' } - -sub js_step { shift->{'js_step'} || 'js' } - +sub default_step { shift->{'default_step'} || 'main' } +sub js_step { shift->{'js_step'} || 'js' } +sub login_step { shift->{'login_step'} || '__login' } +sub error_step { shift->{'error_step'} || '__error' } sub forbidden_step { shift->{'forbidden_step'} || '__forbidden' } sub step_key { shift->{'step_key'} || 'step' } @@ -277,9 +284,9 @@ sub exit_nav_loop { my $self = shift; ### undo morphs - if (my $ref = $self->{'__morph_lineage'}) { + if (my $ref = $self->{'_morph_lineage'}) { ### use the saved index - this allows for early "morphers" to only get rolled back so far - my $index = $self->{'__morph_lineage_start_index'}; + my $index = $self->{'_morph_lineage_start_index'}; $index = -1 if ! defined $index; $self->unmorph while $#$ref != $index; } @@ -497,7 +504,7 @@ sub morph { my $allow = $self->allow_morph($step) || return; ### place to store the lineage - my $lin = $self->{'__morph_lineage'} ||= []; + my $lin = $self->{'_morph_lineage'} ||= []; my $cur = ref $self; # what are we currently push @$lin, $cur; # store so subsequent unmorph calls can do the right thing @@ -555,12 +562,12 @@ sub morph { sub unmorph { my $self = shift; - my $step = shift || '__no_step'; - my $lin = $self->{'__morph_lineage'} || return; + my $step = shift || '_no_step'; + my $lin = $self->{'_morph_lineage'} || return; my $cur = ref $self; my $prev = pop(@$lin) || croak "unmorph called more times than morph - current ($cur)"; - delete $self->{'__morph_lineage'} if ! @$lin; + delete $self->{'_morph_lineage'} if ! @$lin; ### if we are not already that package - bless us there my $hist = { @@ -642,7 +649,7 @@ sub get_valid_auth { $args->{'cleanup_user'} ||= sub { my ($auth, $user) = @_; $self->cleanup_user( $user, $auth) }; $args->{'login_print'} ||= sub { my ($auth, $template, $hash) = @_; - my $step = '__login'; + my $step = $self->login_step; my $hash_base = $self->run_hook('hash_base', $step) || {}; my $hash_comm = $self->run_hook('hash_common', $step) || {}; my $hash_swap = $self->run_hook('hash_swap', $step) || {}; @@ -732,8 +739,8 @@ sub clear_app { path path_i history - __morph_lineage_start_index - __morph_lineage + _morph_lineage_start_index + _morph_lineage hash_errors hash_fill hash_swap @@ -818,11 +825,8 @@ sub prepared_print { sub print { my ($self, $step, $swap, $fill) = @_; - my $file = $self->run_hook('file_print', $step); # get a filename relative to base_dir_abs - my $out = $self->run_hook('swap_template', $step, $file, $swap); - $self->run_hook('fill_template', $step, \$out, $fill); $self->run_hook('print_out', $step, \$out); } @@ -831,24 +835,17 @@ sub print_out { my ($self, $step, $out) = @_; $self->cgix->print_content_type; - print ref($out) ? $$out : $out; + print ref($out) eq 'SCALAR' ? $$out : $out; } sub swap_template { my ($self, $step, $file, $swap) = @_; my $args = $self->run_hook('template_args', $step); - my $copy = $self; - eval {require Scalar::Util; Scalar::Util::weaken($copy)}; - $args->{'INCLUDE_PATH'} ||= sub { - my $dir = $copy->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\""; - $dir = $dir->() if UNIVERSAL::isa($dir, 'CODE'); - return $dir; - }; + $args->{'INCLUDE_PATH'} ||= $self->base_dir_abs; - my $t = $self->template_obj($args); + my $t = $self->template_obj($args); my $out = ''; - $t->process($file, $swap, \$out) || die $t->error; return $out; @@ -1107,25 +1104,25 @@ sub add_to_hash { sub base_dir_rel { my $self = shift; - $self->{'base_dir_rel'} = shift if $#_ != -1; + $self->{'base_dir_rel'} = shift if @_ == 1; return $self->{'base_dir_rel'} || ''; } sub base_dir_abs { my $self = shift; - $self->{'base_dir_abs'} = shift if $#_ != -1; - return $self->{'base_dir_abs'} || ''; + $self->{'base_dir_abs'} = shift if @_ == 1; + return $self->{'base_dir_abs'} || ['.']; # default to the current directory } sub ext_print { my $self = shift; - $self->{'ext_print'} = shift if $#_ != -1; + $self->{'ext_print'} = shift if @_ == 1; return $self->{'ext_print'} || 'html'; } sub ext_val { my $self = shift; - $self->{'ext_val'} = shift if $#_ != -1; + $self->{'ext_val'} = shift if @_ == 1; return $self->{'ext_val'} || 'val'; } @@ -1164,10 +1161,19 @@ sub js_run_step { sub __forbidden_info_complete { 0 } -sub __forbidden_hash_swap { {forbidden_step => shift->stash->{'forbidden_step'}} } +sub __forbidden_hash_swap { shift->stash } sub __forbidden_file_print { \ "

Denied

You do not have access to the step \"[% forbidden_step %]\"" } +###----------------------------------------------------------------### +### a step that is used by the default handle_error + +sub __error_info_complete { 0 } + +sub __error_hash_swap { shift->stash } + +sub __error_file_print { \ "

An a fatal error occurred

Step: \"[% error_step %]\"
[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" } + ###----------------------------------------------------------------### 1; diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod index 6fe9746..3b93a78 100644 --- a/lib/CGI/Ex/App.pod +++ b/lib/CGI/Ex/App.pod @@ -132,8 +132,10 @@ How about a form with validation (inluding javascript validation)... There are infinite possibilities. There is a longer "SYNOPSIS" after the process flow discussion and more examples near the end of this document. It is interesting to note that there have been no databases -so far. CGI::Ex::App is Controller/Viewer that is somewhat Model -agnostic. +so far. It is very, very difficult to find a single database +abstraction that fits every model. CGI::Ex::App is Controller/Viewer +that is somewhat Model agnostic and doesn't come with any default +database abstraction. =head1 DESCRIPTION @@ -245,16 +247,16 @@ during the run_step hook. run_step { ->pre_step (hook) - # exits nav_loop if true + # skips this step if true and exit nav_loop ->skip (hook) - # skips this step if true (stays in nav_loop) + # skips this step if true and stays in nav_loop ->prepare (hook - defaults to true) ->info_complete (hook - ran if prepare was true) ->ready_validate (hook) - return false if ! ready_validate + # returns false from info_complete if ! ready_validate ->validate (hook - uses CGI::Ex::Validate to validate form info) ->hash_validation (hook) ->file_val (hook) @@ -263,7 +265,7 @@ during the run_step hook. ->name_module ->name_step ->ext_val - returns true if validate is true or if nothing to validate + # returns true if validate is true or if nothing to validate ->finalize (hook - defaults to true - ran if prepare and info_complete were true) @@ -1113,8 +1115,8 @@ The following items will be cleared: path path_i history - __morph_lineage_start_index - __morph_lineage + _morph_lineage_start_index + _morph_lineage hash_errors hash_fill hash_swap @@ -1202,6 +1204,11 @@ called is "view". " view - post_print - post_print - 0.00003 - 0" ]; +=item error_step (method) + +Defaults to "__error". The name of a step to run should a dying error +be caught by the default handle_error method. See the handle_error method. + =item exit_nav_loop (method) This method should not normally used but there is no problem with @@ -1235,40 +1242,6 @@ then the file "foo.val" will be searched for. See the section on FINDING TEMPLATES for further discussion. -=item first_step (method) - -Returns the first step of the path. Note that first_step may not be the same -thing as default_step if the path was overridden. - -=item form (method) - -Returns a hashref of the items passed to the CGI. Returns -$self->{form} which defaults to CGI::Ex::get_form. - -=item handle_error (method) - -If anything dies during execution, handle_error will be called with -the error that had happened. Default action is to die with that error. - -=item history (method) - -Returns an arrayref which contains trace history of which hooks of -which steps were ran. Useful for seeing what happened. In general - -each line of the history will show the current step, the hook -requested, and which hook was actually called. - -The dump_history method shows a short condensed version of this -history which makes it easier to see what path was followed. - -In general, the arrayref is free for anything to push onto which will -help in tracking other occurrences in the program as well. - -=item init (method) - -Called by the default new method. Allows for any object -initilizations that may need to take place. Default action does -nothing. - =item fill_args (hook) Returns a hashref of args that will be passed to the CGI::Ex::Fill::fill. @@ -1324,7 +1297,7 @@ The file should be readable by CGI::Ex::Validate::get_validation. This hook is only necessary if the hash_validation hook has not been overridden. - +5B This method an also return a hashref containing the validation - but then you may have wanted to override the hash_validation hook. @@ -1368,12 +1341,22 @@ override the base package (it is still OK to use the full method name See the run_hook method and the morph method for more details. +=item first_step (method) + +Returns the first step of the path. Note that first_step may not be the same +thing as default_step if the path was overridden. + =item forbidden_step (method) Defaults to "__forbidden". The name of a step to run should the current step name be invalid, or if a step found by the default path method is invalid. See the path method. +=item form (method) + +Returns a hashref of the items passed to the CGI. Returns +$self->{form} which defaults to CGI::Ex::get_form. + =item form_name (hook) Return the name of the form to attach the js validation to. Used by @@ -1433,6 +1416,12 @@ Full customization of the login process and the login template can be done via the auth_args hash. See the auth_args method and CGI::Ex::Auth perldoc for more information. +=item handle_error (method) + +If anything dies during execution, handle_error will be called with +the error that had happened. Default action is to try running the +step returned by the error_step method. + =item hash_base (hook) A hash of base items to be merged with hash_form - such as pulldown @@ -1525,6 +1514,19 @@ pass it to CGI::Ex::Validate::get_validation. If no file_val is returned or if the get_validation fails, an empty hash will be returned. Validation is implemented by ->vob which loads a CGI::Ex::Validate object. +=item history (method) + +Returns an arrayref which contains trace history of which hooks of +which steps were ran. Useful for seeing what happened. In general - +each line of the history will show the current step, the hook +requested, and which hook was actually called. + +The dump_history method shows a short condensed version of this +history which makes it easier to see what path was followed. + +In general, the arrayref is free for anything to push onto which will +help in tracking other occurrences in the program as well. + =item info_complete (hook) Calls the ready_validate hook to see if data is ready to validate. If @@ -1532,6 +1534,12 @@ so it calls the validate hook to validate the data. Should make sure the data is ready and valid. Will not be run unless prepare returns true (default). +=item init (method) + +Called by the default new method. Allows for any object +initilizations that may need to take place. Default action does +nothing. + =item insert_path (method) Arguments are the steps to insert. Can be called any time. Inserts @@ -3079,12 +3087,12 @@ the original versions. Krassimir Berov - feedback and some warnings issues with POD examples. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. +=head1 AUTHOR + +Paul Seamons + =cut diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index 99ca4a6..ea3e346 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.15'; +$VERSION = '2.16'; ###----------------------------------------------------------------### @@ -1151,8 +1151,12 @@ The text items shown in the default login template. The default values are: =back +=head1 LICENSE + +This module may be distributed under the same terms as Perl itself. + =head1 AUTHORS -Paul Seamons +Paul Seamons =cut diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 118f4a8..3af42e5 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -29,7 +29,7 @@ use vars qw($VERSION ); @EXPORT_OK = qw(conf_read conf_write in_cache); -$VERSION = '2.15'; +$VERSION = '2.16'; $DEFAULT_EXT = 'conf'; @@ -909,13 +909,13 @@ without even opening the file. Make a similar write method that handles immutability. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. +=head1 AUTHOR + +Paul Seamons + =cut diff --git a/lib/CGI/Ex/Die.pm b/lib/CGI/Ex/Die.pm index 287bed6..98fcc47 100644 --- a/lib/CGI/Ex/Die.pm +++ b/lib/CGI/Ex/Die.pm @@ -23,7 +23,7 @@ use CGI::Ex; use CGI::Ex::Dump qw(debug ctrace dex_html); BEGIN { - $VERSION = '2.15'; + $VERSION = '2.16'; $SHOW_TRACE = 0 if ! defined $SHOW_TRACE; $IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL; $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS; @@ -180,8 +180,12 @@ the developer, should errors occur. This is a stub phase module. More features (error notification, custom error page, etc) will be added later. +=head1 LICENSE + +This module may distributed under the same terms as Perl itself. + =head1 AUTHORS -Paul Seamons +Paul Seamons =cut diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm index 41bece5..ac1b31c 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.15'; +$VERSION = '2.16'; @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); @@ -239,8 +239,12 @@ Turns calls to routines on or off. Default is to be on. =back +=head1 LICENSE + +This module may distributed under the same terms as Perl itself. + =head1 AUTHORS -Paul Seamons +Paul Seamons =cut diff --git a/lib/CGI/Ex/Fill.pm b/lib/CGI/Ex/Fill.pm index c3e079a..308c537 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.15'; + $VERSION = '2.16'; @EXPORT = qw(form_fill); @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key); }; @@ -838,6 +838,6 @@ This module may distributed under the same terms as Perl itself. =head1 AUTHOR -Paul Seamons +Paul Seamons =cut diff --git a/lib/CGI/Ex/JSONDump.pm b/lib/CGI/Ex/JSONDump.pm index 2d90a99..f28e444 100644 --- a/lib/CGI/Ex/JSONDump.pm +++ b/lib/CGI/Ex/JSONDump.pm @@ -17,7 +17,7 @@ use strict; use base qw(Exporter); BEGIN { - $VERSION = '2.15'; + $VERSION = '2.16'; @EXPORT = qw(JSONDump); @EXPORT_OK = @EXPORT; @@ -387,8 +387,12 @@ behavior in these cases you can use the no_tag_splitting flag to turn off the be =back +=head1 LICENSE + +This module may distributed under the same terms as Perl itself. + =head1 AUTHORS -Paul Seamons +Paul Seamons =cut diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index 0e00f76..d9a4f54 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -8,7 +8,7 @@ CGI::Ex::Template - Template::Alloy based TT2/TT3/HT/HTE/Tmpl/Velocity engine. use strict; use warnings; -use Template::Alloy 1.003; +use Template::Alloy 1.004; use base qw(Template::Alloy); use vars qw($VERSION $QR_PRIVATE @@ -25,7 +25,7 @@ use vars qw($VERSION $VOBJS ); -$VERSION = '2.15'; +$VERSION = '2.16'; ### install true symbol table aliases that can be localized *QR_PRIVATE = *Template::Alloy::QR_PRIVATE; @@ -148,12 +148,12 @@ suggested that you use Template::Alloy directly instead. For examples of usage, configuration, syntax, bugs, vmethods, directives, etc please refer to the L documentation. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. +=head1 AUTHOR + +Paul Seamons + =cut diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index b49193c..3d47299 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.15'; +$VERSION = '2.16'; $DEFAULT_EXT = 'val'; $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; @@ -2079,14 +2079,12 @@ javascript didn't validate correctly, the user can still submit the data. Thanks to Eamon Daly for providing bug fixes for bugs in validate.js caused by HTML::Prototype. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. -=cut +=head1 AUTHOR +Paul Seamons +=cut -- 2.45.2