X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=t%2F4_app_00_base.t;h=5d86acaeaa245e2e14bb367572c93cc6e3e54095;hb=febed4ec71f803b083c3e61b82b9464e9bfb0992;hp=ec223d8e48d132cce4903e3c5ec641ef7bc584c9;hpb=419d9570723c210429e2be23875160f57dd36156;p=chaz%2Fp5-CGI-Ex diff --git a/t/4_app_00_base.t b/t/4_app_00_base.t index ec223d8..5d86aca 100644 --- a/t/4_app_00_base.t +++ b/t/4_app_00_base.t @@ -13,8 +13,10 @@ we do try to put it through most paces. =cut -use Test::More tests => 20; +use Test::More tests => 234; use strict; +use warnings; +use CGI::Ex::Dump qw(debug); { package Foo; @@ -24,8 +26,6 @@ use strict; sub init { $test_stdout = '' } - sub ready_validate { 1 } - sub print_out { my $self = shift; my $step = shift; @@ -35,18 +35,21 @@ use strict; 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; + die "No filenames allowed during test mode" if ! ref($file); + return $self->SUPER::swap_template($step, $file, $swap); } - sub auth_args { {login_template => \q{Login Form}} } + sub auth_args { {login_template => \q{Login Form}, key_user => 'user', key_pass => 'pass', key_cookie => 'user', set_cookie => sub {}} } + + sub get_pass_by_user { '123qwe' } ###----------------------------------------------------------------### sub main_info_complete { 0 } - sub main_file_print { return \ "Main Content" } + sub main_file_print { return \ "Main Content [%~ extra %]" } + + sub main_path_info_map { shift->{'main_path_info_map'} } sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} } @@ -62,10 +65,69 @@ use strict; sub step3_info_complete { 0 } - sub step3_file_print { return \ "All good" } + sub step3_file_print { return \ "All good [%~ extra %]" } + + sub step4_file_val { return {wow => {required => 1, required_error => 'wow is required'}} } + + sub step4_path_info_map { [[qr{^/step4/(\w+)$}x, 'wow']] } + + sub step4_file_print { return \ "Some step4 content ([% foo %], [% one %])
[% wow_error %]
[% js_validation %]" } + + sub step4_hash_swap { return {foo => 'bar', one => 'two'} } + + sub step4_hash_fill { return {wow => 'wee'} } + + sub step4_finalize { shift->append_path('step3') } + + sub step5__part_a_file_print { return \ "Step 5 Nested ([% step %])" } + + sub step5__part_a_info_complete { 0 } + } ###----------------------------------------------------------------### +###----------------------------------------------------------------### +print "#-----------------------------------------\n"; +print "### Test some basic returns ###\n"; + +ok(! eval { CGI::Ex::App::new() }, "Invalid new"); +ok(! eval { CGI::Ex::App::new(0) }, "Invalid new"); + +my $app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar'}); +ok($app->script_name eq '/cgi-bin/foo_bar', "Can pass in script_name"); +ok($app->name_module eq 'foo_bar', "Can pass in script_name"); + +$app = CGI::Ex::App->new({script_name => '/cgi-bin/foo_bar.pl'}); +ok($app->script_name eq '/cgi-bin/foo_bar.pl', "Can pass in script_name"); +ok($app->name_module eq 'foo_bar', "Can pass in script_name"); + +ok(Foo->new(name_module => 'foo')->name_module eq 'foo', "Got the name_module"); +ok(! eval { Foo->new(script_name => '%####$')->name_module } && $@, "Bad script_name"); +ok(! eval { Foo->new(script_name => '%####$')->name_module('foo') } && $@, "Bad script_name"); + +ok(! eval { $app->morph_package } && $@, "Can't get a good morph_package"); +ok($app->morph_package('foo') eq 'CGI::Ex::App::Foo', "Got a good morph_package"); +ok($app->morph_package('foo_bar') eq 'CGI::Ex::App::FooBar', "Got a good morph_package"); + +ok(ref($app->path), "Got a good path"); +ok(@{ $app->path } == 0, "Got a good path"); +is($app->default_step, 'main', "Got a good default_step"); +is($app->login_step, '__login', "Got a good login_step"); +is($app->error_step, '__error', "Got a good error_step"); +is($app->forbidden_step, '__forbidden', "Got a good forbidden_step"); +is($app->js_step, 'js', "Got a good js_step"); + +# check for different step types +is($app->run_hook('file_print', '__leading_underbars'), 'foo_bar/__leading_underbars.html', 'file_print - __ is preserved at beginning of step'); +is($app->run_hook('file_print', 'central__underbars'), 'foo_bar/central/underbars.html', 'file_print - __ is used in middle of step'); +my $ref = ref($app); +is($app->run_hook('morph_package', '__leading_underbars'), "${ref}::LeadingUnderbars", 'morph_package - __ is works at beginning of step'); +is($app->run_hook('morph_package', 'central__underbars'), "${ref}::Central::Underbars", 'morph_package - __ is used in middle of step'); + +###----------------------------------------------------------------### +###----------------------------------------------------------------### +print "#-----------------------------------------\n"; +print "### Test basic step selection/form input/validation/filling/template swapping methods ###\n"; #$ENV{'REQUEST_METHOD'} = 'GET'; #$ENV{'QUERY_STRING'} = ''; @@ -73,17 +135,93 @@ use strict; Foo->new({ form => {}, })->navigate; -ok($Foo::test_stdout eq "Main Content", "Got the right output"); +ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo"); + +{ + package Foo2; + our @ISA = qw(Foo); + sub form { {} } +} +Foo2->navigate; +ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2"); ###----------------------------------------------------------------### -#$ENV{'REQUEST_METHOD'} = 'GET'; +{ + package Foo2_1; + our @ISA = qw(Foo); + sub pre_navigate { 1 } +} +Foo2_1->navigate; +ok($Foo::test_stdout eq "", "Got the right output for Foo2_1"); + +Foo2_1->new({_no_pre_navigate => 1})->navigate; +ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_1"); + +{ + package Foo2_2; + our @ISA = qw(Foo); + sub pre_loop { 1 } +} +Foo2_2->navigate; +ok($Foo::test_stdout eq "", "Got the right output for Foo2_2"); + +{ + package Foo2_3; + our @ISA = qw(Foo); + sub post_loop { 1 } +} +Foo2_3->navigate; +ok($Foo::test_stdout eq "", "Got the right output for Foo2_3"); + +{ + package Foo2_4; + our @ISA = qw(Foo); + sub post_navigate { $Foo::test_stdout .= " post"; 1 } +} +Foo2_4->navigate; +ok($Foo::test_stdout eq "Main Content post", "Got the right output for Foo2_4"); + +Foo2_4->new({_no_post_navigate => 1})->navigate; +ok($Foo::test_stdout eq "Main Content", "Got the right output for Foo2_4"); + +my $f; + +###----------------------------------------------------------------### + +local $ENV{'REQUEST_METHOD'} = 'POST'; #$ENV{'QUERY_STRING'} = 'step=step2'; Foo->new({ form => {step => 'step2'}, })->navigate; -ok($Foo::test_stdout eq "Some step2 content (bar, two) wow is required", "Got the right output"); +ok($Foo::test_stdout eq "Some step2 content (bar, two) wow is required", "Got the right output for Foo"); + +Foo->new({ + form => {step => 'step4'}, +})->navigate; +ok($Foo::test_stdout =~ /Some step4 content.*wow is required.*