Dogcows Code - chaz/p5-CGI-Ex/blob - t/0_ex_00_base.t

   1 # -*- Mode: Perl; -*-
   2
   3 =head1 NAME
   4
   5 0_ex_00_base.t - Testing of the base CGI::Ex module.
   6
   7 =cut
   8
   9 use vars qw($test_stdout @ISA);
  10 use strict;
  11 use Test::More tests => 73;
  12
  13 sub TIEHANDLE { bless [], __PACKAGE__ }
  14 sub PRINT {
  15     my $self = shift;
  16     $test_stdout = join("", @_);
  17 }
  18
  19 use_ok('CGI::Ex');
  20
  21 my $cgix = CGI::Ex->new;
  22 ok($cgix, "Got object");
  23
  24 ### test out form and cookies from the CGI object
  25 SKIP: {
  26     skip("CGI.pm not found", 9) if ! eval { require CGI };
  27     local $ENV{'REQUEST_METHOD'} = 'GET';
  28     local $ENV{'QUERY_STRING'}   = 'foo=bar&foo=baz&us=them';
  29     local $ENV{'HTTP_COOKIE'}    = 'bar=baz; bing=blam';
  30
  31     my $form = $cgix->form;
  32     ok($form, "Got form");
  33     ok(ref($form) eq 'HASH', "Good form");
  34     ok($form->{'foo'}, "Found foo");
  35     ok(ref($form->{'foo'}) eq 'ARRAY', "Foo is array");
  36     ok(@{ $form->{'foo'} } == 2, "Correct number");
  37     ok($form->{'us'}, "Found us");
  38     ok($form->{'us'} eq 'them', "Us is correct");
  39
  40     my $cookies = $cgix->cookies;
  41     ok($cookies, "Got cookies");
  42     ok($cookies->{'bar'} eq 'baz', "Found correct bar");
  43 };
  44
  45 ### set a new form
  46 my $form = {foo => 'bar', mult => [qw(a b c)]};
  47 $cgix->form($form);
  48 $cgix->cookies($form);
  49
  50 $form = $cgix->form;
  51 ok($form->{'foo'} eq 'bar', "Could set form");
  52
  53 my $cookies = $cgix->cookies;
  54 ok($cookies->{'foo'} eq 'bar', "Could set form");
  55
  56 ### try print_content_type
  57 if (eval { require Tie::Handle }) {
  58     local @ISA = qw(Tie::Handle);
  59     my $old_out = select STDOUT;
  60
  61     foreach ([[]                             => "Content-Type: text/html\r\n\r\n"],
  62              [['text/html']                  => "Content-Type: text/html\r\n\r\n"],
  63              [['text/html', '']              => "Content-Type: text/html\r\n\r\n"],
  64              [['image/gif']                  => "Content-Type: image/gif\r\n\r\n"],
  65              [['text/html', 'utf-8'],        => "Content-Type: text/html; charset=utf-8\r\n\r\n"],
  66              [[$cgix, ]                      => "Content-Type: text/html\r\n\r\n"],
  67              [[$cgix, 'text/html']           => "Content-Type: text/html\r\n\r\n"],
  68              [[$cgix, 'text/html', '']       => "Content-Type: text/html\r\n\r\n"],
  69              [[$cgix, 'image/gif']           => "Content-Type: image/gif\r\n\r\n"],
  70              [[$cgix, 'text/html', 'utf-8'], => "Content-Type: text/html; charset=utf-8\r\n\r\n"],
  71              ) {
  72         local $ENV{'MOD_PERL'}      = 0;
  73         local $ENV{'CONTENT_TYPED'} = 0;
  74         my ($args, $answer) = @$_;
  75
  76         LOCAL: {
  77             local *STDOUT;
  78             tie *STDOUT, __PACKAGE__;
  79             CGI::Ex::print_content_type(@$args);
  80         };
  81
  82         select $old_out;
  83
  84         (my $ans = $answer) =~ s/\s+$//;
  85         if ($test_stdout eq $answer) {
  86             ok(1, "(@$args) => $ans");
  87         } else {
  88             ok(0, "(@$args) => $ans");
  89             print "#($test_stdout)\n";
  90         }
  91     }
  92
  93     select $old_out;
  94 } else {
  95   SKIP: {
  96       skip("Can't test print_content_type", 10);
  97   };
  98 }
  99
 100 ### try out make_form
 101 my $str = $cgix->make_form($form);
 102 ok($str =~ /foo=bar/, "Make form works");
 103 ok($str =~ /mult=a&mult=b&mult=c/, "Make form works 2");
 104
 105 $str = $cgix->make_form($form, ['foo']);
 106 ok($str eq 'foo=bar', "Make form works with keys");
 107
 108 ### can't test these without being in apache (well we could test STDOUT - but that is for another day - TODO)
 109 foreach my $meth (qw(
 110                      apache_request
 111                      content_typed
 112                      expires
 113                      is_mod_perl_1
 114                      is_mod_perl_2
 115                      last_modified
 116                      location_bounce
 117                      mod_perl_version
 118                      print_content_type
 119                      print_js
 120                      send_status
 121                      send_header
 122                      set_apache_request
 123                      set_cookie
 124                      )) {
 125     ok($cgix->can($meth), "Has method $meth");
 126 }
 127
 128 ### try out time_calc
 129 my $sec;
 130 ok(($sec = CGI::Ex::time_calc('1m'))    == time + 60, "Time_calc ($sec)");
 131 ok(($sec = CGI::Ex::time_calc('-1m'))   == time - 60, "Time_calc ($sec)");
 132 ok(($sec = CGI::Ex::time_calc('1 m'))   == time + 60, "Time_calc ($sec)");
 133 ok(($sec = CGI::Ex::time_calc('1 min')) == time + 60, "Time_calc ($sec)");
 134 ok(($sec = CGI::Ex::time_calc('1'))     == 1, "Time_calc ($sec)");
 135 ok(($sec = CGI::Ex::time_calc('now'))   == time, "Time_calc ($sec)");
 136 ok(($sec = CGI::Ex::time_calc(__FILE__)), "Time_calc ($sec)");
 137
 138 ###----------------------------------------------------------------###
 139
 140 my $html = "<input type=text name=foo value=''>";
 141 $form = {foo => 'bar'};
 142 my $out;
 143
 144 ok(($out = $cgix->fill(scalarref => \$html,  form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
 145 ok(($out = $cgix->fill(arrayref  => [$html], form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
 146
 147 $cgix->fill(text => \$html, form => $form);
 148 ok($html =~ /value=([\"\'])bar\1/, "Filled $html");
 149
 150 $html = "<form name=foo><input type=text name=baz value=''></form><form name=bar><input type=password name=bim value=''></form>";
 151
 152 $form = {baz => 'bing', bim => 'bang'};
 153
 154 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'foo');
 155 ok($out =~ /bing/, "Got bing");
 156 ok($out !~ /bang/, "Didn't get bang");
 157
 158 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'bar');
 159 ok($out =~ /bang/, "Got bang");
 160 ok($out !~ /bing/, "Didn't get bing");
 161
 162 $out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['baz']);
 163 ok($out =~ /bang/, "Got bang");
 164 ok($out !~ /bing/, "Didn't get bing");
 165
 166 $out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['bim']);
 167 ok($out =~ /bing/, "Got bing");
 168 ok($out !~ /bang/, "Didn't get bang");
 169
 170 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 1);
 171 ok($out =~ /bing/, "Got bing");
 172 ok($out =~ /bang/, "Got bang");
 173
 174 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => undef);
 175 ok($out =~ /bing/, "Got bing");
 176 ok($out =~ /bang/, "Got bang");
 177
 178 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 0);
 179 ok($out =~ /bing/, "Got bing");
 180 ok($out !~ /bang/, "Didn't get bang");
 181
 182 ###----------------------------------------------------------------###
 183
 184 $form = {foo => 'bar'};
 185 my $val = {foo => {'required' => 1}};
 186
 187 my $e = $cgix->validate($form, $val);
 188 ok(! $e, "No error");
 189
 190 $form = {};
 191 $e = $cgix->validate($form, $val);
 192 ok($e, "Got error");
 193 ok("$e" =~ /required/i, "Had error message ($e)");
 194
 195 ###----------------------------------------------------------------###
 196
 197 ### defer testing to the conf test modules
 198 foreach my $meth (qw(
 199                      conf_obj
 200                      conf_read
 201                      )) {
 202     ok($cgix->can($meth), "Has method $meth");
 203 }
 204
 205 ###----------------------------------------------------------------###
 206
 207 $form = {foo => 'bar'};
 208 my $args = {VARIABLES => {bim => 'bam'}};
 209 my $temp = "([% foo %])([% bim %])";
 210
 211 $out = $cgix->swap_template($temp, $form, $args);
 212 ok($out =~ /bar/, "Got bar");
 213 ok($out =~ /bam/, "Got bam");
 214
 215 $cgix->swap_template(\$temp, $form, $args);
 216 ok($temp =~ /bar/, "Got bar");
 217 ok($temp =~ /bam/, "Got bam");
 218
 219 ###----------------------------------------------------------------###