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 => 214;
23 use base qw(CGI::Ex::App);
24 use vars qw($test_stdout);
26 sub init { $test_stdout = '' }
32 $test_stdout = ref($str) ? $$str : $str;
36 my ($self, $step, $file, $swap) = @_;
37 die "No filenames allowed during test mode" if ! ref($file);
38 return $self->SUPER::swap_template($step, $file, $swap);
41 sub auth_args { {login_template => \q{Login Form}, key_user => 'user', key_pass => 'pass', key_cookie => 'user', set_cookie => sub {}} }
43 sub get_pass_by_user { '123qwe' }
45 ###----------------------------------------------------------------###
47 sub main_info_complete { 0 }
49 sub main_file_print { return \ "Main Content" }
51 sub main_path_info_map { shift->{'main_path_info_map'} }
53 sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }
55 sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] }
57 sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }
59 sub step2_hash_swap { return {foo => 'bar', one => 'two'} }
61 sub step2_hash_fill { return {wow => 'wee'} }
63 sub step2_finalize { shift->append_path('step3') }
65 sub step3_info_complete { 0 }
67 sub step3_file_print { return \ "All good" }
69 sub step4_file_val { return {wow => {required => 1, required_error => 'wow is required'}} }
71 sub step4_path_info_map { [[qr{^/step4/(\w+)$}x, 'wow']] }
73 sub step4_file_print { return \ "Some step4 content ([% foo %], [% one %]) <form><input type=text name=wow>[% wow_error %]</form>[% js_validation %]" }
75 sub step4_hash_swap { return {foo => 'bar', one => 'two'} }
77 sub step4_hash_fill { return {wow => 'wee'} }
79 sub step4_finalize { shift->append_path('step3') }
83 ###----------------------------------------------------------------###
84 ###----------------------------------------------------------------###
85 ###----------------------------------------------------------------###
86 ###----------------------------------------------------------------###
87 print "### Test some basic returns ###\n";
89 ok(! eval { CGI::Ex::App::new() }, "Invalid new");
90 ok(! eval { CGI::Ex::App::new(0) }, "Invalid new");
92 my $app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar'});
93 ok($app->script_name eq '/cgi-bin/foo_bar', "Can pass in script_name");
94 ok($app->name_module eq 'foo_bar', "Can pass in script_name");
96 $app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar.pl'});
97 ok($app->script_name eq '/cgi-bin/foo_bar.pl', "Can pass in script_name");
98 ok($app->name_module eq 'foo_bar', "Can pass in script_name");
100 ok(Foo->new(name_module => 'foo')->name_module eq 'foo', "Got the name_module");
101 ok(! eval { Foo->new(script_name => '%####$')->name_module } && $@, "Bad script_name");
102 ok(! eval { Foo->new(script_name => '%####$')->name_module('foo') } && $@, "Bad script_name");
104 ok(! eval { $app->morph_package } && $@, "Can't get a good morph_package");
105 ok($app->morph_package('foo') eq 'CGI::Ex::App::Foo', "Got a good morph_package");
106 ok($app->morph_package('foo_bar') eq 'CGI::Ex::App::FooBar', "Got a good morph_package");
108 ok(ref($app->path), "Got a good path");
109 ok(@{ $app->path } == 0, "Got a good path");
110 ok($app->default_step eq 'main', "Got a good default_step");
111 ok($app->login_step eq '__login', "Got a good login_step");
112 ok($app->error_step eq '__error', "Got a good error_step");
113 ok($app->forbidden_step eq '__forbidden', "Got a good forbidden_step");
114 ok($app->js_step eq 'js', "Got a good js_step");
116 ###----------------------------------------------------------------###
117 ###----------------------------------------------------------------###
118 ###----------------------------------------------------------------###
119 ###----------------------------------------------------------------###
120 print "### Test basic step selection/form input/validation/filling/template swapping methods ###\n";
122 #$ENV{'REQUEST_METHOD'} = 'GET';
123 #$ENV{'QUERY_STRING'} = '';
128 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo");
136 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2");
138 ###----------------------------------------------------------------###
143 sub pre_navigate { 1 }
146 ok($Foo::test_stdout eq "", "Got the right output for Foo2_1");
148 Foo2_1->new({_no_pre_navigate => 1})->navigate;
149 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_1");
157 ok($Foo::test_stdout eq "", "Got the right output for Foo2_2");
165 ok($Foo::test_stdout eq "", "Got the right output for Foo2_3");
170 sub post_navigate { $Foo::test_stdout .= " post"; 1 }
173 ok($Foo::test_stdout eq "Main Content post", "Got the right output for Foo2_4");
175 Foo2_4->new({_no_post_navigate => 1})->navigate;
176 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_4");
178 ###----------------------------------------------------------------###
180 local $ENV{'REQUEST_METHOD'} = 'POST';
181 #$ENV{'QUERY_STRING'} = 'step=step2';
184 form => {step => 'step2'},
186 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");
189 form => {step => 'step4'},
191 ok($Foo::test_stdout =~ /Some step4 content.*wow is required.*<script>/s, "Got the right output for Foo (step4)");
196 sub main_info_complete { 1 }
198 eval { Foo3->navigate };
199 ok($Foo::test_stdout =~ /recurse_limit \(15\)/, "Got the right output for Foo3");
201 eval { Foo3->new({recurse_limit => 10})->navigate };
202 ok($Foo::test_stdout =~ /recurse_limit \(10\)/, "Got the right output for Foo3");
204 ###----------------------------------------------------------------###
206 #$ENV{'REQUEST_METHOD'} = 'GET';
207 #$ENV{'QUERY_STRING'} = 'step=step2&wow=something';
210 form=> {step => 'step2', wow => 'something'},
212 ok($Foo::test_stdout eq "All good", "Got the right output for Foo");
214 ###----------------------------------------------------------------###
216 #$ENV{'REQUEST_METHOD'} = 'GET';
217 #$ENV{'QUERY_STRING'} = 'step=step2&wow=something';
220 form=> {step => '_bling'},
222 ok($Foo::test_stdout =~ /Denied/i, "Got the right output for Foo");
227 sub path { shift->{'path'} ||= ['3foo'] }
229 Foo4->new({form => {}})->navigate;
230 ok($Foo::test_stdout =~ /Denied/i, "Got the right output for Foo4");
232 ###----------------------------------------------------------------###
234 #$ENV{'REQUEST_METHOD'} = 'GET';
235 #$ENV{'QUERY_STRING'} = '';
236 local $ENV{'PATH_INFO'} = '/step2';
241 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
244 path_info_map_base => [],
246 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
249 path_info_map_base => [[qr{(?!)}, 'foo']],
251 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
254 path_info_map_base => {},
256 ok($Foo::test_stdout eq "", "Got the right output for Foo");
259 path_info_map_base => [{}],
261 ok($Foo::test_stdout eq "", "Got the right output for Foo");
266 sub path_info_map_base {}
269 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo5");
271 local $ENV{'PATH_INFO'} = '/blah';
274 path_info_map_base => [],
275 main_path_info_map => {},
277 ok($Foo::test_stdout =~ /fatal error.+path_info_map/, "Got the right output for Foo");
280 path_info_map_base => [],
281 main_path_info_map => [{}],
283 ok($Foo::test_stdout =~ /fatal error.+path_info_map/, "Got the right output for Foo");
285 ###----------------------------------------------------------------###
287 #$ENV{'REQUEST_METHOD'} = 'GET';
288 #$ENV{'QUERY_STRING'} = 'wow=something';
289 local $ENV{'PATH_INFO'} = '/step2';
292 form=> {wow => 'something'},
294 ok($Foo::test_stdout eq "All good", "Got the right output");
295 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
297 ###----------------------------------------------------------------###
299 #$ENV{'REQUEST_METHOD'} = 'GET';
300 #$ENV{'QUERY_STRING'} = '';
301 local $ENV{'PATH_INFO'} = '/step2/something';
306 ok($Foo::test_stdout eq "All good", "Got the right output");
307 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
308 ok($f->form->{'wow'} eq 'something', "Got the right variable set in form");
310 ###----------------------------------------------------------------###
312 local $ENV{'PATH_INFO'} = '';
317 sub valid_steps { {step2 => 1} }
318 sub js_run_step { $Foo::test_stdout = 'JS' }
321 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo6");
323 Foo6->new({form => {step => 'main'}})->navigate;
324 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo6");
326 Foo6->new({form => {step => 'step3'}})->navigate;
327 ok($Foo::test_stdout =~ /denied/i, "Got the right output for Foo6");
329 Foo6->new({form => {step => 'step2'}})->navigate;
330 ok($Foo::test_stdout =~ /step2/i, "Got the right output for Foo6");
332 Foo6->new({form => {step => Foo6->new->js_step}})->navigate;
333 ok($Foo::test_stdout eq 'JS', "Got the right output for Foo6");
337 ###----------------------------------------------------------------###
338 ###----------------------------------------------------------------###
339 ###----------------------------------------------------------------###
340 ###----------------------------------------------------------------###
341 print "### Test Authorization Methods ###\n";
343 local $ENV{'PATH_INFO'} = '';
344 local $ENV{'SCRIPT_NAME'} = '/foo';
350 ok($Foo::test_stdout eq "Login Form", "Got the right output");
354 cookies => {user => 'foo/123qwe'},
357 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
361 cookies => {user => 'foo/123qwe'},
362 })->check_valid_auth, "Ran check_valid_auth");
364 my $cva = Foo->new({form => {}, cookies => {user => 'foo/123qwe'}});
365 ok($cva->check_valid_auth && $cva->check_valid_auth, "Can run twice");
371 })->check_valid_auth, "Ran check_valid_auth");
375 auth_data => {user => 'foo'},
378 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo ($Foo::test_stdout)");
380 ###----------------------------------------------------------------###
384 })->navigate_authenticated;
385 ok($Foo::test_stdout eq "Login Form", "Got the right output");
387 ###----------------------------------------------------------------###
392 sub require_auth { 1 }
398 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar");
400 ###----------------------------------------------------------------###
405 sub require_auth { 1 }
408 my $ok = eval { Bar1->new({
410 })->navigate_authenticated; 1 }; # can't call navigate_authenticated with overwritten require_auth
411 ok(! $ok, "Got the right output for Bar1");
413 ###----------------------------------------------------------------###
418 sub main_require_auth { 1 }
424 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2");
426 ###----------------------------------------------------------------###
431 sub require_auth { 1 }
432 sub main_require_auth { 0 }
438 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar3");
440 ###----------------------------------------------------------------###
444 require_auth => {main => 0},
446 ok($Foo::test_stdout eq "Main Content", "Got the right output");
448 ###----------------------------------------------------------------###
452 require_auth => {main => 1},
454 ok($Foo::test_stdout eq "Login Form", "Got the right output");
456 ###----------------------------------------------------------------###
461 sub pre_navigate { shift->require_auth(0); 0 }
466 })->navigate_authenticated;
467 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4");
469 ###----------------------------------------------------------------###
474 sub pre_navigate { shift->require_auth(1); 0 }
480 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)");
482 ###----------------------------------------------------------------###
487 sub pre_navigate { shift->require_auth({main => 1}); 0 }
493 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)");
495 ###----------------------------------------------------------------###
496 ###----------------------------------------------------------------###
497 ###----------------------------------------------------------------###
498 ###----------------------------------------------------------------###
499 print "### Test Configuration methods ###\n";
504 sub name_module { my $self = shift; defined($self->{'name_module'}) ? $self->{'name_module'} : 'conf_1' }
507 my $file = Conf1->new->conf_file;
508 ok($file && $file eq 'conf_1.pl', "Got a conf_file ($file)");
510 ok(! eval { Conf1->new(name_module => '')->conf_file } && $@, "Couldn't get conf_file");
512 $file = Conf1->new({ext_conf => 'ini'})->conf_file;
513 ok($file && $file eq 'conf_1.ini', "Got a conf_file ($file)");
519 ok($err, "Got an error");
521 ok($Foo::test_stdout eq "", "Got the right output for Conf1");
526 form => {step => 'step3'},
529 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
533 conf_file => {form => {step => 'step3'}},
535 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
539 conf_file => {form => {step => 'step3'}},
540 conf_validation => {form => {required => 1}},
542 ok($Foo::test_stdout eq "All good", "Got the right output for Conf1");
547 conf_validation => {form => {required => 1}},
549 ok($Foo::test_stdout eq "" && $@, "Got a conf_validation error");
551 ###----------------------------------------------------------------###
552 ###----------------------------------------------------------------###
553 ###----------------------------------------------------------------###
554 ###----------------------------------------------------------------###
555 print "### Various other coverage tests\n";
557 ok(Conf1->new->conf_obj, "Got a conf_obj");
558 ok(Conf1->new(conf_args => {paths => './', directive => 'merge'})->conf_obj, "Got a conf_obj");
559 ok(Conf1->new->val_obj, "Got a val_obj");
560 ok(Conf1->new(val_args => {cgix => Conf1->new->cgix})->val_obj, "Got a val_obj");
561 ok(Conf1->new->load_conf(1), "Ran load_conf");
563 ok(Foo2->navigate->clear_app, "clear_app works");
565 my $dh = Foo2->navigate;
566 push @{ $dh->history }, "A string", ['A non ref'], {key => 'No elapsed key'};
567 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 2, response => {}};
568 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 2, response => {hi => 'there'}};
569 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => []};
570 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => ['hi']};
571 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => 'a'};
572 push @{ $dh->history }, {step => 'foo', meth => 'bar', found => 'bar', elapsed => 1, response => 'a'x100};
573 ok($dh->dump_history, "Can call dump_history");
574 ok($dh->dump_history('all'), "Can call dump_history");
575 $dh->{'history_max'} = 10;
576 ok($dh->dump_history('all'), "Can call dump_history");
587 sub find_hook { my ($self, $hook, $step) = @_; return $self->SUPER::find_hook($hook, $step) if $step eq 'main'; return ["non_code",1] }
589 Foo7->new({no_history => 1})->navigate;
590 ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo7 ($Foo::test_stdout)");
592 ok( eval { Foo->new->run_hook('hash_base', 'main') }, "Can run_hook main hash_base on Foo");
593 ok(! eval { Foo->new->run_hook('bogus', 'main') }, "Can't run_hook main bogus on Foo");
594 ok(! eval { Foo7->new->run_hook('hash_base', 'bogus') }, "Can't run_hook bogus hash_base on Foo7 for other reasons");
596 foreach my $meth (qw(auth_args conf_args template_args val_args)) {
597 ok(! CGI::Ex::App->new->$meth, "Got a good $meth");
598 ok(CGI::Ex::App->new($meth => {a=>'A'})->$meth->{'a'} eq 'A', "Got a good $meth");
602 foreach my $meth (qw(charset
622 ok(CGI::Ex::App->new($meth => 'blah')->$meth eq 'blah', "I can set $meth");
626 foreach my $meth (qw(base_dir_abs
637 ok(CGI::Ex::App->new($meth => 'blah')->$meth eq 'blah', "I can set $meth");
638 my $c = CGI::Ex::App->new;
640 ok($c->$meth eq 'blah', "I can set $meth");
643 foreach my $type (qw(base
650 my $meth = "hash_$type";
651 ok(CGI::Ex::App->new("hash_$type" => {bing => 'bang'})->$meth->{'bing'} eq 'bang', "Can initialize $meth")
654 my $meth2 = "add_to_$type";
655 my $c = CGI::Ex::App->new;
656 $c->$meth2({bing => 'bang'});
657 $c->$meth2(bong => 'beng');
659 if ($type eq 'errors') {
660 $c->$meth2({bing => "wow"});
661 ok($c->$meth->{"bing_error"} eq "bang<br>wow", "$meth2 works");
662 ok($c->$meth->{"bong_error"} eq 'beng', "$meth2 works");
664 ok($c->has_errors, "has_errors works") if $type eq 'errors';
666 ok($c->$meth->{'bing'} eq 'bang', "$meth2 works");
667 ok($c->$meth->{'bong'} eq 'beng', "$meth2 works");
671 ok(! eval { CGI::Ex::App->new->get_pass_by_user } && $@, "Got a good error for get_pass_by_user");
672 ok(! eval { CGI::Ex::App->new->find_hook } && $@, "Got a good error for find_hook");
674 ###----------------------------------------------------------------###
675 print "### Some morph tests ###\n";
681 sub blah1_pre_step { $Foo::test_stdout = 'blah1_pre'; 1 }
683 sub blah3_info_complete { 1 }
684 sub blah3_post_step { $Foo::test_stdout = 'blah3_post'; 1 }
686 sub blah4_prepare { 0 }
687 sub blah4_file_print { \ 'blah4_file_print' }
689 sub blah5_finalize { 0 }
690 sub blah5_info_complete { 1 }
691 sub blah5_file_print { \ 'blah5_file_print' }
693 sub blah8_morph_package { 'Foo8' }
694 sub blah8_info_complete { 0 }
695 sub blah8_file_print { \ 'blah8_file_print' }
697 sub blah6_allow_morph { 1 }
700 sub info_complete { 0 }
701 sub file_print { \ 'blah6_file_print' }
702 sub early_exit_run_step { $Foo::test_stdout = 'early'; shift->exit_nav_loop }
704 sub blah7_allow_morph { 1 }
705 package Foo8::Blah6::Blah7;
706 our @ISA = qw(Foo8::Blah6);
707 sub info_complete { 0 }
708 sub file_print { \ 'blah7_file_print' }
711 Foo8->new({form => {step => 'blah1'}})->navigate;
712 ok($Foo::test_stdout eq 'blah1_pre', "Got the right output for Foo8");
714 Foo8->new({form => {step => 'blah1'}, allow_morph => 1})->navigate;
715 ok($Foo::test_stdout eq 'blah1_pre', "Got the right output for Foo8");
717 Foo8->new({form => {step => 'blah2'}})->navigate;
718 ok($Foo::test_stdout eq 'Main Content', "Got the right output for Foo8");
720 Foo8->new({form => {step => 'blah3'}})->navigate;
721 ok($Foo::test_stdout eq 'blah3_post', "Got the right output for Foo8");
723 Foo8->new({form => {step => 'blah4'}})->navigate;
724 ok($Foo::test_stdout eq 'blah4_file_print', "Got the right output for Foo8");
726 Foo8->new({form => {step => 'blah5'}})->navigate;
727 ok($Foo::test_stdout eq 'blah5_file_print', "Got the right output for Foo8");
729 Foo8->new({form => {step => 'blah5'}, allow_morph => 1})->navigate;
730 ok($Foo::test_stdout eq 'blah5_file_print', "Got the right output for Foo8");
732 Foo8->new({form => {step => 'blah5'}, allow_morph => 0})->navigate;
733 ok($Foo::test_stdout eq 'blah5_file_print', "Got the right output for Foo8");
735 Foo8->new({form => {step => 'blah5'}, allow_morph => {}})->navigate;
736 ok($Foo::test_stdout eq 'blah5_file_print', "Got the right output for Foo8");
738 Foo8->new({form => {step => 'blah5'}, allow_morph => {blah5 => 1}})->navigate;
739 ok($Foo::test_stdout eq 'blah5_file_print', "Got the right output for Foo8");
741 Foo8->new({form => {step => 'blah6'}})->navigate;
742 ok($Foo::test_stdout eq 'blah6_file_print', "Got the right output for Foo8");
744 Foo8->new({form => {step => 'blah8'}, allow_morph => 1})->navigate;
745 ok($Foo::test_stdout eq 'blah8_file_print', "Got the right output for Foo8 ($Foo::test_stdout)");
747 my $foo8 = Foo8->new({form => {step => 'blah7'}, allow_nested_morph => 1});
748 $foo8->morph('blah6');
750 ok($Foo::test_stdout eq 'blah7_file_print', "Got the right output for Foo8");
752 $foo8 = Foo8->new({form => {step => 'blah7'}, allow_nested_morph => {blah7 => 1}});
753 $foo8->morph('blah6');
755 ok($Foo::test_stdout eq 'blah7_file_print', "Got the right output for Foo8");
757 $foo8 = Foo8->new({form => {step => 'blah7'}, allow_nested_morph => {blah9 => 1}});
758 $foo8->morph('blah6');
760 ok($Foo::test_stdout eq 'blah6_file_print', "Got the right output for Foo8");
762 $foo8 = Foo8->new({form => {step => 'blah7'}, allow_nested_morph => 0});
763 $foo8->morph('blah6');
765 ok($Foo::test_stdout eq 'blah6_file_print', "Got the right output for Foo8");
767 $foo8 = Foo8->new({form => {step => 'early_exit'}, no_history => 1});
768 $foo8->morph('blah6');
770 ok($Foo::test_stdout eq 'early', "Got the right output for Foo8");
771 ok(ref($foo8) eq 'Foo8::Blah6', 'Still is unmorphed right');
775 ok(ref($foo8) eq 'Foo8', 'Got the right class');
776 $foo8->morph('blah6');
777 eval { $foo8->exit_nav_loop }; # coverage
778 ok($@, "Got the die from exit_nav_loop");
780 ###----------------------------------------------------------------###
781 print "### Some path tests tests ###\n";
788 my $str = "First(".$self->first_step.") Previous(".$self->previous_step.") Current(".$self->current_step.") Next(".$self->next_step.") Last(".$self->last_step.")";
793 sub info_complete { 0 }
794 sub invalid_run_step { shift->jump('::') }
796 ok(Foo9->new->previous_step eq '', 'No previous step if not navigating');
798 my $c = Foo9->new(form => {step => 'one'});
799 $c->add_to_path('three', 'four', 'five');
800 $c->insert_path('one', 'two');
802 ok($Foo::test_stdout eq 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
803 ok(! eval { $c->set_path("more") }, "Can't call set_path after nav started");
805 $c = Foo9->new(form => {step => 'five'});
806 $c->set_path('one', 'two', 'three', 'four', 'five');
808 ok($Foo::test_stdout eq 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
811 $c->append_path('one');
812 eval { $c->jump('FIRST') };
813 ok($Foo::test_stdout eq '', "Can't jump without nav_loop");
815 eval { Foo9->new(form => {step => 'invalid'})->navigate };
816 ok($Foo::test_stdout =~ /fatal.*invalid jump index/si, "Can't jump with invalid step");
818 ###----------------------------------------------------------------###
826 my $s = join "", @{ $self->path };
827 substr($s, $self->{'path_i'}, 0, '(');
828 substr($s, $self->{'path_i'} + 2, 0, ')');
833 # my ($self, $hook, $step) = @_;
834 # print "Into $step: ".$self->join_path."\n" if $hook eq 'run_step';
835 # return $self->SUPER::run_hook($hook, $step);
840 if ($self->join_path eq '(a)') {
841 $self->append_path('b', 'c', 'd', 'e');
842 $self->jump('CURRENT');
843 } elsif ($self->join_path eq 'a(a)bcde') {
845 } elsif ($self->join_path eq 'aab(a)bcde') {
847 } elsif ($self->join_path eq 'aabab(a)ababcde') {
849 } elsif ($self->join_path eq 'aababacd(a)ababacde') {
852 die "Shouldn't get here";
858 if ($self->join_path eq 'aa(b)cde') {
859 $self->jump('PREVIOUS');
860 } elsif ($self->join_path eq 'aaba(b)cde') {
863 die "Shouldn't get here";
869 sub d_run_step { shift->jump('FIRST') }
873 $self->replace_path(); # truncate
877 sub default_step { 'z' }
881 sub __error_run_step { 1 }
884 my $Foo10 = Foo10->new(form => {step => 'a'});
886 ok($Foo10->join_path eq 'aababacdae(z)', 'Followed good path: '.$Foo10->join_path);
888 ###----------------------------------------------------------------###
894 sub step1_next_step { 'step6' }
895 sub step6_file_print { \ 'step6_file_print' }
896 sub step2_name_step { '' }
897 sub step3_name_step { 'foo.htm' }
900 our @ISA = qw(Foo11);
904 local $ENV{'SCRIPT_NAME'} = '/cgi/ralph.pl';
905 ok(Foo11->new->file_print("george") eq 'ralph/george.html', 'file_print: '. Foo11->new->file_print("george"));
906 ok(Foo11->new->file_val("george") =~ m|\Q/ralph/george.val\E|, 'file_val: '. Foo11->new->file_val("george"));
907 ok(ref(Foo12->new->file_val("george")) eq 'HASH', 'file_val: no such path');
908 ok(Foo11->new(val_path => '../' )->file_val("george") eq '../ralph/george.val', 'file_val');
909 ok(Foo11->new(val_path => sub {'../'} )->file_val("george") eq '../ralph/george.val', 'file_val');
910 ok(Foo11->new(val_path => ['../'] )->file_val("george") eq '../ralph/george.val', 'file_val');
911 ok(Foo11->new(val_path => ['../', './'])->file_val("george") eq '../ralph/george.val', 'file_val');
913 ok(! eval { Foo11->new->file_print("step2") } && $@, 'Bad name_step');
914 ok(! eval { Foo11->new->file_val("step2") } && $@, 'Bad name_step');
916 ok(Foo11->new->file_print("step3") eq 'ralph/foo.htm', 'file_print: '. Foo11->new->file_print("step3"));
917 ok(Foo11->new->file_val("step3") =~ m|\Q/ralph/foo.val\E|, 'file_val: '. Foo11->new->file_val("step3"));
920 local $ENV{'REQUEST_METHOD'} = 'POST';
922 Foo11->new(form => {step => 'step1'})->navigate;
923 ok($Foo::test_stdout eq 'step6_file_print', "Refine Path and set_ready_validate work ($Foo::test_stdout)");
926 $f->set_ready_validate(1);
927 ok($f->ready_validate, "Is ready to validate");
928 $f->set_ready_validate(0);
929 ok(! $f->ready_validate, "Not ready to validate");
930 $f->set_ready_validate(1);
931 ok($f->ready_validate, "Is ready to validate");
932 $f->set_ready_validate('somestep', 0);
933 ok(! $f->ready_validate, "Not ready to validate");
935 ###----------------------------------------------------------------###
940 sub step0_ready_validate { 1 }
941 sub step0_hash_validation { {foo => {required => 1}} }
943 sub step1_ready_validate { 1 }
944 sub step1_form_name { shift->{'step1_form_name'} }
945 sub step1_hash_validation { shift->{'step1_hash_validation'} }
946 sub step1_file_print { \ 'step1_file_print [% has_errors %]' }
949 ok(Foo13->new(ext_val => 'html')->navigate->js_validation('step0') eq '', 'Got right validation');
950 ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13 ($Foo::test_stdout)");
952 Foo13->new(form => {step => 'step1'})->navigate->js_validation('step1');
953 ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13");
955 ok(Foo13->new->js_validation('step1') eq '', "No validation found");
956 ok(Foo13->new->js_validation('step1', 'foo') eq '', "No validation found");
957 ok(Foo13->new->js_validation('step1', 'foo', {}) eq '', "No validation found");
958 ok(Foo13->new->js_validation('step1', 'foo', {foo => {required => 1}}), "Validation found");
960 ###----------------------------------------------------------------###
964 sub new { bless {}, __PACKAGE__ }
967 my ($self, $file) = @_;
968 $Foo::test_stdout = "Print JS: $file";
970 sub print_content_type {
972 my $mime = shift || 'text/html';
973 my $char = shift || '';
974 $mime .= "; charset=$char" if $char && $char =~ m|^[\w\-\.\:\+]+$|;
975 $Foo::test_stdout = "Print: $mime";
979 CGI::Ex::App->new(cgix => CGIX->new)->js_run_step;
980 ok($Foo::test_stdout eq 'Print JS: ', "Ran js_run_step: $Foo::test_stdout");
982 CGI::Ex::App->new(cgix => CGIX->new, form => {js => 'CGI/Ex/validate.js'})->js_run_step;
983 ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
985 CGI::Ex::App->new(cgix => CGIX->new, path_info => '/js/CGI/Ex/validate.js')->js_run_step;
986 ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
988 CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', "# the output\n");
989 ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
990 CGI::Ex::App->new(cgix => CGIX->new, mimetype => 'img/gif')->print_out('foo', "# the output\n");
991 ok($Foo::test_stdout eq 'Print: img/gif', "Got right header: $Foo::test_stdout");
992 CGI::Ex::App->new(cgix => CGIX->new, charset => 'ISO-foo')->print_out('foo', "# the output\n");
993 ok($Foo::test_stdout eq 'Print: text/html; charset=ISO-foo', "Got right header: $Foo::test_stdout");
995 CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', \ "# the output\n");
996 ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
998 ###----------------------------------------------------------------###\