X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=t%2F4_app_00_base.t;fp=t%2F4_app_00_base.t;h=3fe81be023eeb197188882a1a375ea1bb3392351;hp=78148d5f815f87ec295565ce3c4a434df4075662;hb=18123183bfb2737ea337306c9d705fca5b5e50d6;hpb=b6e904ff7b346908d0662aae9a9c5f7d976dd85e diff --git a/t/4_app_00_base.t b/t/4_app_00_base.t index 78148d5..3fe81be 100644 --- a/t/4_app_00_base.t +++ b/t/4_app_00_base.t @@ -13,8 +13,9 @@ we do try to put it through most paces. =cut -use Test::More tests => 25; +use Test::More tests => 214; use strict; +use warnings; { package Foo; @@ -24,8 +25,6 @@ use strict; sub init { $test_stdout = '' } - sub ready_validate { 1 } - sub print_out { my $self = shift; my $step = shift; @@ -35,12 +34,13 @@ 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' } ###----------------------------------------------------------------### @@ -48,6 +48,8 @@ use strict; sub main_file_print { return \ "Main Content" } + sub main_path_info_map { shift->{'main_path_info_map'} } + sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} } sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] } @@ -63,9 +65,59 @@ use strict; sub step3_info_complete { 0 } sub step3_file_print { return \ "All good" } + + 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') } + } ###----------------------------------------------------------------### +###----------------------------------------------------------------### +###----------------------------------------------------------------### +###----------------------------------------------------------------### +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"); +ok($app->default_step eq 'main', "Got a good default_step"); +ok($app->login_step eq '__login', "Got a good login_step"); +ok($app->error_step eq '__error', "Got a good error_step"); +ok($app->forbidden_step eq '__forbidden', "Got a good forbidden_step"); +ok($app->js_step eq 'js', "Got a good js_step"); + +###----------------------------------------------------------------### +###----------------------------------------------------------------### +###----------------------------------------------------------------### +###----------------------------------------------------------------### +print "### Test basic step selection/form input/validation/filling/template swapping methods ###\n"; #$ENV{'REQUEST_METHOD'} = 'GET'; #$ENV{'QUERY_STRING'} = ''; @@ -73,17 +125,81 @@ 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"); + +###----------------------------------------------------------------### + +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.*