CGI::Ex 2.15

diff --git a/Changes b/Changes
index aa0bd82cf05596b4e4f17b0f93eac7d208089fe0..d3f9bcd7d4499a2e9c726b8e027ad0c0dcd38925 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,11 @@
+2.15
+      2007-06-20
+        * Fix some warning issues with the Recipe sample in App
+        * Cleanup require_auth interface in App (you will want to
+          double check if you have overwritten require_auth in your
+          application to make sure your implementation is still compatible)
+        * Require latest Template::Alloy
+

 2.14
       2007-06-12
         * Moved CGI::Ex::Template to Template::Alloy
 2.14
       2007-06-12
         * Moved CGI::Ex::Template to Template::Alloy

diff --git a/MANIFEST b/MANIFEST
index f2440d7bd76eaf2b041bcd68eb449d147e492ecb..c800d2fd75bfd3c9135c03cafcbf9a4c78d34ca7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -26,23 +26,14 @@ samples/benchmark/bench_cgix_hfif.pl
 samples/benchmark/bench_conf_readers.pl
 samples/benchmark/bench_conf_writers.pl
 samples/benchmark/bench_jsondump.pl
 samples/benchmark/bench_conf_readers.pl
 samples/benchmark/bench_conf_writers.pl
 samples/benchmark/bench_jsondump.pl

-samples/benchmark/bench_method_calling.pl
-samples/benchmark/bench_operator_storage.pl
-samples/benchmark/bench_optree.pl
-samples/benchmark/bench_template.pl
-samples/benchmark/bench_template_tag_parser.pl

 samples/benchmark/bench_validation.pl
 samples/benchmark/bench_validation.pl

-samples/benchmark/bench_various_templaters.pl
-samples/benchmark/bench_various_templaters.pl.out

 samples/devel/dprof_conf.d
 samples/devel/dprof_conf.d

-samples/devel/dprof_template.d

 samples/devel/dprof_validation.d
 samples/generate_js.pl
 samples/index.cgi
 samples/js_validate_1.html
 samples/js_validate_2.html
 samples/js_validate_3.html
 samples/devel/dprof_validation.d
 samples/generate_js.pl
 samples/index.cgi
 samples/js_validate_1.html
 samples/js_validate_2.html
 samples/js_validate_3.html

-samples/memory_template.pl

 samples/yaml_js_1.html
 samples/yaml_js_2.html
 samples/yaml_js_3.html
 samples/yaml_js_1.html
 samples/yaml_js_2.html
 samples/yaml_js_3.html

diff --git a/META.yml b/META.yml
index 0baa4534a0d3d1f7354a495f17f14bb60517e875..9025e12489765984bad3600f51a01babad6f0c35 100644 (file)
--- 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
 # 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.14
+version:      2.15

 version_from: lib/CGI/Ex.pm
 installdirs:  site
 requires:
 version_from: lib/CGI/Ex.pm
 installdirs:  site
 requires:

-    Template::Alloy:               1.002
+    Template::Alloy:               1.003

 
 distribution_type: module
 generated_by: ExtUtils::MakeMaker version 6.30_01
 
 distribution_type: module
 generated_by: ExtUtils::MakeMaker version 6.30_01

diff --git a/Makefile.PL b/Makefile.PL
index 754fca42eff41559eedd45423587f0e302451ffe..6b47c5a7fcf926e80b604c3886ab7d2e9a3795d0 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,7 +12,7 @@ WriteMakefile(
               VERSION_FROM  => "lib/CGI/Ex.pm",
               INSTALLDIRS   => 'site',
               PREREQ_PM     => {
               VERSION_FROM  => "lib/CGI/Ex.pm",
               INSTALLDIRS   => 'site',
               PREREQ_PM     => {

-                  'Template::Alloy' => '1.002',
+                  'Template::Alloy' => '1.003',

               },
               
               dist          => {
               },
               
               dist          => {

diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm
index 6737649d3815b6f6d358091e2af8e9e4f31b8954..750b5ce6f98def0059eb8998e60ebdb616132337 100644 (file)
--- a/lib/CGI/Ex.pm
+++ b/lib/CGI/Ex.pm
@@ -24,7 +24,7 @@ use vars qw($VERSION
 use base qw(Exporter);
 
 BEGIN {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION               = '2.14';
+    $VERSION               = '2.15';

     $PREFERRED_CGI_MODULE  ||= 'CGI';
     @EXPORT = ();
     @EXPORT_OK = qw(get_form
     $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 9ccbab3e31ca43c0559f937d64a25371c82f4780..ec3ff6a976aee7370cebe4645d266abedfefb26d 100644 (file)
--- a/lib/CGI/Ex/App.pm
+++ b/lib/CGI/Ex/App.pm
@@ -10,7 +10,7 @@ use strict;
 use vars qw($VERSION);
 
 BEGIN {
 use vars qw($VERSION);
 
 BEGIN {

-    $VERSION = '2.14';
+    $VERSION = '2.15';

 
     Time::HiRes->import('time') if eval {require Time::HiRes};
     eval {require Scalar::Util};
 
     Time::HiRes->import('time') if eval {require Time::HiRes};
     eval {require Scalar::Util};


@@ -49,12 +49,6 @@ sub navigate {
     $self->{'_time'} = time;
 
     eval {
     $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;
 
         ### a chance to do things at the very beginning
         return $self if ! $self->{'_no_pre_navigate'} && $self->pre_navigate;
 


@@ -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
 
     ### 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;
     ### iterate on each step of the path
     foreach ($self->{'path_i'} ||= 0;
              $self->{'path_i'} <= $#$path;


@@ -113,17 +105,18 @@ sub nav_loop {
         $step = $1; # untaint
 
         ### allow for per-step authentication
         $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
         }
 
         ### 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 = $ENV{'PATH_INFO'}) {
+        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'));
             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'));


@@ -195,8 +188,8 @@ sub path {
     if (! $self->{'path'}) {
         my $path = $self->{'path'} = []; # empty path
 
     if (! $self->{'path'}) {
         my $path = $self->{'path'} = []; # empty path
 

-        ### add initial items to the form hash from path_info
-        if (my $info = $ENV{'PATH_INFO'}) {
+        ### 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'));
             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'));


@@ -464,6 +457,8 @@ sub dump_history {
                 $note .= ' - {}';
             } elsif (ref($resp) eq 'ARRAY' && ! @$resp) {
                 $note .= ' - []';
                 $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) {
             } elsif (! ref $resp || ! $all) {
                 my $max = $self->{'history_max'} || 30;
                 if (length($resp) > $max) {


@@ -601,6 +596,10 @@ sub navigate_authenticated {
     my ($self, $args) = @_;
     $self = $self->new($args) if ! ref $self;
 
     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;
     $self->require_auth(1);
 
     return $self->navigate;


@@ -608,8 +607,8 @@ sub navigate_authenticated {
 
 sub require_auth {
     my $self = shift;
 
 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 }
 }
 
 sub is_authed { shift->auth_data }


@@ -624,8 +623,16 @@ sub get_valid_auth {
     my $self = shift;
     return 1 if $self->is_authed;
 
     my $self = shift;
     return 1 if $self->is_authed;
 

-    ### augment the args with sensible defaults

     my $args = $self->auth_args;
     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;
     $args->{'cgix'}             ||= $self->cgix;
     $args->{'form'}             ||= $self->form;
     $args->{'cookies'}          ||= $self->cookies;


@@ -635,9 +642,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) = @_;
     $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 = '__login';
+        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;
     };
 
     require CGI::Ex::Auth;


@@ -660,6 +673,19 @@ sub verify_user  { 1 }
 ###----------------------------------------------------------------###
 ### a few standard base accessors
 
 ###----------------------------------------------------------------###
 ### 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;
 sub form {
     my $self = shift;
     $self->{'form'} = shift if @_ == 1;


@@ -672,15 +698,6 @@ sub cookies {
     return $self->{'cookies'} ||= $self->cgix->get_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;
 sub vob {
     my $self = shift;
     $self->{'vob'} = shift if @_ == 1;


@@ -807,15 +824,14 @@ sub print {
     my $out  = $self->run_hook('swap_template', $step, $file, $swap);
 
     $self->run_hook('fill_template', $step, \$out, $fill);
     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;
 }
 
 sub print_out {
     my ($self, $step, $out) = @_;
 
     $self->cgix->print_content_type;

-    print $out;
+    print ref($out) ? $$out : $out;

 }
 
 sub swap_template {
 }
 
 sub swap_template {


@@ -884,7 +900,7 @@ sub name_module {
 
     return $self->{'name_module'} ||= do {
         # allow for cgi-bin/foo or cgi-bin/foo.pl to resolve to "foo"
 
     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
     };
         $script =~ m/ (\w+) (?:\.\w+)? $/x || die "Couldn't determine module name from \"name_module\" lookup ($step)";
         $1; # return of the do
     };


@@ -1033,8 +1049,8 @@ sub hash_base {
         my $copy = $self;
         eval {require Scalar::Util; Scalar::Util::weaken($copy)};
         my $hash = {
         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,
             js_validation   => sub { $copy->run_hook('js_validation', $step, shift) },
             form_name       => sub { $copy->run_hook('form_name', $step) },
             $self->step_key => $step,


@@ -1117,7 +1133,7 @@ sub ext_val {
 ### default to using this script as a handler
 sub js_uri_path {
     my $self   = shift;
 ### 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)
     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)


@@ -1132,7 +1148,7 @@ sub js_run_step {
     my $self = shift;
 
     ### make sure path info looks like /js/CGI/Ex/foo.js
     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);
     $file = ($file =~  m!^(?:/js/|/)?(\w+(?:/\w+)*\.js)$!) ? $1 : '';
 
     $self->cgix->print_js($file);

diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod
index 0188cdc40e6c0d38d508384a491d956f05fd4094..6fe97464e0e828e7d241fff509c46dcfe814ffd8 100644 (file)
--- a/lib/CGI/Ex/App.pod
+++ b/lib/CGI/Ex/App.pod
@@ -202,6 +202,9 @@ The nav_loop method will run as follows:
 
         foreach step of path {
 
 
         foreach step of path {
 

+            ->require_auth (hook)
+                # exits nav_loop if true
+

             ->morph
                 # check ->allow_morph
                 # check ->allow_nested_morph
             ->morph
                 # check ->allow_morph
                 # check ->allow_nested_morph


@@ -314,31 +317,31 @@ The default out of the box configuration will map URIs to steps as follows:
 
     # Assuming /cgi-bin/my_app is the program being run
 
 
     # Assuming /cgi-bin/my_app is the program being run
 

-    URI:  /cgi-bin/my_app
+   URI:  /cgi-bin/my_app

     STEP: main
     FORM: {}
     WHY:  No other information is passed.  The path method is
           called which eventually calls ->default_step which
           defaults to "main"
 
     STEP: main
     FORM: {}
     WHY:  No other information is passed.  The path method is
           called which eventually calls ->default_step which
           defaults to "main"
 

-    URI:  /cgi-bin/my_app?foo=bar
+   URI:  /cgi-bin/my_app?foo=bar

     STEP: main
     FORM: {foo => "bar"}
     WHY:  Same as previous example except that QUERY_STRING
           information was passed and placed in form.
 
     STEP: main
     FORM: {foo => "bar"}
     WHY:  Same as previous example except that QUERY_STRING
           information was passed and placed in form.
 

-    URI:  /cgi-bin/my_app?step=my_step
+   URI:  /cgi-bin/my_app?step=my_step

     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which looks in $self->form
           for the key ->step_key (which defaults to "step").
 
     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which looks in $self->form
           for the key ->step_key (which defaults to "step").
 

-    URI:  /cgi-bin/my_app?step=my_step&foo=bar
+   URI:  /cgi-bin/my_app?step=my_step&foo=bar

     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}

-    WHY:  Same as before but has other parameters were passed.
+    WHY:  Same as before but another parameter was passed.

 
 

-    URI:  /cgi-bin/my_app/my_step
+   URI:  /cgi-bin/my_app/my_step

     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which called path_info_map_base
     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which called path_info_map_base


@@ -348,12 +351,12 @@ The default out of the box configuration will map URIs to steps as follows:
           $self->form->{$self->step_key} for the initial step. See
           the path_info_map_base method for more information.
 
           $self->form->{$self->step_key} for the initial step. See
           the path_info_map_base method for more information.
 

-    URI:  /cgi-bin/my_app/my_step?foo=bar
+   URI:  /cgi-bin/my_app/my_step?foo=bar

     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but other parameters were passed.
 
     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but other parameters were passed.
 

-    URI:  /cgi-bin/my_app/my_step?step=other_step
+   URI:  /cgi-bin/my_app/my_step?step=other_step

     STEP: other_step
     FORM: {step => "other_step"}
     WHY:  The same procedure took place, but when the PATH_INFO
     STEP: other_step
     FORM: {step => "other_step"}
     WHY:  The same procedure took place, but when the PATH_INFO


@@ -371,7 +374,7 @@ that the following method is installed in your script.
         ];
     }
 
         ];
     }
 

-    URI:  /cgi-bin/my_app/my_step/bar
+   URI:  /cgi-bin/my_app/my_step/bar

     STEP: my_step
     FORM: {foo => "bar"}
     WHY:  The step was matched as in previous examples using
     STEP: my_step
     FORM: {foo => "bar"}
     WHY:  The step was matched as in previous examples using


@@ -381,7 +384,7 @@ that the following method is installed in your script.
           and the corresponding matched value was placed into
           the form using the keys specified following the regex.
 
           and the corresponding matched value was placed into
           the form using the keys specified following the regex.
 

-    URI:  /cgi-bin/my_app/my_step/bar/1234
+   URI:  /cgi-bin/my_app/my_step/bar/1234

     STEP: my_step
     FORM: {foo => "bar", id => "1234"}
     WHY:  Same as the previous example, except that the first
     STEP: my_step
     FORM: {foo => "bar", id => "1234"}
     WHY:  Same as the previous example, except that the first


@@ -391,19 +394,19 @@ that the following method is installed in your script.
           order that will match the most data.  The third regex
           would also match this PATH_INFO.
 
           order that will match the most data.  The third regex
           would also match this PATH_INFO.
 

-    URI:  /cgi-bin/my_app/my_step/some/other/type/of/data
+   URI:  /cgi-bin/my_app/my_step/some/other/type/of/data

     STEP: my_step
     FORM: {anything_else => 'some/other/type/of/data'}
     WHY:  Same as the previous example, except that the third
           regex matched.
 
     STEP: my_step
     FORM: {anything_else => 'some/other/type/of/data'}
     WHY:  Same as the previous example, except that the third
           regex matched.
 

-    URI:  /cgi-bin/my_app/my_step/bar?bling=blang
+   URI:  /cgi-bin/my_app/my_step/bar?bling=blang

     STEP: my_step
     FORM: {foo => "bar", bling => "blang"}
     STEP: my_step
     FORM: {foo => "bar", bling => "blang"}

-    WHY:  Same as the first step, but additional QUERY_STRING
+    WHY:  Same as the first sample, but additional QUERY_STRING

           information was passed.
 
           information was passed.
 

-    URI:  /cgi-bin/my_app/my_step/one%20two?bar=three%20four
+   URI:  /cgi-bin/my_app/my_step/one%20two?bar=three%20four

     STEP: my_step
     FORM: {anything_else => "one two", bar => "three four"}
     WHY:  The third path_info_map regex matched.  Note that the
     STEP: my_step
     FORM: {anything_else => "one two", bar => "three four"}
     WHY:  The third path_info_map regex matched.  Note that the


@@ -440,7 +443,7 @@ for more information about the many ways you can validate your data.
 The default hash_validation hook returns an empty hashref.  This means that passed
 in data is all valid and the script will automatically call the step's finalize method.
 
 The default hash_validation hook returns an empty hashref.  This means that passed
 in data is all valid and the script will automatically call the step's finalize method.
 

-The following shows how to some contrived validation to a step called "my_step".
+The following shows how to add some contrived validation to a step called "my_step".

 
     sub my_step_hash_validation {
         return {
 
     sub my_step_hash_validation {
         return {


@@ -564,7 +567,9 @@ validation files).
 
 The default file_print hook will look for content on your file system,
 but it can also be completely overridden to return a reference to a
 
 The default file_print hook will look for content on your file system,
 but it can also be completely overridden to return a reference to a

-scalar containing the contents of your file.  Actually it can return
+scalar containing the contents of your file (beginning with version 2.14
+string references can be cached which makes templates passed this way
+"first class" citizens).  Actually it can return

 anything that Template::Alloy (Template::Toolkit compatible) will
 treat as input.  This templated html is displayed to the user during
 any step that enters the "print" phase.
 anything that Template::Alloy (Template::Toolkit compatible) will
 treat as input.  This templated html is displayed to the user during
 any step that enters the "print" phase.


@@ -1171,6 +1176,7 @@ called is "view".
     debug: admin/Recipe.pm line 14
     shift->dump_history = [
             "Elapsed: 0.00562",
     debug: admin/Recipe.pm line 14
     shift->dump_history = [
             "Elapsed: 0.00562",

+            "view - require_auth - require_auth - 0.00001 - 0",

             "view - run_step - run_step - 0.00488 - 1",
             "    view - pre_step - pre_step - 0.00003 - 0",
             "    view - skip - view_skip - 0.00004 - 0",
             "view - run_step - run_step - 0.00488 - 1",
             "    view - pre_step - pre_step - 0.00003 - 0",
             "    view - skip - view_skip - 0.00004 - 0",


@@ -1382,8 +1388,7 @@ to the authentication object during the get_valid_auth method.
 
 =item get_valid_auth (method)
 
 
 =item get_valid_auth (method)
 

-If require_auth is true at either the application level or at the
-step level, get_valid_auth will be called.
+If require_auth hook returns true on any given step then get_valid_auth will be called.

 
 It will call auth_args to get some default args to pass to
 CGI::Ex::Auth->new.  It augments the args with sensible defaults that
 
 It will call auth_args to get some default args to pass to
 CGI::Ex::Auth->new.  It augments the args with sensible defaults that


@@ -1772,8 +1777,9 @@ This starts the process flow for the path and its steps.
 
 =item navigate_authenticated (method)
 
 
 =item navigate_authenticated (method)
 

-Same as the method navigate but sets require_auth(1) before
-running.  See the require_auth method.
+Same as the method navigate but calls ->require_auth(1) before
+running.  It will only work if the navigate_authenticated method
+has not been overwritten. See the require_auth method.

 
 =item new (class method)
 
 
 =item new (class method)
 


@@ -2022,45 +2028,104 @@ had been successfully validated and acted upon.
 Arguments are the steps used to replace.  Can be called any time.
 Replaces the remaining steps (if any) of the current path.
 
 Arguments are the steps used to replace.  Can be called any time.
 Replaces the remaining steps (if any) of the current path.
 

-=item require_auth (method)
+=item require_auth (hook)

 
 

-Default undef.  Can return either a true value or a hashref of step names.
+Defaults to self->{require_auth} which defaults to undef.
+If called as a method and passed a single value of 1, 0, or undef it will
+set the value of $self->{require_auth} to that value.  If set to a true
+value then any subsequent step will require authentication (unless its
+hook has been overwritten).

 
 

-If a hashref of stepnames is returned, authentication will be turned on
-at the step level.  In this mode if any step is accessed, the get_valid_auth
-method will be called.  If it fails, then the nav_loop will be stopped
-(the post_navigate method will be called - use the is_authed method to perform
-different functions).  Any step of the path not in the hash will not require
-authentication.  For example, to add authentication to add authentication
-to the add, edit and delete steps you could do:
+Any of the following ways can be used to require authentication on
+every step.

 
 

-    sub require_auth { {add => 1, edit => 1, delete => 1} }
+=over 4

 
 

-If a non-hash true value is returned from the require_auth method then
-authentication will take place before the pre_navigation or the nav_loop methods.
-If authentication fails the navigation process is exited (the post_navigate
-method will not be called).
+=item

 
     sub require_auth { 1 }
 
 
     sub require_auth { 1 }
 

-Alternatively you can also could do either of the following:
+=item

 
     __PACKAGE__->navigate_authenticated; # instead of __PACKAGE__->navigate;
 
 
     __PACKAGE__->navigate_authenticated; # instead of __PACKAGE__->navigate;
 

-    # OR
+=item
+
+    __PACKAGE__->new({require_auth => 1}->navigate;
+
+=item

 
     sub init { shift->require_auth(1) }
 
 
     sub init { shift->require_auth(1) }
 

-    # OR
+=back

 
 

-    __PACKAGE__->new({require_auth => 1}->navigate;
+Because it is called as a hook, the current step is passed as the
+first argument.  If the hook returns false, no authentication will be
+required on this step.  If the hook returns a true, non-hashref value,
+authentication will be required via the get_valid_auth method.  If the
+method returns a hashref of stepnames to require authentication on,
+the step will require authentication via the get_valid_auth method if
+the current step is in the hashref.  If authentication is required and
+succeeds, the step will proceed.  If authentication is required and
+fails at the step level the current step will be aborted,
+authentication will be asked for (the post_navigate method will still
+be called).
+
+For example you could add authentication to the add, edit, and delete
+steps in any of the following ways:

 
 

-If get_valid_auth returns true, in either case, the is_authed method will
-return true and the auth_data will contain the authenticated user's data.
-If it returns false, auth_data may possibly contain a defined but false
-data object with details as to why authentication failed.
+=over 4

 
 

-See the get_valid_auth method.
+=item
+
+    sub require_auth { {add => 1, edit => 1, delete => 1} }
+
+=item
+
+    sub add_require_auth    { 1 }
+    sub edit_require_auth   { 1 }
+    sub delete_require_auth { 1 }
+
+=item
+
+    sub require_auth {
+        my ($self, $step) = @_;
+        return 1 if $step && $step =~ /^(add|edit|delete)$/;
+        return 0;
+    }
+
+=back
+
+If however you wanted to require authentication on all but one or two methods
+(such as requiring authentication on all but a forgot_password step) you could do
+either of the following:
+
+=over 4
+
+=item
+
+    sub require_auth {
+        my ($self, $step) = @_;
+        return 0 if $step && $step eq 'forgot_password';
+        return 1; # require auth on all other steps
+    }
+
+=item
+
+    sub require_auth { 1 } # turn it on for all steps
+
+    sub forgot_password_require_auth { 0 } # turn it off
+
+=back
+
+See the get_valid_auth method for what occurs should authentication be required.
+
+There is one key difference from the 2.14 version of App.  In 2.14 and
+previous versions, the pre_navigate and post_navigate methods would
+not be called if require_auth returned a true non-hashref value.  In
+version 2.15 and later, the 2.15 pre_navigate and post_navigate
+methods are always called - even if authentication fails.  Also in 2.15
+and later, the method is called as a hook meaning the step is passed in.

 
 =item run_hook (method)
 
 
 =item run_hook (method)
 


@@ -2601,7 +2666,7 @@ the core logic of the application.
             return 0;
         }
 
             return 0;
         }
 

-        my $s = "UPDATE recipe SET title = ?, ingredients = ?, directions = ? WHERE id = ?";
+        $s = "UPDATE recipe SET title = ?, ingredients = ?, directions = ? WHERE id = ?";

         $self->dbh->do($s, {}, $form->{'title'},
                                $form->{'ingredients'},
                                $form->{'directions'},
         $self->dbh->do($s, {}, $form->{'title'},
                                $form->{'ingredients'},
                                $form->{'directions'},


@@ -2983,6 +3048,18 @@ will cause all steps to require validation):
 
     sub require_auth { {add => 1, edit => 1, delete => 1} }
 
 
     sub require_auth { {add => 1, edit => 1, delete => 1} }
 

+We could also enable authentication by using individual hooks as in:
+
+    sub add_require_auth    { 1 }
+    sub edit_require_auth   { 1 }
+    sub delete_require_auth { 1 }
+
+Or we could require authentication on everything - but let a few steps in:
+
+    sub require_auth { 1 }      # turn authentication on for all
+    sub main_require_auth { 0 } # turn it off for main and view
+    sub view_require_auth { 0 }
+

 That's it.  The add, edit, and delete steps will now require authentication.
 See the require_auth, get_valid_auth, and auth_args methods for more information.
 Also see the L<CGI::Ex::Auth> perldoc.
 That's it.  The add, edit, and delete steps will now require authentication.
 See the require_auth, get_valid_auth, and auth_args methods for more information.
 Also see the L<CGI::Ex::Auth> perldoc.


@@ -2992,13 +3069,15 @@ Also see the L<CGI::Ex::Auth> perldoc.
 The following corporation and individuals contributed in some part to
 the original versions.
 
 The following corporation and individuals contributed in some part to
 the original versions.
 

-    Bizhosting.com - giving a problem that fit basic design patterns.
+    Bizhosting.com  - giving a problem that fit basic design patterns.
+
+    Earl Cahill     - pushing the idea of more generic frameworks.

 
 

-    Earl Cahill    - pushing the idea of more generic frameworks.
+    Adam Erickson   - design feedback, bugfixing, feature suggestions.

 
 

-    Adam Erickson  - design feedback, bugfixing, feature suggestions.
+    James Lance     - design feedback, bugfixing, feature suggestions.

 
 

-    James Lance    - design feedback, bugfixing, feature suggestions.
+    Krassimir Berov - feedback and some warnings issues with POD examples.

 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index d7056e21dce85be27103c6c9b3f07f10530f3f30..99ca4a6f47cde6143b9bb80222548dd7461ffbd5 100644 (file)
--- 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;
 
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 

-$VERSION = '2.14';
+$VERSION = '2.15';

 
 ###----------------------------------------------------------------###
 
 
 ###----------------------------------------------------------------###
 

diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm
index fcd00a4a170fcde210b1d361c0959e94f23c7706..118f4a8c5676beb3056103e1533ea143beb23307 100644 (file)
--- 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);
 
             );
 @EXPORT_OK = qw(conf_read conf_write in_cache);
 

-$VERSION = '2.14';
+$VERSION = '2.15';

 
 $DEFAULT_EXT = 'conf';
 
 
 $DEFAULT_EXT = 'conf';
 

diff --git a/lib/CGI/Ex/Die.pm b/lib/CGI/Ex/Die.pm
index 345468a54aaf6340755c685590de6b9a1b6f79ce..287bed6fee800f6f335f6d4f009fd0672ee63468 100644 (file)
--- 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 {
 use CGI::Ex::Dump qw(debug ctrace dex_html);
 
 BEGIN {

-  $VERSION = '2.14';
+  $VERSION = '2.15';

   $SHOW_TRACE = 0      if ! defined $SHOW_TRACE;
   $IGNORE_EVAL = 0     if ! defined $IGNORE_EVAL;
   $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
   $SHOW_TRACE = 0      if ! defined $SHOW_TRACE;
   $IGNORE_EVAL = 0     if ! defined $IGNORE_EVAL;
   $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;

diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm
index 1a9070c38f32a7f2597bfa3610b182a0ec6e6ead..41bece5d6da6c6789c3741a1df7ee3927dbed9e5 100644 (file)
--- 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;
 
 use strict;
 use Exporter;
 

-$VERSION   = '2.14';
+$VERSION   = '2.15';

 @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);
 @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 b15b7735962172179e04750f9d2d31104abe6e2b..c3e079a9975b9a3f098a94bb79792a65367cfa42 100644 (file)
--- 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 {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION   = '2.14';
+    $VERSION   = '2.15';

     @EXPORT    = qw(form_fill);
     @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
 };
     @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/JSONDump.pm b/lib/CGI/Ex/JSONDump.pm
index c07a138e2ee6e15d6c6226518282f7cc579a868e..2d90a99d588ccbfd52d7136530d43ae94e55d836 100644 (file)
--- a/lib/CGI/Ex/JSONDump.pm
+++ b/lib/CGI/Ex/JSONDump.pm
@@ -17,7 +17,7 @@ use strict;
 use base qw(Exporter);
 
 BEGIN {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION  = '2.14';
+    $VERSION  = '2.15';

 
     @EXPORT = qw(JSONDump);
     @EXPORT_OK = @EXPORT;
 
     @EXPORT = qw(JSONDump);
     @EXPORT_OK = @EXPORT;

diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm
index 2f6fbfa69990c2bfef129cef4322f78ff5c4400d..0e00f76a481a85ec149454731052d570490b354c 100644 (file)
--- 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 strict;
 use warnings;

-use Template::Alloy 1.002;
+use Template::Alloy 1.003;

 use base qw(Template::Alloy);
 use vars qw($VERSION
             $QR_PRIVATE
 use base qw(Template::Alloy);
 use vars qw($VERSION
             $QR_PRIVATE


@@ -25,7 +25,7 @@ use vars qw($VERSION
             $VOBJS
             );
 
             $VOBJS
             );
 

-$VERSION = '2.14';
+$VERSION = '2.15';

 
 ### install true symbol table aliases that can be localized
 *QR_PRIVATE        = *Template::Alloy::QR_PRIVATE;
 
 ### install true symbol table aliases that can be localized
 *QR_PRIVATE        = *Template::Alloy::QR_PRIVATE;

diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm
index f97d425e0122cb8ae2ccd8770bd631368ee0b105..b49193c4347e47a575c502129f112a194b887583 100644 (file)
--- a/lib/CGI/Ex/Validate.pm
+++ b/lib/CGI/Ex/Validate.pm
@@ -22,7 +22,7 @@ use vars qw($VERSION
             @UNSUPPORTED_BROWSERS
             );
 
             @UNSUPPORTED_BROWSERS
             );
 

-$VERSION = '2.14';
+$VERSION = '2.15';

 
 $DEFAULT_EXT   = 'val';
 $QR_EXTRA      = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
 
 $DEFAULT_EXT   = 'val';
 $QR_EXTRA      = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;

diff --git a/samples/benchmark/bench_conf_readers.pl b/samples/benchmark/bench_conf_readers.pl
index 20f1b45f753e7c5d5f042070026738ff586a5254..845c8079f238b38df3293e11681a3d58460088ae 100644 (file)
--- a/samples/benchmark/bench_conf_readers.pl
+++ b/samples/benchmark/bench_conf_readers.pl
@@ -2,7 +2,7 @@
 
 use strict;
 use vars qw($PLACEHOLDER);
 
 use strict;
 use vars qw($PLACEHOLDER);

-use Benchmark qw(cmpthese);
+use Benchmark qw(cmpthese timethese);

 use CGI::Ex::Conf;
 use POSIX qw(tmpnam);
 
 use CGI::Ex::Conf;
 use POSIX qw(tmpnam);
 


@@ -42,6 +42,152 @@ my $str = '{
   one8    => {key1 => "val8",  key2 => "ralph"},
 }';
 
   one8    => {key1 => "val8",  key2 => "ralph"},
 }';
 

+my $str = '[
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+  foo     => [key1 => "bar",   key2 => "ralph"],
+  pass    => [key1 => "word",  key2 => "ralph"],
+  garbage => [key1 => "can",   key2 => "ralph"],
+  mighty  => [key1 => "ducks", key2 => "ralph"],
+  quack   => [key1 => "moo",   key2 => "ralph"],
+  one1    => [key1 => "val1",  key2 => "ralph"],
+  one2    => [key1 => "val2",  key2 => "ralph"],
+  one3    => [key1 => "val3",  key2 => "ralph"],
+  one4    => [key1 => "val4",  key2 => "ralph"],
+  one5    => [key1 => "val5",  key2 => "ralph"],
+  one6    => [key1 => "val6",  key2 => "ralph"],
+  one7    => [key1 => "val7",  key2 => "ralph"],
+  one8    => [key1 => "val8",  key2 => "ralph"],
+]';
+

 ###----------------------------------------------------------------###
 
 #           Rate   yaml  yaml2    xml g_conf     pl    sto   sto2  yaml3
 ###----------------------------------------------------------------###
 
 #           Rate   yaml  yaml2    xml g_conf     pl    sto   sto2  yaml3


@@ -87,13 +233,13 @@ $TESTS{pl} = sub {
 $files{pl} = $file;
 
 ### do a generic conf_write
 $files{pl} = $file;
 
 ### do a generic conf_write

-my $file2 = tmpnam(). '.g_conf';
-&generic_conf_write($file2, $conf);
-local $CGI::Ex::Conf::EXT_READERS{g_conf} = \&generic_conf_read;
-$TESTS{g_conf} = sub {
-  my $hash = $cob->read_ref($file2);
-};
-$files{g_conf} = $file2;
+#my $file2 = tmpnam(). '.g_conf';
+#&generic_conf_write($file2, $conf);
+#local $CGI::Ex::Conf::EXT_READERS{g_conf} = \&generic_conf_read;
+#$TESTS{g_conf} = sub {
+#  my $hash = $cob->read_ref($file2);
+#};
+#$files{g_conf} = $file2;

 
 
 if (eval {require JSON}) {
 
 
 if (eval {require JSON}) {


@@ -187,7 +333,7 @@ foreach my $key (sort keys %files) {
   print "$key => $files{$key}\n";
 }
 
   print "$key => $files{$key}\n";
 }
 

-cmpthese($n, \%TESTS);
+cmpthese timethese ($n, \%TESTS);

 
 ### comment out this line to inspect files
 unlink $_ foreach values %files;
 
 ### comment out this line to inspect files
 unlink $_ foreach values %files;

diff --git a/t/4_app_00_base.t b/t/4_app_00_base.t
index 1520d7abcbfcc518f3ae8f6ba9ea7dfc35631582..ec223d8e48d132cce4903e3c5ec641ef7bc584c9 100644 (file)
--- a/t/4_app_00_base.t
+++ b/t/4_app_00_base.t
@@ -8,57 +8,61 @@
 
 These tests are extremely stripped down to test the basic path flow.  Normally
 unit tests are useful for garnering information about a module.  For CGI::Ex::App
 
 These tests are extremely stripped down to test the basic path flow.  Normally
 unit tests are useful for garnering information about a module.  For CGI::Ex::App

-it is suggested to stick to live use cases or the CGI::Ex::App perldoc.
+it is suggested to stick to live use cases or the CGI::Ex::App perldoc - though
+we do try to put it through most paces.

 
 =cut
 
 
 =cut
 

-use Test::More tests => 9;
+use Test::More tests => 20;

 use strict;
 
 {
 use strict;
 
 {

-  package Foo;
+    package Foo;

 
 

-  use base qw(CGI::Ex::App);
-  use vars qw($test_stdout);
+    use base qw(CGI::Ex::App);
+    use vars qw($test_stdout);

 
 

-  sub ready_validate { 1 }
+    sub init { $test_stdout = '' }

 
 

-  sub print_out {
-    my $self = shift;
-    my $step = shift;
-    $test_stdout = shift;
-  }
+    sub ready_validate { 1 }

 
 

-  sub swap_template {
-    my ($self, $step, $file, $swap) = @_;
-    my $out = ref($file) ? $$file : "No filenames allowed during test mode";
-    $self->cgix->swap_template(\$out, $swap);
-    return $out;
-  }
+    sub print_out {
+        my $self = shift;
+        my $step = shift;
+        my $str  = shift;
+        $test_stdout = ref($str) ? $$str : $str;
+    }

 
 

-  ###----------------------------------------------------------------###
+    sub swap_template {
+        my ($self, $step, $file, $swap) = @_;
+        my $out = ref($file) ? $$file : "No filenames allowed during test mode";
+        $self->cgix->swap_template(\$out, $swap);
+        return $out;
+    }

 
 

-  sub main_info_complete { 0 }
+    sub auth_args { {login_template => \q{Login Form}} }

 
 

-  sub main_file_print { return \ "Main Content" }
+    ###----------------------------------------------------------------###

 
 

-  sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }
+    sub main_info_complete { 0 }

 
 

-  sub step2_path_info_map { [[qr{^/step2/(\w+)$}, 'wow']] }
+    sub main_file_print { return \ "Main Content" }

 
 

-  sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }
+    sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }

 
 

-  sub step2_hash_swap { return {foo => 'bar', one => 'two'} }
+    sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] }

 
 

-  sub step2_hash_fill { return {wow => 'wee'} }
+    sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }

 
 

-  sub step2_finalize { shift->append_path('step3') }
+    sub step2_hash_swap { return {foo => 'bar', one => 'two'} }

 
 

-  sub step3_info_complete { 0 }
+    sub step2_hash_fill { return {wow => 'wee'} }

 
 

-  sub step3_file_print { return \ "All good" }
+    sub step2_finalize { shift->append_path('step3') }

 
 

+    sub step3_info_complete { 0 }

 
 

+    sub step3_file_print { return \ "All good" }

 }
 
 ###----------------------------------------------------------------###
 }
 
 ###----------------------------------------------------------------###


@@ -67,7 +71,7 @@ use strict;
 #$ENV{'QUERY_STRING'}   = '';
 
 Foo->new({
 #$ENV{'QUERY_STRING'}   = '';
 
 Foo->new({

-  form => {},
+    form => {},

 })->navigate;
 ok($Foo::test_stdout eq "Main Content", "Got the right output");
 
 })->navigate;
 ok($Foo::test_stdout eq "Main Content", "Got the right output");
 


@@ -77,7 +81,7 @@ ok($Foo::test_stdout eq "Main Content", "Got the right output");
 #$ENV{'QUERY_STRING'}   = 'step=step2';
 
 Foo->new({
 #$ENV{'QUERY_STRING'}   = 'step=step2';
 
 Foo->new({

-  form => {step => 'step2'},
+    form => {step => 'step2'},

 })->navigate;
 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
 
 })->navigate;
 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
 


@@ -87,7 +91,7 @@ ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow
 #$ENV{'QUERY_STRING'}   = 'step=step2&wow=something';
 
 Foo->new({
 #$ENV{'QUERY_STRING'}   = 'step=step2&wow=something';
 
 Foo->new({

-  form=> {step => 'step2', wow => 'something'},
+    form=> {step => 'step2', wow => 'something'},

 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 
 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 


@@ -98,7 +102,7 @@ ok($Foo::test_stdout eq "All good", "Got the right output");
 local $ENV{'PATH_INFO'} = '/step2';
 
 Foo->new({
 local $ENV{'PATH_INFO'} = '/step2';
 
 Foo->new({

-  form=> {},
+    form=> {},

 })->navigate;
 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
 
 })->navigate;
 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
 


@@ -109,7 +113,7 @@ ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow
 local $ENV{'PATH_INFO'} = '/step2';
 
 my $f = Foo->new({
 local $ENV{'PATH_INFO'} = '/step2';
 
 my $f = Foo->new({

-  form=> {wow => 'something'},
+    form=> {wow => 'something'},

 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");


@@ -121,10 +125,134 @@ ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
 local $ENV{'PATH_INFO'} = '/step2/something';
 
 $f = Foo->new({
 local $ENV{'PATH_INFO'} = '/step2/something';
 
 $f = Foo->new({

-  form => {},
+    form => {},

 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 ok($f->form->{'step'} eq 'step2',     "Got the right variable set in form");
 ok($f->form->{'wow'}  eq 'something', "Got the right variable set in form");
 
 ###----------------------------------------------------------------###
 })->navigate;
 ok($Foo::test_stdout eq "All good", "Got the right output");
 ok($f->form->{'step'} eq 'step2',     "Got the right variable set in form");
 ok($f->form->{'wow'}  eq 'something', "Got the right variable set in form");
 
 ###----------------------------------------------------------------###

+
+local $ENV{'PATH_INFO'}   = '';
+local $ENV{'SCRIPT_NAME'} = '';
+
+Foo->new({
+    form => {},
+    require_auth => 1,
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output");
+
+###----------------------------------------------------------------###
+
+Foo->new({
+    form => {},
+})->navigate_authenticated;
+ok($Foo::test_stdout eq "Login Form", "Got the right output");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar;
+    @Bar::ISA = qw(Foo);
+    sub require_auth { 1 }
+}
+
+Bar->new({
+    form => {},
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar1;
+    @Bar1::ISA = qw(Foo);
+    sub require_auth { 1 }
+}
+
+my $ok = eval { Bar1->new({
+    form => {},
+})->navigate_authenticated; 1 }; # can't call navigate_authenticated with overwritten require_auth
+ok(! $ok, "Got the right output for Bar1");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar2;
+    @Bar2::ISA = qw(Foo);
+    sub main_require_auth { 1 }
+}
+
+Bar2->new({
+    form => {},
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar3;
+    @Bar3::ISA = qw(Foo);
+    sub require_auth { 1 }
+    sub main_require_auth { 0 }
+}
+
+Bar3->new({
+    form => {},
+})->navigate;
+ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar3");
+
+###----------------------------------------------------------------###
+
+Foo->new({
+    form => {},
+    require_auth => {main => 0},
+})->navigate;
+ok($Foo::test_stdout eq "Main Content", "Got the right output");
+
+###----------------------------------------------------------------###
+
+Foo->new({
+    form => {},
+    require_auth => {main => 1},
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar4;
+    @Bar4::ISA = qw(Foo);
+    sub pre_navigate { shift->require_auth(0); 0 }
+}
+
+Bar4->new({
+    form => {},
+})->navigate_authenticated;
+ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar5;
+    @Bar5::ISA = qw(Foo);
+    sub pre_navigate { shift->require_auth(1); 0 }
+}
+
+Bar5->new({
+    form => {},
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)");
+
+###----------------------------------------------------------------###
+
+{
+    package Bar6;
+    @Bar6::ISA = qw(Foo);
+    sub pre_navigate { shift->require_auth({main => 1}); 0 }
+}
+
+Bar6->new({
+    form => {},
+})->navigate;
+ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)");