+print "#-----------------------------------------\n";
+print "### Some morph tests ###\n";
+
+{
+ package Foo8;
+ our @ISA = qw(Foo);
+
+ sub blah1_pre_step { $Foo::test_stdout = 'blah1_pre'; 1 }
+ sub blah2_skip { 1 }
+ sub blah3_info_complete { 1 }
+ sub blah3_post_step { $Foo::test_stdout = 'blah3_post'; 1 }
+
+ sub blah4_prepare { 0 }
+ sub blah4_file_print { \ 'blah4_file_print' }
+
+ sub blah5_finalize { 0 }
+ sub blah5_info_complete { 1 }
+ sub blah5_file_print { \ 'blah5_file_print' }
+
+ sub blah8_morph_package { 'Foo8' }
+ sub blah8_info_complete { 0 }
+ sub blah8_file_print { \ 'blah8_file_print' }
+
+ sub blah6_allow_morph { 1 }
+ package Foo8::Blah6;
+ our @ISA = qw(Foo8);
+ sub info_complete { 0 }
+ sub file_print { \ 'blah6_file_print' }
+ sub early_exit_run_step { $Foo::test_stdout = 'early'; shift->exit_nav_loop }
+
+ sub blah7_allow_morph { 1 }
+ package Foo8::Blah6::Blah7;
+ our @ISA = qw(Foo8::Blah6);
+ sub info_complete { 0 }
+ sub file_print { \ 'blah7_file_print' }
+
+ package Foo8::Blah9;
+ our @ISA = qw(Foo8);
+ sub info_complete { 0 }
+ sub file_print { \ 'blah9_file_print' }
+
+ package Foo8;
+ sub __error_allow_morph { 0 }
+ sub __error_file_print { \ '[% error_step %] - [% error %]' }
+ $INC{'Foo8/Blah10.pm'} = 'internal'; # fake require - not a real App package
+
+ package Foo8;
+ sub blah11_morph_package { 'Not::Exists::Blah11' }
+}
+
+Foo8->new({form => {step => 'blah1'}})->navigate;
+is($Foo::test_stdout, 'blah1_pre', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah1'}, allow_morph => 1})->navigate;
+is($Foo::test_stdout, 'blah1_pre', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah2'}})->navigate;
+is($Foo::test_stdout, 'Main Content', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah3'}})->navigate;
+is($Foo::test_stdout, 'blah3_post', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah4'}})->navigate;
+is($Foo::test_stdout, 'blah4_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah5'}})->navigate;
+is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah5'}, allow_morph => 1})->navigate;
+is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah5'}, allow_morph => 0})->navigate;
+is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah5'}, allow_morph => {}})->navigate;
+is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah5'}, allow_morph => {blah5 => 1}})->navigate;
+is($Foo::test_stdout, 'blah5_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah6'}})->navigate;
+is($Foo::test_stdout, 'blah6_file_print', "Got the right output for Foo8");
+
+Foo8->new({form => {step => 'blah8'}, allow_morph => 1})->navigate;
+is($Foo::test_stdout, 'blah8_file_print', "Got the right output for Foo8 ($Foo::test_stdout)");
+
+my $foo8 = Foo8->new({form => {step => 'blah7'}});
+$foo8->morph('blah6');
+$foo8->navigate;
+is($Foo::test_stdout, 'blah7_file_print', "Got the right output for Foo8");
+
+$foo8 = Foo8->new({form => {step => 'early_exit'}, no_history => 1});
+$foo8->morph('blah6');
+$foo8->navigate;
+ok($Foo::test_stdout eq 'early', "Got the right output for Foo8");
+is(ref($foo8), 'Foo8::Blah6', 'Still is unmorphed right');
+
+$foo8 = Foo8->new;
+$foo8->morph;
+ok(ref($foo8) eq 'Foo8', 'Got the right class');
+$foo8->morph('blah6');
+eval { $foo8->exit_nav_loop }; # coverage
+ok($@, "Got the die from exit_nav_loop");
+
+Foo8->new({form => {step => 'blah9'}, allow_morph => 2})->navigate;
+is($Foo::test_stdout, 'blah9_file_print', "Got the right output for Foo8::Blah9 ($Foo::test_stdout)");
+
+$foo8 = Foo8->new({form => {step => 'blah10'}, allow_morph => 2});
+eval { $foo8->navigate };
+#use CGI::Ex::Dump qw(debug);
+#debug $foo8->dump_history;
+ok($Foo::test_stdout =~ /^blah10 -/, "Got the right output for Foo8::Blah10");
+ok($Foo::test_stdout =~ m|Found package Foo8::Blah10|, "Got the right output for Foo8::Blah10") || diag $Foo::test_stdout;
+
+$foo8 = Foo8->new({form => {step => 'blah11'}, allow_morph => 2});
+eval { $foo8->navigate };
+#use CGI::Ex::Dump qw(debug);
+#debug $foo8->dump_history;
+ok($Foo::test_stdout =~ /^blah11 -/, "Got the right output for Foo8::Blah11");
+ok($Foo::test_stdout =~ m|Not/Exists/Blah11.pm.*\@INC|, "Got the right output for Foo8::Blah11") || diag $Foo::test_stdout;
+
+
+$foo8 = Foo8->new;
+$foo8->run_hook('morph', 'blah6', 1);
+is(ref($foo8), 'Foo8::Blah6', "Right package");
+
+$foo8->run_hook_as('run_step', 'blah7', 'Foo8::Blah6::Blah7');
+is($Foo::test_stdout, 'blah7_file_print', "Got the right output for Foo8::Blah6::Blah7");
+is(ref($foo8), 'Foo8::Blah6', "Right package");
+
+$foo8->run_hook_as('run_step', 'main', 'Foo8');
+is($Foo::test_stdout, 'Main Content', "Got the right output for Foo8");
+is(ref($foo8), 'Foo8::Blah6', "Right package");
+
+$foo8->run_hook_as('run_step', 'blah6', 'Foo8::Blah6');
+is($Foo::test_stdout, 'blah6_file_print', "Got the right output for Foo8::Blah6");
+$foo8->run_hook('unmorph', 'blah6');
+#use CGI::Ex::Dump qw(debug);
+#debug $foo8->dump_history;
+
+
+
+{
+ package Baz;
+ our @ISA = qw(Foo);
+ sub default_step { 'bazmain' }
+ sub info_complete { 0 }
+ sub file_print { my ($self, $step) = @_; return \qq{\u$step Content} }
+ sub allow_morph { 1 }
+
+ package Baz::Bstep1;
+ our @ISA = qw(Baz);
+
+ package Baz::Bstep2;
+ our @ISA = qw(Baz);
+ sub hash_swap { shift->goto_step('bstep3') } # hijack it here
+
+ package Baz::Bstep3;
+ our @ISA = qw(Baz);
+}
+
+Baz->navigate;
+is($Foo::test_stdout, 'Bazmain Content', "Got the right output for Foo8::Blah6");
+Baz->navigate({form => {step => 'bstep1'}});
+is($Foo::test_stdout, 'Bstep1 Content', "Got the right output for Foo8::Blah6");
+
+my $baz = Baz->new({form => {step => 'bstep2'}});
+eval { $baz->navigate };
+is($Foo::test_stdout, 'Bstep3 Content', "Got the right output for Foo8::Blah6");
+is(ref($baz), 'Baz', "And back to the correct object type");
+#debug $baz->dump_history;
+
+###----------------------------------------------------------------###
+print "#-----------------------------------------\n";
+print "### Some path tests ###\n";
+
+{
+ package Foo9;
+ our @ISA = qw(Foo);
+ sub file_print {
+ my $self = shift;
+ my $str = "First(".$self->first_step.") Previous(".$self->previous_step.") Current(".$self->current_step.") Next(".$self->next_step.") Last(".$self->last_step.")";
+ return \$str;
+ }
+ sub one_skip { 1 }
+ sub two_skip { 1 }
+ sub info_complete { 0 }
+ sub invalid_run_step { shift->goto_step('::') }
+}
+ok(Foo9->new->previous_step eq '', 'No previous step if not navigating');
+
+my $c = Foo9->new(form => {step => 'one'});
+$c->add_to_path('three', 'four', 'five');
+$c->insert_path('one', 'two');
+$c->navigate;
+is($Foo::test_stdout, 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
+ok(! eval { $c->set_path("more") }, "Can't call set_path after nav started");
+
+$c = Foo9->new(form => {step => 'five'});
+$c->set_path('one', 'two', 'three', 'four', 'five');
+$c->navigate;
+is($Foo::test_stdout, 'First(one) Previous(two) Current(three) Next(four) Last(five)', "Got the right content for Foo9");
+
+$c = Foo9->new;
+$c->append_path('one');
+eval { $c->goto_step('FIRST') };
+is($Foo::test_stdout, 'Main Content', "Can jump without nav_loop started");
+
+$c = Foo9->new;
+$c->set_path('one');
+eval { $c->goto_step('main') };
+is($Foo::test_stdout, 'Main Content', "Can jump to step not on the path");
+
+###----------------------------------------------------------------###
+
+{
+ package Foo10;
+ our @ISA = qw(Foo);
+
+ sub join_path {
+ my $self = shift;
+ my $s = join "", @{ $self->path };
+ substr($s, $self->{'path_i'}, 0, '(');
+ substr($s, $self->{'path_i'} + 2, 0, ')');
+ return $s;
+ }
+
+ #sub run_hook {
+ # my ($self, $hook, $step) = @_;
+ # print "Into $step: ".$self->join_path."\n" if $hook eq 'run_step';
+ # return $self->SUPER::run_hook($hook, $step);
+ #}
+
+ sub a_run_step {
+ my $self = shift;
+ if ($self->join_path eq '(a)') {
+ $self->append_path('b', 'c', 'd', 'e');
+ $self->jump('CURRENT');
+ } elsif ($self->join_path eq 'a(a)bcde') {
+ $self->jump('NEXT');
+ } elsif ($self->join_path eq 'aab(a)bcde') {
+ $self->jump(1);
+ } elsif ($self->join_path eq 'aabab(a)ababcde') {
+ $self->jump('c');
+ } elsif ($self->join_path eq 'aababacd(a)ababacde') {
+ $self->jump('LAST');
+ } else {
+ die "Shouldn't get here";
+ }
+ }
+
+ sub b_run_step {
+ my $self = shift;
+ if ($self->join_path eq 'aa(b)cde') {
+ $self->jump('PREVIOUS');
+ } elsif ($self->join_path eq 'aaba(b)cde') {
+ $self->jump(-10);
+ } else {
+ die "Shouldn't get here";
+ }
+ }
+
+ sub c_run_step { 0 }
+
+ sub d_run_step { shift->jump('FIRST') }
+
+ sub e_run_step {
+ my $self = shift;
+ $self->replace_path(); # truncate
+ $self->jump(1);
+ }
+
+ sub default_step { 'z' }
+
+ sub z_run_step { 1 }
+
+ sub __error_run_step { 1 }
+}
+
+my $Foo10 = Foo10->new(form => {step => 'a'});
+$Foo10->navigate;
+is($Foo10->join_path, 'aababacdae(z)', 'Followed good path');
+
+###----------------------------------------------------------------###
+print "#-----------------------------------------\n";
+print "### Integrated validation tests ###\n";
+
+{
+ package Foo11;
+ our @ISA = qw(Foo);
+ sub step1_skip { 1 }
+ sub step1_next_step { 'step6' }
+ sub step6_file_print { \ 'step6_file_print' }
+ sub step2_name_step { '' }
+ sub step3_name_step { 'foo.htm' }
+
+ package Foo12;
+ our @ISA = qw(Foo11);
+ sub val_path { '' }
+}
+
+local $ENV{'SCRIPT_NAME'} = '/cgi/ralph.pl';
+ok(Foo11->new->file_print("george") eq 'ralph/george.html', 'file_print: '. Foo11->new->file_print("george"));
+ok(Foo11->new->file_val("george") =~ m|\Q/ralph/george.val\E|, 'file_val: '. Foo11->new->file_val("george"));
+ok(ref(Foo12->new->file_val("george")) eq 'HASH', 'file_val: no such path');
+ok(Foo11->new(val_path => '../' )->file_val("george") eq '../ralph/george.val', 'file_val');
+ok(Foo11->new(val_path => sub {'../'} )->file_val("george") eq '../ralph/george.val', 'file_val');
+ok(Foo11->new(val_path => ['../'] )->file_val("george") eq '../ralph/george.val', 'file_val');
+ok(Foo11->new(val_path => ['../', './'])->file_val("george") eq '../ralph/george.val', 'file_val');
+
+ok(! eval { Foo11->new->file_print("step2") } && $@, 'Bad name_step');
+ok(! eval { Foo11->new->file_val("step2") } && $@, 'Bad name_step');
+
+ok(Foo11->new->file_print("step3") eq 'ralph/foo.htm', 'file_print: '. Foo11->new->file_print("step3"));
+ok(Foo11->new->file_val("step3") =~ m|\Q/ralph/foo.val\E|, 'file_val: '. Foo11->new->file_val("step3"));
+
+
+local $ENV{'REQUEST_METHOD'} = 'POST';
+
+Foo11->new(form => {step => 'step1'})->navigate;
+ok($Foo::test_stdout eq 'step6_file_print', "Refine Path and set_ready_validate work ($Foo::test_stdout)");
+
+$f = Foo11->new;
+$f->set_ready_validate(1);
+ok($f->ready_validate, "Is ready to validate");
+$f->set_ready_validate(0);
+ok(! $f->ready_validate, "Not ready to validate");
+$f->set_ready_validate(1);
+ok($f->ready_validate, "Is ready to validate");
+$f->set_ready_validate('somestep', 0);
+ok(! $f->ready_validate, "Not ready to validate");
+
+###----------------------------------------------------------------###
+
+{
+ package Foo13;
+ our @ISA = qw(Foo);
+ sub step0_ready_validate { 1 }
+ sub step0_hash_validation { {foo => {required => 1}} }
+
+ sub step1_ready_validate { 1 }
+ sub step1_form_name { shift->{'step1_form_name'} }
+ sub step1_hash_validation { shift->{'step1_hash_validation'} }
+ sub step1_file_print { \ 'step1_file_print [% has_errors %]' }
+}
+
+ok(Foo13->new(ext_val => 'html')->navigate, 'Ran Foo13');
+ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13 ($Foo::test_stdout)");
+
+Foo13->new(form => {step => 'step1'})->navigate->js_validation('step1');
+ok($Foo::test_stdout eq 'Main Content', "Got the right content on Foo13");
+
+ok(Foo13->new->js_validation('step1') eq '', "No validation found");
+ok(Foo13->new->js_validation('step1', 'foo') eq '', "No validation found");
+ok(Foo13->new->js_validation('step1', 'foo', {}) eq '', "No validation found");
+ok(Foo13->new->js_validation('step1', 'foo', {foo => {required => 1}}), "Validation found");
+
+###----------------------------------------------------------------###
+print "#-----------------------------------------\n";
+print "### Header tests ###\n";
+
+{
+ package CGIX;
+ sub new { bless {}, __PACKAGE__ }
+ sub get_form { {} }
+ sub print_js {
+ my ($self, $file) = @_;
+ $Foo::test_stdout = "Print JS: $file";
+ }
+ sub print_content_type {
+ my $self = shift;
+ my $mime = shift || 'text/html';
+ my $char = shift || '';
+ $mime .= "; charset=$char" if $char && $char =~ m|^[\w\-\.\:\+]+$|;
+ $Foo::test_stdout = "Print: $mime";
+ }
+}
+
+CGI::Ex::App->new(cgix => CGIX->new)->js_run_step;
+ok($Foo::test_stdout eq 'Print JS: ', "Ran js_run_step: $Foo::test_stdout");
+
+CGI::Ex::App->new(cgix => CGIX->new, form => {js => 'CGI/Ex/validate.js'})->js_run_step;
+ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
+
+CGI::Ex::App->new(cgix => CGIX->new, path_info => '/js/CGI/Ex/validate.js')->js_run_step;
+ok($Foo::test_stdout eq 'Print JS: CGI/Ex/validate.js', "Ran js_run_step: $Foo::test_stdout");
+
+CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', "# the output\n");
+ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
+CGI::Ex::App->new(cgix => CGIX->new, mimetype => 'img/gif')->print_out('foo', "# the output\n");
+ok($Foo::test_stdout eq 'Print: img/gif', "Got right header: $Foo::test_stdout");
+CGI::Ex::App->new(cgix => CGIX->new, charset => 'ISO-foo')->print_out('foo', "# the output\n");
+ok($Foo::test_stdout eq 'Print: text/html; charset=ISO-foo', "Got right header: $Foo::test_stdout");
+
+CGI::Ex::App->new(cgix => CGIX->new)->print_out('foo', \ "# the output\n");
+ok($Foo::test_stdout eq 'Print: text/html', "Got right header: $Foo::test_stdout");
+
+###----------------------------------------------------------------###\
+print "#-----------------------------------------\n";