5 0_ex_00_base.t - Testing of the base CGI::Ex module.
9 use vars qw($test_stdout @ISA);
11 use Test::More tests => 73;
13 sub TIEHANDLE { bless [], __PACKAGE__ }
16 $test_stdout = join("", @_);
21 my $cgix = CGI::Ex->new;
22 ok($cgix, "Got object");
24 ### test out form and cookies from the CGI object
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';
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");
40 my $cookies = $cgix->cookies;
41 ok($cookies, "Got cookies");
42 ok($cookies->{'bar'} eq 'baz', "Found correct bar");
46 my $form = {foo => 'bar', mult => [qw(a b c)]};
48 $cgix->cookies($form);
51 ok($form->{'foo'} eq 'bar', "Could set form");
53 my $cookies = $cgix->cookies;
54 ok($cookies->{'foo'} eq 'bar', "Could set form");
56 ### try print_content_type
57 if (eval { require Tie::Handle }) {
58 local @ISA = qw(Tie::Handle);
59 my $old_out = select STDOUT;
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"],
72 local $ENV{'MOD_PERL'} = 0;
73 local $ENV{'CONTENT_TYPED'} = 0;
74 my ($args, $answer) = @$_;
78 tie *STDOUT, __PACKAGE__;
79 CGI::Ex::print_content_type(@$args);
84 (my $ans = $answer) =~ s/\s+$//;
85 if ($test_stdout eq $answer) {
86 ok(1, "(@$args) => $ans");
88 ok(0, "(@$args) => $ans");
89 print "#($test_stdout)\n";
96 skip("Can't test print_content_type", 10);
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");
105 $str = $cgix->make_form($form, ['foo']);
106 ok($str eq 'foo=bar', "Make form works with keys");
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(
125 ok($cgix->can($meth), "Has method $meth");
128 ### try out time_calc
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)");
138 ###----------------------------------------------------------------###
140 my $html = "<input type=text name=foo value=''>";
141 $form = {foo => 'bar'};
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");
147 $cgix->fill(text => \$html, form => $form);
148 ok($html =~ /value=([\"\'])bar\1/, "Filled $html");
150 $html = "<form name=foo><input type=text name=baz value=''></form><form name=bar><input type=password name=bim value=''></form>";
152 $form = {baz => 'bing', bim => 'bang'};
154 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'foo');
155 ok($out =~ /bing/, "Got bing");
156 ok($out !~ /bang/, "Didn't get bang");
158 $out = $cgix->fill(scalarref => \$html, form => $form, target => 'bar');
159 ok($out =~ /bang/, "Got bang");
160 ok($out !~ /bing/, "Didn't get bing");
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");
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");
170 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 1);
171 ok($out =~ /bing/, "Got bing");
172 ok($out =~ /bang/, "Got bang");
174 $out = $cgix->fill(scalarref => \$html, form => $form, fill_password => undef);
175 ok($out =~ /bing/, "Got bing");
176 ok($out =~ /bang/, "Got bang");
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");
182 ###----------------------------------------------------------------###
184 $form = {foo => 'bar'};
185 my $val = {foo => {'required' => 1}};
187 my $e = $cgix->validate($form, $val);
188 ok(! $e, "No error");
191 $e = $cgix->validate($form, $val);
193 ok("$e" =~ /required/i, "Had error message ($e)");
195 ###----------------------------------------------------------------###
197 ### defer testing to the conf test modules
198 foreach my $meth (qw(
202 ok($cgix->can($meth), "Has method $meth");
205 ###----------------------------------------------------------------###
207 $form = {foo => 'bar'};
208 my $args = {VARIABLES => {bim => 'bam'}};
209 my $temp = "([% foo %])([% bim %])";
211 $out = $cgix->swap_template($temp, $form, $args);
212 ok($out =~ /bar/, "Got bar");
213 ok($out =~ /bam/, "Got bam");
215 $cgix->swap_template(\$temp, $form, $args);
216 ok($temp =~ /bar/, "Got bar");
217 ok($temp =~ /bam/, "Got bam");
219 ###----------------------------------------------------------------###