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 => 234;
19 use CGI::Ex::Dump qw(debug);
24 use base qw(CGI::Ex::App);
25 use vars qw($test_stdout);
27 sub init { $test_stdout = '' }
33 $test_stdout = ref($str) ? $$str : $str;
37 my ($self, $step, $file, $swap) = @_;
38 die "No filenames allowed during test mode" if ! ref($file);
39 return $self->SUPER::swap_template($step, $file, $swap);
42 sub auth_args { {login_template => \q{Login Form}, key_user => 'user', key_pass => 'pass', key_cookie => 'user', set_cookie => sub {}} }
44 sub get_pass_by_user { '123qwe' }
46 ###----------------------------------------------------------------###
48 sub main_info_complete { 0 }
50 sub main_file_print { return \ "Main Content [%~ extra %]" }
52 sub main_path_info_map { shift->{'main_path_info_map'} }
54 sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }
56 sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] }
58 sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }
60 sub step2_hash_swap { return {foo => 'bar', one => 'two'} }
62 sub step2_hash_fill { return {wow => 'wee'} }
64 sub step2_finalize { shift->append_path('step3') }
66 sub step3_info_complete { 0 }
68 sub step3_file_print { return \ "All good [%~ extra %]" }
70 sub step4_file_val { return {wow => {required => 1, required_error => 'wow is required'}} }
72 sub step4_path_info_map { [[qr{^/step4/(\w+)$}x, 'wow']] }
74 sub step4_file_print { return \ "Some step4 content ([% foo %], [% one %]) <form><input type=text name=wow>[% wow_error %]</form>[% js_validation %]" }
76 sub step4_hash_swap { return {foo => 'bar', one => 'two'} }
78 sub step4_hash_fill { return {wow => 'wee'} }
80 sub step4_finalize { shift->append_path('step3') }
82 sub step5__part_a_file_print { return \ "Step 5 Nested ([% step %])" }
84 sub step5__part_a_info_complete { 0 }
88 ###----------------------------------------------------------------###
89 ###----------------------------------------------------------------###
90 print "#-----------------------------------------\n";
91 print "### Test some basic returns ###\n";
93 ok(! eval { CGI::Ex::App::new() }, "Invalid new");
94 ok(! eval { CGI::Ex::App::new(0) }, "Invalid new");
96 my $app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar'});
97 ok($app->script_name eq '/cgi-bin/foo_bar', "Can pass in script_name");
98 ok($app->name_module eq 'foo_bar', "Can pass in script_name");
100 $app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar.pl'});
101 ok($app->script_name eq '/cgi-bin/foo_bar.pl', "Can pass in script_name");
102 ok($app->name_module eq 'foo_bar', "Can pass in script_name");
104 ok(Foo->new(name_module => 'foo')->name_module eq 'foo', "Got the name_module");
105 ok(! eval { Foo->new(script_name => '%####$')->name_module } && $@, "Bad script_name");
106 ok(! eval { Foo->new(script_name => '%####$')->name_module('foo') } && $@, "Bad script_name");
108 ok(! eval { $app->morph_package } && $@, "Can't get a good morph_package");
109 ok($app->morph_package('foo') eq 'CGI::Ex::App::Foo', "Got a good morph_package");
110 ok($app->morph_package('foo_bar') eq 'CGI::Ex::App::FooBar', "Got a good morph_package");
112 ok(ref($app->path), "Got a good path");
113 ok(@{ $app->path } == 0, "Got a good path");
114 is($app->default_step, 'main', "Got a good default_step");
115 is($app->login_step, '__login', "Got a good login_step");
116 is($app->error_step, '__error', "Got a good error_step");
117 is($app->forbidden_step, '__forbidden', "Got a good forbidden_step");
118 is($app->js_step, 'js', "Got a good js_step");
120 # check for different step types
121 is($app->run_hook('file_print', '__leading_underbars'), 'foo_bar/__leading_underbars.html', 'file_print - __ is preserved at beginning of step');
122 is($app->run_hook('file_print', 'central__underbars'), 'foo_bar/central/underbars.html', 'file_print - __ is used in middle of step');
124 is($app->run_hook('morph_package', '__leading_underbars'), "${ref}::LeadingUnderbars", 'morph_package - __ is works at beginning of step');
125 is($app->run_hook('morph_package', 'central__underbars'), "${ref}::Central::Underbars", 'morph_package - __ is used in middle of step');
127 ###----------------------------------------------------------------###
128 ###----------------------------------------------------------------###
129 print "#-----------------------------------------\n";
130 print "### Test basic step selection/form input/validation/filling/template swapping methods ###\n";
132 #$ENV{'REQUEST_METHOD'} = 'GET';
133 #$ENV{'QUERY_STRING'} = '';
138 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo");
146 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2");
148 ###----------------------------------------------------------------###
153 sub pre_navigate { 1 }
156 ok($Foo::test_stdout eq "", "Got the right output for Foo2_1");
158 Foo2_1->new({_no_pre_navigate => 1})->navigate;
159 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_1");
167 ok($Foo::test_stdout eq "", "Got the right output for Foo2_2");
175 ok($Foo::test_stdout eq "", "Got the right output for Foo2_3");
180 sub post_navigate { $Foo::test_stdout .= " post"; 1 }
183 ok($Foo::test_stdout eq "Main Content post", "Got the right output for Foo2_4");
185 Foo2_4->new({_no_post_navigate => 1})->navigate;
186 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_4");
190 ###----------------------------------------------------------------###
192 local $ENV{'REQUEST_METHOD'} = 'POST';
193 #$ENV{'QUERY_STRING'} = 'step=step2';
196 form => {step => 'step2'},
198 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output for Foo");
201 form => {step => 'step4'},
203 ok($Foo::test_stdout =~ /Some step4 content.*wow is required.*<script>/s, "Got the right output for Foo (step4)");
206 form => {step => 'step5/part_a'},
208 is($Foo::test_stdout, 'Step 5 Nested (step5__part_a)', "Got the right output for Foo (step5__part_a)");
211 form => {step => 'step5__part_a'},
213 is($Foo::test_stdout, 'Step 5 Nested (step5__part_a)', "Got the right output for Foo (step5__part_a)");
218 sub main_info_complete { 1 }
220 eval { Foo3->navigate };
221 ok($Foo::test_stdout =~ /recurse_limit \(15\)/, "Got the right output for Foo3");
223 eval { Foo3->new({recurse_limit => 10})->navigate };
224 ok($Foo::test_stdout =~ /recurse_limit \(10\)/, "Got the right output for Foo3");
226 ###----------------------------------------------------------------###
228 #$ENV{'REQUEST_METHOD'} = 'GET';
229 #$ENV{'QUERY_STRING'} = 'step=step2&wow=something';
232 form=> {step => 'step2', wow => 'something'},
234 ok($Foo::test_stdout eq "All good", "Got the right output for Foo");
236 ###----------------------------------------------------------------###
238 #$ENV{'REQUEST_METHOD'} = 'GET';
239 #$ENV{'QUERY_STRING'} = 'step=step2&wow=something';
242 form=> {step => '_bling'},
244 ok($Foo::test_stdout =~ /Denied/i, "Got the right output for Foo");
249 sub path { shift->{'path'} ||= ['3foo'] }
251 Foo4->new({form => {}})->navigate;
252 ok($Foo::test_stdout =~ /Denied/i, "Got the right output for Foo4");
254 ###----------------------------------------------------------------###
256 #$ENV{'REQUEST_METHOD'} = 'GET';
257 #$ENV{'QUERY_STRING'} = '';
258 local $ENV{'PATH_INFO'} = '/step2';
263 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
266 path_info_map_base => [],
268 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
271 path_info_map_base => [[qr{(?!)}, 'foo']],
273 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
276 path_info_map_base => {},
278 ok($Foo::test_stdout eq "", "Got the right output for Foo");
281 path_info_map_base => [{}],
283 ok($Foo::test_stdout eq "", "Got the right output for Foo");
288 sub path_info_map_base {}
291 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo5");
293 local $ENV{'PATH_INFO'} = '/blah';
296 path_info_map_base => [],
297 main_path_info_map => {},
299 ok($Foo::test_stdout =~ /fatal error.+path_info_map/, "Got the right output for Foo");
302 path_info_map_base => [],
303 main_path_info_map => [{}],
305 ok($Foo::test_stdout =~ /fatal error.+path_info_map/, "Got the right output for Foo");
307 ###----------------------------------------------------------------###
309 local $ENV{'PATH_INFO'} = '/whatever';
311 path_info_map_base => [[qr{(.+)}, sub { my ($form, $m1) = @_; $form->{'step'} = 'step3'; $form->{'extra'} = $m1 }]],
313 is($Foo::test_stdout, 'All good/whatever', "Got the right output path_info_map_base with a code ref");
315 ###----------------------------------------------------------------###
317 #$ENV{'REQUEST_METHOD'} = 'GET';
318 #$ENV{'QUERY_STRING'} = 'wow=something';
319 local $ENV{'PATH_INFO'} = '/step2';
322 form=> {wow => 'something'},
324 ok($Foo::test_stdout eq "All good", "Got the right output");
325 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
327 ###----------------------------------------------------------------###
329 #$ENV{'REQUEST_METHOD'} = 'GET';
330 #$ENV{'QUERY_STRING'} = '';
331 local $ENV{'PATH_INFO'} = '/step2/something';
336 ok($Foo::test_stdout eq "All good", "Got the right output");
337 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
338 ok($f->form->{'wow'} eq 'something', "Got the right variable set in form");
340 ###----------------------------------------------------------------###
342 local $ENV{'PATH_INFO'} = '/step5/part_a';
344 path_info_map_base => [[qr{(.+)}, 'step']],
346 is($Foo::test_stdout, 'Step 5 Nested (step5__part_a)', "Got the right output for Foo (step5/part_a)");
348 ###----------------------------------------------------------------###
350 local $ENV{'PATH_INFO'} = '';
355 sub valid_steps { {step2 => 1} }
356 sub js_run_step { $Foo::test_stdout = 'JS' }
359 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo6");
361 Foo6->new({form => {step => 'main'}})->navigate;
362 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo6");
364 Foo6->new({form => {step => 'step3'}})->navigate;
365 ok($Foo::test_stdout =~ /denied/i, "Got the right output for Foo6");
367 Foo6->new({form => {step => 'step2'}})->navigate;
368 ok($Foo::test_stdout =~ /step2/i, "Got the right output for Foo6");
370 Foo6->new({form => {step => Foo6->new->js_step}})->navigate;
371 ok($Foo::test_stdout eq 'JS', "Got the right output for Foo6");
375 ###----------------------------------------------------------------###
376 ###----------------------------------------------------------------###
377 ###----------------------------------------------------------------###
378 ###----------------------------------------------------------------###
379 print "#-----------------------------------------\n";
380 print "### Test Authorization Methods ###\n";
382 local $ENV{'PATH_INFO'} = '';
383 local $ENV{'SCRIPT_NAME'} = '/foo';
389 is($Foo::test_stdout, "Login Form", "Got the right output");
393 cookies => {user => 'foo/123qwe'},
396 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
400 cookies => {user => 'foo/123qwe'},
401 })->check_valid_auth, "Ran check_valid_auth");
403 my $cva = Foo->new({form => {}, cookies => {user => 'foo/123qwe'}});
404 ok($cva->check_valid_auth && $cva->check_valid_auth, "Can run twice");
410 })->check_valid_auth, "Ran check_valid_auth");
414 auth_data => {user => 'foo'},
417 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
419 ###----------------------------------------------------------------###
423 })->navigate_authenticated;
424 ok($Foo::test_stdout eq "Login Form", "Got the right output");
426 ###----------------------------------------------------------------###
431 sub require_auth { 1 }
437 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar");
439 ###----------------------------------------------------------------###
444 sub require_auth { 1 }
447 my $ok = eval { Bar1->new({
449 })->navigate_authenticated; 1 }; # can't call navigate_authenticated with overwritten require_auth
450 ok(! $ok, "Got the right output for Bar1");
452 ###----------------------------------------------------------------###
457 sub main_require_auth { 1 }
463 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2");
465 ###----------------------------------------------------------------###
470 sub require_auth { 1 }
471 sub main_require_auth { 0 }
477 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar3");
479 ###----------------------------------------------------------------###
483 require_auth => {main => 0},
485 ok($Foo::test_stdout eq "Main Content", "Got the right output");
487 ###----------------------------------------------------------------###
491 require_auth => {main => 1},
493 ok($Foo::test_stdout eq "Login Form", "Got the right output");
495 ###----------------------------------------------------------------###
500 sub pre_navigate { shift->require_auth(0); 0 }
505 })->navigate_authenticated;
506 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4");
508 ###----------------------------------------------------------------###
513 sub pre_navigate { shift->require_auth(1); 0 }
519 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)");
521 ###----------------------------------------------------------------###
526 sub pre_navigate { shift->require_auth({main => 1}); 0 }
532 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)");
534 ###----------------------------------------------------------------###
535 ###----------------------------------------------------------------###
536 ###----------------------------------------------------------------###
537 ###----------------------------------------------------------------###
538 print "#-----------------------------------------\n";
539 print "### Test Configuration methods ###\n";
544 sub name_module { my $self = shift; defined($self->{'name_module'}) ? $self->{'name_module'} : 'conf_1' }
547 my $file = Conf1->new->conf_file;
548 ok($file && $file eq 'conf_1.pl', "Got a conf_file ($file)");
550 ok(! eval { Conf1->new(name_module => '')->conf_file } && $@, "Couldn't get conf_file");
552 $file = Conf1->new({ext_conf => 'ini'})->conf_file;
553 ok($file && $file eq 'conf_1.ini', "Got a conf_file ($file)");
559 ok($err, "Got an error");
561 ok($Foo::test_stdout eq "", "Got the right output for Conf1");
566 form => {step => 'step3'},
569 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
573 conf_file => {form => {step => 'step3'}},
575 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
579 conf_file => {form => {step => 'step3'}},
580 conf_validation => {form => {required => 1}},
582 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
587 conf_validation => {form => {required => 1}},
589 ok($Foo::test_stdout eq "" && $@, "Got a conf_validation error");
591 ###----------------------------------------------------------------###
592 ###----------------------------------------------------------------###
593 ###----------------------------------------------------------------###
594 ###----------------------------------------------------------------###
595 print "#-----------------------------------------\n";
596 print "### Various other coverage tests\n";
598 ok(Conf1->new->conf_obj, "Got a conf_obj");
599 ok(Conf1->new(conf_args => {paths => './', directive => 'merge'})->conf_obj, "Got a conf_obj");
600 ok(Conf1->new->val_obj, "Got a val_obj");
601 ok(Conf1->new(val_args => {cgix => Conf1->new->cgix})->val_obj, "Got a val_obj");
602 ok(Conf1->new->load_conf(1), "Ran load_conf");
604 ok(Foo2->navigate->clear_app, "clear_app works");
606 my $dh = Foo2->navigate;
607 push @{ $dh->history }, "A string", ['A non ref'], {key => 'No elapsed key'};
608 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 2, response => {}};
609 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 2, response => {hi => 'there'}};
610 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => []};
611 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => ['hi']};
612 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => 'a'};
613 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => 'a'x100};
614 ok($dh->dump_history, "Can call dump_history");
615 ok($dh->dump_history('all'), "Can call dump_history");
616 $dh->{'history_max'} = 10;
617 ok($dh->dump_history('all'), "Can call dump_history");
628 sub find_hook { my ($self, $hook, $step) = @_; return $self->SUPER::find_hook($hook, $step) if $step eq 'main'; return ["non_code",1] }
630 Foo7->new({no_history => 1})->navigate;
631 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo7 ($Foo::test_stdout)");
633 ok( eval { Foo->new->run_hook('hash_base', 'main') }, "Can run_hook main hash_base on Foo");
634 ok(! eval { Foo->new->run_hook('bogus', 'main') }, "Can't run_hook main bogus on Foo");
635 ok(! eval { Foo7->new->run_hook('hash_base', 'bogus') }, "Can't run_hook bogus hash_base on Foo7 for other reasons");
637 foreach my $meth (qw(auth_args conf_args template_args val_args)) {
638 ok(! CGI::Ex::App->new->$meth, "Got a good $meth");
639 ok(CGI::Ex::App->new($meth => {a=>'A'})->$meth->{'a'} eq 'A', "Got a good $meth");
643 foreach my $meth (qw(charset
663 ok(CGI::Ex::App->new($meth => 'blah')->$meth eq 'blah', "I can set $meth");
667 foreach my $meth (qw(base_dir_abs
678 ok(CGI::Ex::App->new($meth => 'blah')->$meth eq 'blah', "I can set $meth");
679 my $c = CGI::Ex::App->new;
681 ok($c->$meth eq 'blah', "I can set $meth");
684 foreach my $type (qw(base
691 my $meth = "hash_$type";
692 ok(CGI::Ex::App->new("hash_$type" => {bing => 'bang'})->$meth->{'bing'} eq 'bang', "Can initialize $meth")
695 my $meth2 = "add_to_$type";
696 my $c = CGI::Ex::App->new;
697 $c->$meth2({bing => 'bang'});
698 $c->$meth2(bong => 'beng');
700 if ($type eq 'errors') {
701 $c->$meth2({bing => "wow"});
702 ok($c->$meth->{"bing_error"} eq "bang<br>wow", "$meth2 works");
703 ok($c->$meth->{"bong_error"} eq 'beng', "$meth2 works");
705 ok($c->has_errors, "has_errors works") if $type eq 'errors';
707 ok($c->$meth->{'bing'} eq 'bang', "$meth2 works");
708 ok($c->$meth->{'bong'} eq 'beng', "$meth2 works");
712 ok(! eval { CGI::Ex::App->new->get_pass_by_user } && $@, "Got a good error for get_pass_by_user");
713 ok(! eval { CGI::Ex::App->new->find_hook } && $@, "Got a good error for find_hook");
715 ###----------------------------------------------------------------###
716 print "#-----------------------------------------\n";
717 print "### Some morph tests ###\n";
723 sub blah1_pre_step { $Foo::test_stdout = 'blah1_pre'; 1 }
725 sub blah3_info_complete { 1 }
726 sub blah3_post_step { $Foo::test_stdout = 'blah3_post'; 1 }
728 sub blah4_prepare { 0 }
729 sub blah4_file_print { \ 'blah4_file_print' }
731 sub blah5_finalize { 0 }
732 sub blah5_info_complete { 1 }
733 sub blah5_file_print { \ 'blah5_file_print' }
735 sub blah8_morph_package { 'Foo8' }
736 sub blah8_info_complete { 0 }
737 sub blah8_file_print { \ 'blah8_file_print' }
739 sub blah6_allow_morph { 1 }
742 sub info_complete { 0 }
743 sub file_print { \ 'blah6_file_print' }
744 sub early_exit_run_step { $Foo::test_stdout = 'early'; shift->exit_nav_loop }
746 sub blah7_allow_morph { 1 }
747 package Foo8::Blah6::Blah7;
748 our @ISA = qw(Foo8::Blah6);
749 sub info_complete { 0 }
750 sub file_print { \ 'blah7_file_print' }
754 sub info_complete { 0 }
755 sub file_print { \ 'blah9_file_print' }
758 sub __error_allow_morph { 0 }
759 sub __error_file_print { \ '[% error_step %] - [% error %]' }
760 $INC{'Foo8/Blah10.pm'} = 'internal'; # fake require - not a real App package
763 sub blah11_morph_package { 'Not::Exists::Blah11' }
766 Foo8->new({form => {step => 'blah1'}})->navigate;
767 is($Foo::test_stdout, 'blah1_pre', "Got the right output for Foo8");
769 Foo8->new({form => {step => 'blah1'}, allow_morph => 1})->navigate;
770 is($Foo::test_stdout, 'blah1_pre', "Got the right output for Foo8");
772 Foo8->new({form => {step => 'blah2'}})->navigate;
773 is($Foo::test_stdout, 'Main Content', "Got the right output for Foo8");
775 Foo8->new({form => {step => 'blah3'}})->navigate;
776 is($Foo::test_stdout, 'blah3_post', "Got the right output for Foo8");
778 Foo8->new({form => {step => 'blah4'}})->navigate;
779 is($Foo::test_stdout, 'blah4_file_print', "Got the right output for Foo8");
781 Foo8->new({form => {step => 'blah5'}})->navigate;
782 is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
784 Foo8->new({form => {step => 'blah5'}, allow_morph => 1})->navigate;
785 is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
787 Foo8->new({form => {step => 'blah5'}, allow_morph => 0})->navigate;
788 is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
790 Foo8->new({form => {step => 'blah5'}, allow_morph => {}})->navigate;
791 is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
793 Foo8->new({form => {step => 'blah5'}, allow_morph => {blah5 => 1}})->navigate;
794 is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
796 Foo8->new({form => {step => 'blah6'}})->navigate;
797 is($Foo::test_stdout, 'blah6_file_print', "Got the right output for Foo8");
799 Foo8->new({form => {step => 'blah8'}, allow_morph => 1})->navigate;
800 is($Foo::test_stdout, 'blah8_file_print', "Got the right output for Foo8 ($Foo::test_stdout)");
802 my $foo8 = Foo8->new({form => {step => 'blah7'}});
803 $foo8->morph('blah6');
805 is($Foo::test_stdout, 'blah7_file_print', "Got the right output for Foo8");
807 $foo8 = Foo8->new({form => {step => 'early_exit'}, no_history => 1});
808 $foo8->morph('blah6');
810 ok($Foo::test_stdout eq 'early', "Got the right output for Foo8");
811 is(ref($foo8), 'Foo8::Blah6', 'Still is unmorphed right');
815 ok(ref($foo8) eq 'Foo8', 'Got the right class');
816 $foo8->morph('blah6');
817 eval { $foo8->exit_nav_loop }; # coverage
818 ok($@, "Got the die from exit_nav_loop");
820 Foo8->new({form => {step => 'blah9'}, allow_morph => 2})->navigate;
821 is($Foo::test_stdout, 'blah9_file_print', "Got the right output for Foo8::Blah9 ($Foo::test_stdout)");
823 $foo8 = Foo8->new({form => {step => 'blah10'}, allow_morph => 2});
824 eval { $foo8->navigate };
825 #use CGI::Ex::Dump qw(debug);
826 #debug $foo8->dump_history;
827 ok($Foo::test_stdout =~ /^blah10 -/, "Got the right output for Foo8::Blah10");
828 ok($Foo::test_stdout =~ m|Found package Foo8::Blah10|, "Got the right output for Foo8::Blah10") || diag $Foo::test_stdout;
830 $foo8 = Foo8->new({form => {step => 'blah11'}, allow_morph => 2});
831 eval { $foo8->navigate };
832 #use CGI::Ex::Dump qw(debug);
833 #debug $foo8->dump_history;
834 ok($Foo::test_stdout =~ /^blah11 -/, "Got the right output for Foo8::Blah11");
835 ok($Foo::test_stdout =~ m|Not/Exists/Blah11.pm.*\@INC|, "Got the right output for Foo8::Blah11") || diag $Foo::test_stdout;
839 $foo8->run_hook('morph', 'blah6', 1);
840 is(ref($foo8), 'Foo8::Blah6', "Right package");
842 $foo8->run_hook_as('run_step', 'blah7', 'Foo8::Blah6::Blah7');
843 is($Foo::test_stdout, 'blah7_file_print', "Got the right output for Foo8::Blah6::Blah7");
844 is(ref($foo8), 'Foo8::Blah6', "Right package");
846 $foo8->run_hook_as('run_step', 'main', 'Foo8');
847 is($Foo::test_stdout, 'Main Content', "Got the right output for Foo8");
848 is(ref($foo8), 'Foo8::Blah6', "Right package");
850 $foo8->run_hook_as('run_step', 'blah6', 'Foo8::Blah6');
851 is($Foo::test_stdout, 'blah6_file_print', "Got the right output for Foo8::Blah6");
852 $foo8->run_hook('unmorph', 'blah6');
853 #use CGI::Ex::Dump qw(debug);
854 #debug $foo8->dump_history;
861 sub default_step { 'bazmain' }
862 sub info_complete { 0 }
863 sub file_print { my ($self, $step) = @_; return \qq{\u$step Content} }
864 sub allow_morph { 1 }
871 sub hash_swap { shift->goto_step('bstep3') } # hijack it here
878 is($Foo::test_stdout, 'Bazmain Content', "Got the right output for Foo8::Blah6");
879 Baz->navigate({form => {step => 'bstep1'}});
880 is($Foo::test_stdout, 'Bstep1 Content', "Got the right output for Foo8::Blah6");
882 my $baz = Baz->new({form => {step => 'bstep2'}});
883 eval { $baz->navigate };
884 is($Foo::test_stdout, 'Bstep3 Content', "Got the right output for Foo8::Blah6");
885 is(ref($baz), 'Baz', "And back to the correct object type");
886 #debug $baz->dump_history;
888 ###----------------------------------------------------------------###
889 print "#-----------------------------------------\n";
890 print "### Some path tests ###\n";
897 my $str = "First(".$self->first_step.") Previous(".$self->previous_step.") Current(".$self->current_step.") Next(".$self->next_step.") Last(".$self->last_step.")";
902 sub info_complete { 0 }
903 sub invalid_run_step { shift->goto_step('::') }
905 ok(Foo9->new->previous_step eq '', 'No previous step if not navigating');
907 my $c = Foo9->new(form => {step => 'one'});
908 $c->add_to_path('three', 'four', 'five');
909 $c->insert_path('one', 'two');
911 is($Foo::test_stdout, 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
912 ok(! eval { $c->set_path("more") }, "Can't call set_path after nav started");
914 $c = Foo9->new(form => {step => 'five'});
915 $c->set_path('one', 'two', 'three', 'four', 'five');
917 is($Foo::test_stdout, 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
920 $c->append_path('one');
921 eval { $c->goto_step('FIRST') };
922 is($Foo::test_stdout, 'Main Content', "Can jump without nav_loop started");
926 eval { $c->goto_step('main') };
927 is($Foo::test_stdout, 'Main Content', "Can jump to step not on the path");
929 ###----------------------------------------------------------------###
937 my $s = join "", @{ $self->path };
938 substr($s, $self->{'path_i'}, 0, '(');
939 substr($s, $self->{'path_i'} + 2, 0, ')');
944 # my ($self, $hook, $step) = @_;
945 # print "Into $step: ".$self->join_path."\n" if $hook eq 'run_step';
946 # return $self->SUPER::run_hook($hook, $step);
951 if ($self->join_path eq '(a)') {
952 $self->append_path('b', 'c', 'd', 'e');
953 $self->jump('CURRENT');
954 } elsif ($self->join_path eq 'a(a)bcde') {
956 } elsif ($self->join_path eq 'aab(a)bcde') {
958 } elsif ($self->join_path eq 'aabab(a)ababcde') {
960 } elsif ($self->join_path eq 'aababacd(a)ababacde') {
963 die "Shouldn't get here";
969 if ($self->join_path eq 'aa(b)cde') {
970 $self->jump('PREVIOUS');
971 } elsif ($self->join_path eq 'aaba(b)cde') {
974 die "Shouldn't get here";
980 sub d_run_step { shift->jump('FIRST') }
984 $self->replace_path(); # truncate
988 sub default_step { 'z' }
992 sub __error_run_step { 1 }
995 my $Foo10 = Foo10->new(form => {step => 'a'});
997 is($Foo10->join_path, 'aababacdae(z)', 'Followed good path');
999 ###----------------------------------------------------------------###
1000 print "#-----------------------------------------\n";
1001 print "### Integrated validation tests ###\n";
1006 sub step1_skip { 1 }
1007 sub step1_next_step { 'step6' }
1008 sub step6_file_print { \ 'step6_file_print' }
1009 sub step2_name_step { '' }
1010 sub step3_name_step { 'foo.htm' }
1013 our @ISA = qw(Foo11);
1017 local $ENV{'SCRIPT_NAME'} = '/cgi/ralph.pl';
1018 ok(Foo11->new->file_print("george") eq 'ralph/george.html', 'file_print: '. Foo11->new->file_print("george"));
1019 ok(Foo11->new->file_val("george") =~ m|\Q/ralph/george.val\E|, 'file_val: '. Foo11->new->file_val("george"));
1020 ok(ref(Foo12->new->file_val("george")) eq 'HASH', 'file_val: no such path');
1021 ok(Foo11->new(val_path => '../' )->file_val("george") eq '../ralph/george.val', 'file_val');
1022 ok(Foo11->new(val_path => sub {'../'} )->file_val("george") eq '../ralph/george.val', 'file_val');
1023 ok(Foo11->new(val_path => ['../'] )->file_val("george") eq '../ralph/george.val', 'file_val');
1024 ok(Foo11->new(val_path => ['../', './'])->file_val("george") eq '../ralph/george.val', 'file_val');
1026 ok(! eval { Foo11->new->file_print("step2") } && $@, 'Bad name_step');
1027 ok(! eval { Foo11->new->file_val("step2") } && $@, 'Bad name_step');
1029 ok(Foo11->new->file_print("step3") eq 'ralph/foo.htm', 'file_print: '. Foo11->new->file_print("step3"));
1030 ok(Foo11->new->file_val("step3") =~ m|\Q/ralph/foo.val\E|, 'file_val: '. Foo11->new->file_val("step3"));
1033 local $ENV{'REQUEST_METHOD'} = 'POST';
1035 Foo11->new(form => {step => 'step1'})->navigate;
1036 ok($Foo::test_stdout eq 'step6_file_print', "Refine Path and set_ready_validate work ($Foo::test_stdout)");
1039 $f->set_ready_validate(1);
1040 ok($f->ready_validate, "Is ready to validate");
1041 $f->set_ready_validate(0);
1042 ok(! $f->ready_validate, "Not ready to validate");
1043 $f->set_ready_validate(1);
1044 ok($f->ready_validate, "Is ready to validate");
1045 $f->set_ready_validate('somestep', 0);
1046 ok(! $f->ready_validate, "Not ready to validate");
1048 ###----------------------------------------------------------------###
1053 sub step0_ready_validate { 1 }
1054 sub step0_hash_validation { {foo => {required => 1}} }
1056 sub step1_ready_validate { 1 }
1057 sub step1_form_name { shift->{'step1_form_name'} }
1058 sub step1_hash_validation { shift->{'step1_hash_validation'} }
1059 sub step1_file_print { \ 'step1_file_print [% has_errors %]' }
1062 ok(Foo13->new(ext_val => 'html')->navigate, 'Ran Foo13');
1063 ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13 ($Foo::test_stdout)");
1065 Foo13->new(form => {step => 'step1'})->navigate->js_validation('step1');
1066 ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13");
1068 ok(Foo13->new->js_validation('step1') eq '', "No validation found");
1069 ok(Foo13->new->js_validation('step1', 'foo') eq '', "No validation found");
1070 ok(Foo13->new->js_validation('step1', 'foo', {}) eq '', "No validation found");
1071 ok(Foo13->new->js_validation('step1', 'foo', {foo => {required => 1}}), "Validation found");
1073 ###----------------------------------------------------------------###
1074 print "#-----------------------------------------\n";
1075 print "### Header tests ###\n";
1079 sub new { bless {}, __PACKAGE__ }
1082 my ($self, $file) = @_;
1083 $Foo::test_stdout = "Print JS: $file";
1085 sub print_content_type {
1087 my $mime = shift || 'text/html';
1088 my $char = shift || '';
1089 $mime .= "; charset=$char" if $char && $char =~ m|^[\w\-\.\:\+]+$|;
1090 $Foo::test_stdout = "Print: $mime";
1094 CGI::Ex::App->new(cgix => CGIX->new)->js_run_step;
1095 ok($Foo::test_stdout eq 'Print JS: ', "Ran js_run_step: $Foo::test_stdout");
1097 CGI::Ex::App->new(cgix => CGIX->new, form => {js => 'CGI/Ex/validate.js'})->js_run_step;
1098 ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
1100 CGI::Ex::App->new(cgix => CGIX->new, path_info => '/js/CGI/Ex/validate.js')->js_run_step;
1101 ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
1103 CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', "# the output\n");
1104 ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
1105 CGI::Ex::App->new(cgix => CGIX->new, mimetype => 'img/gif')->print_out('foo', "# the output\n");
1106 ok($Foo::test_stdout eq 'Print: img/gif', "Got right header: $Foo::test_stdout");
1107 CGI::Ex::App->new(cgix => CGIX->new, charset => 'ISO-foo')->print_out('foo', "# the output\n");
1108 ok($Foo::test_stdout eq 'Print: text/html; charset=ISO-foo', "Got right header: $Foo::test_stdout");
1110 CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', \ "# the output\n");
1111 ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
1113 ###----------------------------------------------------------------###\
1114 print "#-----------------------------------------\n";