Dogcows Code - chaz/p5-CGI-Ex/blob - t/4_app_00_base.t

   1 # -*- Mode: Perl; -*-
   2
   3 =head1 NAME
   4
   5 4_app_00_base.t - Check for the basic functionality of CGI::Ex::App.
   6
   7 =head1 NOTE
   8
   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.
  13
  14 =cut
  15
  16 use Test::More tests => 20;
  17 use strict;
  18
  19 {
  20     package Foo;
  21
  22     use base qw(CGI::Ex::App);
  23     use vars qw($test_stdout);
  24
  25     sub init { $test_stdout = '' }
  26
  27     sub ready_validate { 1 }
  28
  29     sub print_out {
  30         my $self = shift;
  31         my $step = shift;
  32         my $str  = shift;
  33         $test_stdout = ref($str) ? $$str : $str;
  34     }
  35
  36     sub swap_template {
  37         my ($self, $step, $file, $swap) = @_;
  38         my $out = ref($file) ? $$file : "No filenames allowed during test mode";
  39         $self->cgix->swap_template(\$out, $swap);
  40         return $out;
  41     }
  42
  43     sub auth_args { {login_template => \q{Login Form}} }
  44
  45     ###----------------------------------------------------------------###
  46
  47     sub main_info_complete { 0 }
  48
  49     sub main_file_print { return \ "Main Content" }
  50
  51     sub step2_hash_validation { return {wow => {required => 1, required_error => 'wow is required'}} }
  52
  53     sub step2_path_info_map { [[qr{^/step2/(\w+)$}x, 'wow']] }
  54
  55     sub step2_file_print { return \ "Some step2 content ([% foo %], [% one %]) <input type=text name=wow>[% wow_error %]" }
  56
  57     sub step2_hash_swap { return {foo => 'bar', one => 'two'} }
  58
  59     sub step2_hash_fill { return {wow => 'wee'} }
  60
  61     sub step2_finalize { shift->append_path('step3') }
  62
  63     sub step3_info_complete { 0 }
  64
  65     sub step3_file_print { return \ "All good" }
  66 }
  67
  68 ###----------------------------------------------------------------###
  69
  70 #$ENV{'REQUEST_METHOD'} = 'GET';
  71 #$ENV{'QUERY_STRING'}   = '';
  72
  73 Foo->new({
  74     form => {},
  75 })->navigate;
  76 ok($Foo::test_stdout eq "Main Content", "Got the right output");
  77
  78 ###----------------------------------------------------------------###
  79
  80 #$ENV{'REQUEST_METHOD'} = 'GET';
  81 #$ENV{'QUERY_STRING'}   = 'step=step2';
  82
  83 Foo->new({
  84     form => {step => 'step2'},
  85 })->navigate;
  86 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
  87
  88 ###----------------------------------------------------------------###
  89
  90 #$ENV{'REQUEST_METHOD'} = 'GET';
  91 #$ENV{'QUERY_STRING'}   = 'step=step2&wow=something';
  92
  93 Foo->new({
  94     form=> {step => 'step2', wow => 'something'},
  95 })->navigate;
  96 ok($Foo::test_stdout eq "All good", "Got the right output");
  97
  98 ###----------------------------------------------------------------###
  99
 100 #$ENV{'REQUEST_METHOD'} = 'GET';
 101 #$ENV{'QUERY_STRING'}   = '';
 102 local $ENV{'PATH_INFO'} = '/step2';
 103
 104 Foo->new({
 105     form=> {},
 106 })->navigate;
 107 ok($Foo::test_stdout eq "Some step2 content (bar, two) <input type=text name=wow value=\"wee\">wow is required", "Got the right output");
 108
 109 ###----------------------------------------------------------------###
 110
 111 #$ENV{'REQUEST_METHOD'} = 'GET';
 112 #$ENV{'QUERY_STRING'}   = 'wow=something';
 113 local $ENV{'PATH_INFO'} = '/step2';
 114
 115 my $f = Foo->new({
 116     form=> {wow => 'something'},
 117 })->navigate;
 118 ok($Foo::test_stdout eq "All good", "Got the right output");
 119 ok($f->form->{'step'} eq 'step2', "Got the right variable set in form");
 120
 121 ###----------------------------------------------------------------###
 122
 123 #$ENV{'REQUEST_METHOD'} = 'GET';
 124 #$ENV{'QUERY_STRING'}   = '';
 125 local $ENV{'PATH_INFO'} = '/step2/something';
 126
 127 $f = Foo->new({
 128     form => {},
 129 })->navigate;
 130 ok($Foo::test_stdout eq "All good", "Got the right output");
 131 ok($f->form->{'step'} eq 'step2',     "Got the right variable set in form");
 132 ok($f->form->{'wow'}  eq 'something', "Got the right variable set in form");
 133
 134 ###----------------------------------------------------------------###
 135
 136 local $ENV{'PATH_INFO'}   = '';
 137 local $ENV{'SCRIPT_NAME'} = '';
 138
 139 Foo->new({
 140     form => {},
 141     require_auth => 1,
 142 })->navigate;
 143 ok($Foo::test_stdout eq "Login Form", "Got the right output");
 144
 145 ###----------------------------------------------------------------###
 146
 147 Foo->new({
 148     form => {},
 149 })->navigate_authenticated;
 150 ok($Foo::test_stdout eq "Login Form", "Got the right output");
 151
 152 ###----------------------------------------------------------------###
 153
 154 {
 155     package Bar;
 156     @Bar::ISA = qw(Foo);
 157     sub require_auth { 1 }
 158 }
 159
 160 Bar->new({
 161     form => {},
 162 })->navigate;
 163 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar");
 164
 165 ###----------------------------------------------------------------###
 166
 167 {
 168     package Bar1;
 169     @Bar1::ISA = qw(Foo);
 170     sub require_auth { 1 }
 171 }
 172
 173 my $ok = eval { Bar1->new({
 174     form => {},
 175 })->navigate_authenticated; 1 }; # can't call navigate_authenticated with overwritten require_auth
 176 ok(! $ok, "Got the right output for Bar1");
 177
 178 ###----------------------------------------------------------------###
 179
 180 {
 181     package Bar2;
 182     @Bar2::ISA = qw(Foo);
 183     sub main_require_auth { 1 }
 184 }
 185
 186 Bar2->new({
 187     form => {},
 188 })->navigate;
 189 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2");
 190
 191 ###----------------------------------------------------------------###
 192
 193 {
 194     package Bar3;
 195     @Bar3::ISA = qw(Foo);
 196     sub require_auth { 1 }
 197     sub main_require_auth { 0 }
 198 }
 199
 200 Bar3->new({
 201     form => {},
 202 })->navigate;
 203 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar3");
 204
 205 ###----------------------------------------------------------------###
 206
 207 Foo->new({
 208     form => {},
 209     require_auth => {main => 0},
 210 })->navigate;
 211 ok($Foo::test_stdout eq "Main Content", "Got the right output");
 212
 213 ###----------------------------------------------------------------###
 214
 215 Foo->new({
 216     form => {},
 217     require_auth => {main => 1},
 218 })->navigate;
 219 ok($Foo::test_stdout eq "Login Form", "Got the right output");
 220
 221 ###----------------------------------------------------------------###
 222
 223 {
 224     package Bar4;
 225     @Bar4::ISA = qw(Foo);
 226     sub pre_navigate { shift->require_auth(0); 0 }
 227 }
 228
 229 Bar4->new({
 230     form => {},
 231 })->navigate_authenticated;
 232 ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4");
 233
 234 ###----------------------------------------------------------------###
 235
 236 {
 237     package Bar5;
 238     @Bar5::ISA = qw(Foo);
 239     sub pre_navigate { shift->require_auth(1); 0 }
 240 }
 241
 242 Bar5->new({
 243     form => {},
 244 })->navigate;
 245 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)");
 246
 247 ###----------------------------------------------------------------###
 248
 249 {
 250     package Bar6;
 251     @Bar6::ISA = qw(Foo);
 252     sub pre_navigate { shift->require_auth({main => 1}); 0 }
 253 }
 254
 255 Bar6->new({
 256     form => {},
 257 })->navigate;
 258 ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)");