5 4_app_00_base.t - Check for the basic functionality of CGI::Ex::App.
9 These tests are extremely stripped down to test the basic path flow. Normally
10 unit tests are useful for garnering information about a module. For CGI::Ex::App
11 it is suggested to stick to live use cases or the CGI::Ex::App perldoc - though
12 we do try to put it through most paces.
16 use Test::More tests => 20;
22 use base qw(CGI::Ex::App);
23 use vars qw($test_stdout);
25 sub init { $test_stdout = '' }
27 sub ready_validate { 1 }
33 $test_stdout = ref($str) ? $$str : $str;
37 my ($self, $step, $file, $swap) = @_;
38 my $out = ref($file) ? $$file : "No filenames allowed during test mode";
39 $self->cgix->swap_template(\$out, $swap);
43 sub auth_args { {login_template => \q{Login Form}} }
45 ###----------------------------------------------------------------###
47 sub main_info_complete { 0 }
49 sub main_file_print { return \ "Main Content" }
51 sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }
53 sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] }
55 sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }
57 sub step2_hash_swap { return {foo => 'bar', one => 'two'} }
59 sub step2_hash_fill { return {wow => 'wee'} }
61 sub step2_finalize { shift->append_path('step3') }
63 sub step3_info_complete { 0 }
65 sub step3_file_print { return \ "All good" }
68 ###----------------------------------------------------------------###
70 #$ENV{'REQUEST_METHOD'} = 'GET';
71 #$ENV{'QUERY_STRING'} = '';
76 ok($Foo::test_stdout eq "Main Content", "Got the right output");
78 ###----------------------------------------------------------------###
80 #$ENV{'REQUEST_METHOD'} = 'GET';
81 #$ENV{'QUERY_STRING'} = 'step=step2';
84 form => {step => 'step2'},
86 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
88 ###----------------------------------------------------------------###
90 #$ENV{'REQUEST_METHOD'} = 'GET';
91 #$ENV{'QUERY_STRING'} = 'step=step2&wow=something';
94 form=> {step => 'step2', wow => 'something'},
96 ok($Foo::test_stdout eq "All good", "Got the right output");
98 ###----------------------------------------------------------------###
100 #$ENV{'REQUEST_METHOD'} = 'GET';
101 #$ENV{'QUERY_STRING'} = '';
102 local $ENV{'PATH_INFO'} = '/step2';
107 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 ###----------------------------------------------------------------###
111 #$ENV{'REQUEST_METHOD'} = 'GET';
112 #$ENV{'QUERY_STRING'} = 'wow=something';
113 local $ENV{'PATH_INFO'} = '/step2';
116 form=> {wow => 'something'},
118 ok($Foo::test_stdout eq "All good", "Got the right output");
119 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
121 ###----------------------------------------------------------------###
123 #$ENV{'REQUEST_METHOD'} = 'GET';
124 #$ENV{'QUERY_STRING'} = '';
125 local $ENV{'PATH_INFO'} = '/step2/something';
130 ok($Foo::test_stdout eq "All good", "Got the right output");
131 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
132 ok($f->form->{'wow'} eq 'something', "Got the right variable set in form");
134 ###----------------------------------------------------------------###
136 local $ENV{'PATH_INFO'} = '';
137 local $ENV{'SCRIPT_NAME'} = '';
143 ok($Foo::test_stdout eq "Login Form", "Got the right output");
145 ###----------------------------------------------------------------###
149 })->navigate_authenticated;
150 ok($Foo::test_stdout eq "Login Form", "Got the right output");
152 ###----------------------------------------------------------------###
157 sub require_auth { 1 }
163 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar");
165 ###----------------------------------------------------------------###
169 @Bar1::ISA = qw(Foo);
170 sub require_auth { 1 }
173 my $ok = eval { Bar1->new({
175 })->navigate_authenticated; 1 }; # can't call navigate_authenticated with overwritten require_auth
176 ok(! $ok, "Got the right output for Bar1");
178 ###----------------------------------------------------------------###
182 @Bar2::ISA = qw(Foo);
183 sub main_require_auth { 1 }
189 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2");
191 ###----------------------------------------------------------------###
195 @Bar3::ISA = qw(Foo);
196 sub require_auth { 1 }
197 sub main_require_auth { 0 }
203 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar3");
205 ###----------------------------------------------------------------###
209 require_auth => {main => 0},
211 ok($Foo::test_stdout eq "Main Content", "Got the right output");
213 ###----------------------------------------------------------------###
217 require_auth => {main => 1},
219 ok($Foo::test_stdout eq "Login Form", "Got the right output");
221 ###----------------------------------------------------------------###
225 @Bar4::ISA = qw(Foo);
226 sub pre_navigate { shift->require_auth(0); 0 }
231 })->navigate_authenticated;
232 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4");
234 ###----------------------------------------------------------------###
238 @Bar5::ISA = qw(Foo);
239 sub pre_navigate { shift->require_auth(1); 0 }
245 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)");
247 ###----------------------------------------------------------------###
251 @Bar6::ISA = qw(Foo);
252 sub pre_navigate { shift->require_auth({main => 1}); 0 }
258 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)");