X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=t%2F4_app_00_base.t;h=ec223d8e48d132cce4903e3c5ec641ef7bc584c9;hp=1520d7abcbfcc518f3ae8f6ba9ea7dfc35631582;hb=419d9570723c210429e2be23875160f57dd36156;hpb=aa030874456c91d688e6c9b25e82d2bf9575ea6f

diff --git a/t/4_app_00_base.t b/t/4_app_00_base.t
index 1520d7a..ec223d8 100644
--- 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
-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
 
-use Test::More tests => 9;
+use Test::More tests => 20;
 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({
-  form => {},
+    form => {},
 })->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({
-  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");
 
@@ -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({
-  form=> {step => 'step2', wow => 'something'},
+    form=> {step => 'step2', wow => 'something'},
 })->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({
-  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");
 
@@ -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({
-  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");
@@ -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({
-  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");
 
 ###----------------------------------------------------------------###
+
+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 ($@)");