X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FApp.pm;h=2c7ecee6a078da536049cb7a93441245b7b67ba9;hb=ba92ea5b36cbcd9c03016491dfb06dfc74baf409;hp=739c82fb755307e22a63d39f28257b1fd723639c;hpb=d0287461de3f9b5c49ce02b22957022bdc5e87d8;p=chaz%2Fp5-CGI-Ex

diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm
index 739c82f..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.07';
+    $VERSION = '2.16';
 
     Time::HiRes->import('time') if eval {require Time::HiRes};
     eval {require Scalar::Util};
@@ -49,18 +49,12 @@ sub navigate {
     $self->{'_time'} = time;
 
     eval {
-        ### allow for authentication
-        my $ref = $self->require_auth;
-        if ($ref && ! ref $ref) {
-            return $self if ! $self->get_valid_auth;
-        }
-
         ### a chance to do things at the very beginning
         return $self if ! $self->{'_no_pre_navigate'} && $self->pre_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 ($@) {
@@ -86,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;
@@ -98,8 +92,6 @@ sub nav_loop {
     ### allow for an early return
     return if $self->pre_loop($path); # a true value means to abort the navigate
 
-    my $req_auth = ref($self->require_auth) ? $self->require_auth : undef;
-
     ### iterate on each step of the path
     foreach ($self->{'path_i'} ||= 0;
              $self->{'path_i'} <= $#$path;
@@ -113,15 +105,29 @@ sub nav_loop {
         $step = $1; # untaint
 
         ### allow for per-step authentication
-        if ($req_auth
-            && $req_auth->{$step}
-            && ! $self->get_valid_auth) {
-            return;
+        if (! $self->is_authed) {
+            my $req = $self->run_hook('require_auth', $step, 1);
+            if (ref($req) ? $req->{$step} : $req) { # in the hash - or true
+                return if ! $self->get_valid_auth;
+            }
         }
 
         ### allow for becoming another package (allows for some steps in external files)
         $self->morph($step);
 
+        ### allow for mapping path_info pieces to form elements
+        if (my $info = $self->path_info) {
+            my $maps = $self->run_hook('path_info_map', $step) || [];
+            croak 'Usage: sub path_info_map { [[qr{/path_info/(\w+)}, "keyname"]] }'
+                if ! UNIVERSAL::isa($maps, 'ARRAY') || (@$maps && ! UNIVERSAL::isa($maps->[0], 'ARRAY'));
+            foreach my $map (@$maps) {
+                my @match = $info =~ $map->[0];
+                next if ! @match;
+                $self->form->{$map->[$_]} = $match[$_ - 1] foreach grep {! defined $self->form->{$map->[$_]}} 1 .. $#$map;
+                last;
+            }
+        }
+
         ### run the guts of the step
         my $handled = $self->run_hook('run_step', $step);
 
@@ -164,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' }
@@ -182,10 +195,21 @@ sub path {
     if (! $self->{'path'}) {
         my $path = $self->{'path'} = []; # empty path
 
-        my $step = $self->form->{ $self->step_key };
-        $step = lc($1) if ! $step && $ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} =~ m|^/(\w+)|;
+        ### add initial items to the form hash from path_info5B
+        if (my $info = $self->path_info) {
+            my $maps = $self->path_info_map_base || [];
+            croak 'Usage: sub path_info_map_base { [[qr{/path_info/(\w+)}, "keyname"]] }'
+                if ! UNIVERSAL::isa($maps, 'ARRAY') || (@$maps && ! UNIVERSAL::isa($maps->[0], 'ARRAY'));
+            foreach my $map (@$maps) {
+                my @match = $info =~ $map->[0];
+                next if ! @match;
+                $self->form->{$map->[$_]} = $match[$_ - 1] foreach grep {! defined $self->form->{$map->[$_]}} 1 .. $#$map;
+                last;
+            }
+        }
 
         ### make sure the step is valid
+        my $step = $self->form->{$self->step_key};
         if (defined $step) {
             if ($step =~ /^_/) {         # can't begin with _
                 $self->stash->{'forbidden_step'} = $step;
@@ -205,6 +229,11 @@ sub path {
     return $self->{'path'};
 }
 
+sub path_info_map_base {
+    my $self = shift;
+    return [[qr{/(\w+)}, $self->step_key]];
+}
+
 sub set_path {
     my $self = shift;
     my $path = $self->{'path'} ||= [];
@@ -255,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;
     }
@@ -435,6 +464,8 @@ sub dump_history {
                 $note .= ' - {}';
             } elsif (ref($resp) eq 'ARRAY' && ! @$resp) {
                 $note .= ' - []';
+            } elsif (! defined $resp) {
+                $note .= ' - undef';
             } elsif (! ref $resp || ! $all) {
                 my $max = $self->{'history_max'} || 30;
                 if (length($resp) > $max) {
@@ -473,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
 
@@ -531,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 = {
@@ -572,6 +603,10 @@ sub navigate_authenticated {
     my ($self, $args) = @_;
     $self = $self->new($args) if ! ref $self;
 
+    if ($self->can('require_auth') != \&CGI::Ex::App::require_auth) {
+        require Carp;
+        Carp::croak("The default navigate_authenticated method was called but the default require_auth method has been overwritten - aborting");
+    }
     $self->require_auth(1);
 
     return $self->navigate;
@@ -579,8 +614,8 @@ sub navigate_authenticated {
 
 sub require_auth {
     my $self = shift;
-    $self->{'require_auth'} = shift if @_ == 1;
-    return $self->{'require_auth'};
+    $self->{'require_auth'} = shift if @_ == 1 && (! defined($_[0]) || ref($_[0]) || $_[0] =~ /^[01]$/);
+    return $self->{'require_auth'} || 0;
 }
 
 sub is_authed { shift->auth_data }
@@ -595,8 +630,16 @@ sub get_valid_auth {
     my $self = shift;
     return 1 if $self->is_authed;
 
-    ### augment the args with sensible defaults
     my $args = $self->auth_args;
+
+    ### allow passed in args
+    if (my $extra = shift) {
+        $args = {%$args, %$extra};
+    }
+
+    ### augment the args with sensible defaults
+    $args->{'script_name'}      ||= $self->script_name;
+    $args->{'path_info'}        ||= $self->path_info;
     $args->{'cgix'}             ||= $self->cgix;
     $args->{'form'}             ||= $self->form;
     $args->{'cookies'}          ||= $self->cookies;
@@ -606,9 +649,15 @@ 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 $out = $self->run_hook('swap_template', '__login', $template, $hash);
-        $self->run_hook('fill_template', '__login', \$out, $hash);
-        $self->run_hook('print_out', '__login', $out);
+        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) || {};
+        my $swap = {%$hash_base, %$hash_comm, %$hash_swap, %$hash};
+
+        my $out = $self->run_hook('swap_template', $step, $template, $swap);
+        $self->run_hook('fill_template', $step, \$out, $hash);
+        $self->run_hook('print_out', $step, \$out);
     };
 
     require CGI::Ex::Auth;
@@ -631,6 +680,19 @@ sub verify_user  { 1 }
 ###----------------------------------------------------------------###
 ### a few standard base accessors
 
+sub script_name { shift->{'script_name'} || $ENV{'SCRIPT_NAME'} || $0 }
+
+sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }
+
+sub cgix {
+    my $self = shift;
+    $self->{'cgix'} = shift if @_ == 1;
+    return $self->{'cgix'} ||= do {
+        require CGI::Ex;
+        CGI::Ex->new; # return of the do
+    };
+}
+
 sub form {
     my $self = shift;
     $self->{'form'} = shift if @_ == 1;
@@ -643,15 +705,6 @@ sub cookies {
     return $self->{'cookies'} ||= $self->cgix->get_cookies;
 }
 
-sub cgix {
-    my $self = shift;
-    $self->{'cgix'} = shift if @_ == 1;
-    return $self->{'cgix'} ||= do {
-        require CGI::Ex;
-        CGI::Ex->new; # return of the do
-    };
-}
-
 sub vob {
     my $self = shift;
     $self->{'vob'} = shift if @_ == 1;
@@ -686,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
@@ -700,6 +753,8 @@ sub clear_app {
 ###----------------------------------------------------------------###
 ### default hook implementations
 
+sub path_info_map { }
+
 sub run_step {
     my $self = shift;
     my $step = shift;
@@ -770,34 +825,26 @@ 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);
+    $self->run_hook('print_out',     $step, \$out);
 }
 
 sub print_out {
     my ($self, $step, $out) = @_;
 
     $self->cgix->print_content_type;
-    print $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 { $copy->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\"" };
-
-    require CGI::Ex::Template;
-    my $t = CGI::Ex::Template->new($args);
+    $args->{'INCLUDE_PATH'} ||= $self->base_dir_abs;
 
+    my $t = $self->template_obj($args);
     my $out = '';
     $t->process($file, $swap, \$out) || die $t->error;
 
@@ -806,6 +853,13 @@ sub swap_template {
 
 sub template_args { {} }
 
+sub template_obj {
+    my ($self, $args) = @_;
+
+    require CGI::Ex::Template;
+    my $t = CGI::Ex::Template->new($args);
+}
+
 sub fill_template {
     my ($self, $step, $outref, $fill) = @_;
 
@@ -825,14 +879,9 @@ sub pre_step   { 0 } # success indicates we handled step (don't continue step or
 sub skip       { 0 } # success indicates to skip the step (and continue loop)
 sub prepare    { 1 } # failure means show step
 sub finalize   { 1 } # failure means show step
-sub post_print { 0 } # success indicates we handled step (don't continue loop)
+sub post_print { 0 }
 sub post_step  { 0 } # success indicates we handled step (don't continue step or loop)
 
-sub name_step {
-    my ($self, $step) = @_;
-    return $step;
-}
-
 sub morph_package {
     my $self = shift;
     my $step = shift || '';
@@ -848,12 +897,17 @@ sub name_module {
 
     return $self->{'name_module'} ||= do {
         # allow for cgi-bin/foo or cgi-bin/foo.pl to resolve to "foo"
-        my $script = $ENV{'SCRIPT_NAME'} || $0;
+        my $script = $self->script_name;
         $script =~ m/ (\w+) (?:\.\w+)? $/x || die "Couldn't determine module name from \"name_module\" lookup ($step)";
         $1; # return of the do
     };
 }
 
+sub name_step {
+    my ($self, $step) = @_;
+    return $step;
+}
+
 sub file_print {
     my $self = shift;
     my $step = shift;
@@ -872,15 +926,27 @@ sub file_val {
     my $self = shift;
     my $step = shift;
 
-    my $abs      = $self->base_dir_abs || return {};
+    ### determine the path to begin looking for files - allow for an arrayref
+    my $abs = $self->base_dir_abs || [];
+    $abs = $abs->() if UNIVERSAL::isa($abs, 'CODE');
+    $abs = [$abs] if ! UNIVERSAL::isa($abs, 'ARRAY');
+    return {} if @$abs == 0;
+
     my $base_dir = $self->base_dir_rel;
     my $module   = $self->run_hook('name_module', $step);
-    my $_step    = $self->run_hook('name_step', $step);
+    my $_step    = $self->run_hook('name_step', $step) || die "Missing name_step";
     $_step .= '.'. $self->ext_val if $_step !~ /\.\w+$/;
 
-    foreach ($abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }
+    foreach (@$abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }
 
-    return $abs . $base_dir . $module . $_step;
+    if (@$abs > 1) {
+        foreach my $_abs (@$abs) {
+            my $path = $_abs . $base_dir . $module . $_step;
+            return $path if -e $path;
+        }
+    }
+
+    return $abs->[0] . $base_dir . $module . $_step;
 }
 
 sub info_complete {
@@ -980,8 +1046,8 @@ sub hash_base {
         my $copy = $self;
         eval {require Scalar::Util; Scalar::Util::weaken($copy)};
         my $hash = {
-            script_name     => $ENV{'SCRIPT_NAME'} || $0,
-            path_info       => $ENV{'PATH_INFO'}   || '',
+            script_name     => $copy->script_name,
+            path_info       => $copy->path_info,
             js_validation   => sub { $copy->run_hook('js_validation', $step, shift) },
             form_name       => sub { $copy->run_hook('form_name', $step) },
             $self->step_key => $step,
@@ -1038,33 +1104,33 @@ 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_val {
+sub ext_print {
     my $self = shift;
-    $self->{'ext_val'} = shift if $#_ != -1;
-    return $self->{'ext_val'} || 'val';
+    $self->{'ext_print'} = shift if @_ == 1;
+    return $self->{'ext_print'} || 'html';
 }
 
-sub ext_print {
+sub ext_val {
     my $self = shift;
-    $self->{'ext_print'} = shift if $#_ != -1;
-    return $self->{'ext_print'} || 'html';
+    $self->{'ext_val'} = shift if @_ == 1;
+    return $self->{'ext_val'} || 'val';
 }
 
 ### where to find the javascript files
 ### default to using this script as a handler
 sub js_uri_path {
     my $self   = shift;
-    my $script = $ENV{'SCRIPT_NAME'} || return '';
+    my $script = $self->script_name;
     my $js_step = $self->js_step;
     return ($self->can('path') == \&CGI::Ex::App::path)
         ? $script .'/'. $js_step # try to use a cache friendly URI (if path is our own)
@@ -1079,7 +1145,7 @@ sub js_run_step {
     my $self = shift;
 
     ### make sure path info looks like /js/CGI/Ex/foo.js
-    my $file = $self->form->{'js'} || $ENV{'PATH_INFO'} || '';
+    my $file = $self->form->{'js'} || $self->path_info;
     $file = ($file =~  m!^(?:/js/|/)?(\w+(?:/\w+)*\.js)$!) ? $1 : '';
 
     $self->cgix->print_js($file);
@@ -1095,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 { \ "<h1>Denied</h1>You do not have access to the step <b>\"[% forbidden_step %]\"</b>" }
 
+###----------------------------------------------------------------###
+### 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 { \ "<h1>An a fatal error occurred</h1>Step: <b>\"[% error_step %]\"</b><br>[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" }
+
 ###----------------------------------------------------------------###
 
 1;