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 strict;
  10 use Test::More tests => 63;
  11
  12 use_ok('CGI::Ex');
  13
  14 my $cgix = CGI::Ex->new;
  15 ok($cgix, "Got object");
  16
  17 ### test out form and cookies from the CGI object
  18 SKIP: {
  19     skip("CGI.pm not found", 9) if ! eval { require CGI };
  20     local $ENV{'REQUEST_METHOD'} = 'GET';
  21     local $ENV{'QUERY_STRING'}   = 'foo=bar&foo=baz&us=them';
  22     local $ENV{'HTTP_COOKIE'}    = 'bar=baz; bing=blam';
  23
  24     my $form = $cgix->form;
  25     ok($form, "Got form");
  26     ok(ref($form) eq 'HASH', "Good form");
  27     ok($form->{'foo'}, "Found foo");
  28     ok(ref($form->{'foo'}) eq 'ARRAY', "Foo is array");
  29     ok(@{ $form->{'foo'} } == 2, "Correct number");
  30     ok($form->{'us'}, "Found us");
  31     ok($form->{'us'} eq 'them', "Us is correct");
  32
  33     my $cookies = $cgix->cookies;
  34     ok($cookies, "Got cookies");
  35     ok($cookies->{'bar'} eq 'baz', "Found correct bar");
  36 };
  37
  38 ### set a new form
  39 my $form = {foo => 'bar', mult => [qw(a b c)]};
  40 $cgix->form($form);
  41 $cgix->cookies($form);
  42
  43 $form = $cgix->form;
  44 ok($form->{'foo'} eq 'bar', "Could set form");
  45
  46 my $cookies = $cgix->cookies;
  47 ok($cookies->{'foo'} eq 'bar', "Could set form");
  48
  49
  50 ### try out make_form
  51 my $str = $cgix->make_form($form);
  52 ok($str =~ /foo=bar/, "Make form works");
  53 ok($str =~ /mult=a&mult=b&mult=c/, "Make form works 2");
  54
  55 $str = $cgix->make_form($form, ['foo']);
  56 ok($str eq 'foo=bar', "Make form works with keys");
  57
  58 ### can't test these without being in apache (well we could test STDOUT - but that is for another day - TODO)
  59 foreach my $meth (qw(
  60                      apache_request
  61                      content_typed
  62                      expires
  63                      is_mod_perl_1
  64                      is_mod_perl_2
  65                      last_modified
  66                      location_bounce
  67                      mod_perl_version
  68                      print_content_type
  69                      print_js
  70                      send_status
  71                      send_header
  72                      set_apache_request
  73                      set_cookie
  74                      )) {
  75     ok($cgix->can($meth), "Has method $meth");
  76 }
  77
  78 ### try out time_calc
  79 my $sec;
  80 ok(($sec = CGI::Ex::time_calc('1m'))    == time + 60, "Time_calc ($sec)");
  81 ok(($sec = CGI::Ex::time_calc('-1m'))   == time - 60, "Time_calc ($sec)");
  82 ok(($sec = CGI::Ex::time_calc('1 m'))   == time + 60, "Time_calc ($sec)");
  83 ok(($sec = CGI::Ex::time_calc('1 min')) == time + 60, "Time_calc ($sec)");
  84 ok(($sec = CGI::Ex::time_calc('1'))     == 1, "Time_calc ($sec)");
  85 ok(($sec = CGI::Ex::time_calc('now'))   == time, "Time_calc ($sec)");
  86 ok(($sec = CGI::Ex::time_calc(__FILE__)), "Time_calc ($sec)");
  87
  88 ###----------------------------------------------------------------###
  89
  90 my $html = "<input type=text name=foo value=''>";
  91 $form = {foo => 'bar'};
  92 my $out;
  93
  94 ok(($out = $cgix->fill(scalarref => \$html,  form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
  95 ok(($out = $cgix->fill(arrayref  => [$html], form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
  96
  97 $cgix->fill(text => \$html, form => $form);
  98 ok($html =~ /value=([\"\'])bar\1/, "Filled $html");
  99
 100 $html = "<form name=foo><input type=text name=baz value=''></form><form name=bar><input type=password name=bim value=''></form>";
 101
 102 $form = {baz => 'bing', bim => 'bang'};
 103
 104 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'foo');
 105 ok($out =~ /bing/, "Got bing");
 106 ok($out !~ /bang/, "Didn't get bang");
 107
 108 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'bar');
 109 ok($out =~ /bang/, "Got bang");
 110 ok($out !~ /bing/, "Didn't get bing");
 111
 112 $out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['baz']);
 113 ok($out =~ /bang/, "Got bang");
 114 ok($out !~ /bing/, "Didn't get bing");
 115
 116 $out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['bim']);
 117 ok($out =~ /bing/, "Got bing");
 118 ok($out !~ /bang/, "Didn't get bang");
 119
 120 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 1);
 121 ok($out =~ /bing/, "Got bing");
 122 ok($out =~ /bang/, "Got bang");
 123
 124 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => undef);
 125 ok($out =~ /bing/, "Got bing");
 126 ok($out =~ /bang/, "Got bang");
 127
 128 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 0);
 129 ok($out =~ /bing/, "Got bing");
 130 ok($out !~ /bang/, "Didn't get bang");
 131
 132 ###----------------------------------------------------------------###
 133
 134 $form = {foo => 'bar'};
 135 my $val = {foo => {'required' => 1}};
 136
 137 my $e = $cgix->validate($form, $val);
 138 ok(! $e, "No error");
 139
 140 $form = {};
 141 $e = $cgix->validate($form, $val);
 142 ok($e, "Got error");
 143 ok("$e" =~ /required/i, "Had error message ($e)");
 144
 145 ###----------------------------------------------------------------###
 146
 147 ### defer testing to the conf test modules
 148 foreach my $meth (qw(
 149                      conf_obj
 150                      conf_read
 151                      )) {
 152     ok($cgix->can($meth), "Has method $meth");
 153 }
 154
 155 ###----------------------------------------------------------------###
 156
 157 $form = {foo => 'bar'};
 158 my $args = {VARIABLES => {bim => 'bam'}};
 159 my $temp = "([% foo %])([% bim %])";
 160
 161 $out = $cgix->swap_template($temp, $form, $args);
 162 ok($out =~ /bar/, "Got bar");
 163 ok($out =~ /bam/, "Got bam");
 164
 165 $cgix->swap_template(\$temp, $form, $args);
 166 ok($temp =~ /bar/, "Got bar");
 167 ok($temp =~ /bam/, "Got bam");
 168
 169 ###----------------------------------------------------------------###