# -*- Mode: Perl; -*-
=head1 NAME
0_ex_00_base.t - Testing of the base CGI::Ex module.
=cut
use vars qw($test_stdout @ISA);
use strict;
use Test::More tests => 73;
sub TIEHANDLE { bless [], __PACKAGE__ }
sub PRINT {
my $self = shift;
$test_stdout = join("", @_);
}
use_ok('CGI::Ex');
my $cgix = CGI::Ex->new;
ok($cgix, "Got object");
### test out form and cookies from the CGI object
SKIP: {
skip("CGI.pm not found", 9) if ! eval { require CGI };
local $ENV{'REQUEST_METHOD'} = 'GET';
local $ENV{'QUERY_STRING'} = 'foo=bar&foo=baz&us=them';
local $ENV{'HTTP_COOKIE'} = 'bar=baz; bing=blam';
my $form = $cgix->form;
ok($form, "Got form");
ok(ref($form) eq 'HASH', "Good form");
ok($form->{'foo'}, "Found foo");
ok(ref($form->{'foo'}) eq 'ARRAY', "Foo is array");
ok(@{ $form->{'foo'} } == 2, "Correct number");
ok($form->{'us'}, "Found us");
ok($form->{'us'} eq 'them', "Us is correct");
my $cookies = $cgix->cookies;
ok($cookies, "Got cookies");
ok($cookies->{'bar'} eq 'baz', "Found correct bar");
};
### set a new form
my $form = {foo => 'bar', mult => [qw(a b c)]};
$cgix->form($form);
$cgix->cookies($form);
$form = $cgix->form;
ok($form->{'foo'} eq 'bar', "Could set form");
my $cookies = $cgix->cookies;
ok($cookies->{'foo'} eq 'bar', "Could set form");
### try print_content_type
if (eval { require Tie::Handle }) {
local @ISA = qw(Tie::Handle);
my $old_out = select STDOUT;
foreach ([[] => "Content-Type: text/html\r\n\r\n"],
[['text/html'] => "Content-Type: text/html\r\n\r\n"],
[['text/html', ''] => "Content-Type: text/html\r\n\r\n"],
[['image/gif'] => "Content-Type: image/gif\r\n\r\n"],
[['text/html', 'utf-8'], => "Content-Type: text/html; charset=utf-8\r\n\r\n"],
[[$cgix, ] => "Content-Type: text/html\r\n\r\n"],
[[$cgix, 'text/html'] => "Content-Type: text/html\r\n\r\n"],
[[$cgix, 'text/html', ''] => "Content-Type: text/html\r\n\r\n"],
[[$cgix, 'image/gif'] => "Content-Type: image/gif\r\n\r\n"],
[[$cgix, 'text/html', 'utf-8'], => "Content-Type: text/html; charset=utf-8\r\n\r\n"],
) {
local $ENV{'MOD_PERL'} = 0;
local $ENV{'CONTENT_TYPED'} = 0;
my ($args, $answer) = @$_;
LOCAL: {
local *STDOUT;
tie *STDOUT, __PACKAGE__;
CGI::Ex::print_content_type(@$args);
};
select $old_out;
(my $ans = $answer) =~ s/\s+$//;
if ($test_stdout eq $answer) {
ok(1, "(@$args) => $ans");
} else {
ok(0, "(@$args) => $ans");
print "#($test_stdout)\n";
}
}
select $old_out;
} else {
SKIP: {
skip("Can't test print_content_type", 10);
};
}
### try out make_form
my $str = $cgix->make_form($form);
ok($str =~ /foo=bar/, "Make form works");
ok($str =~ /mult=a&mult=b&mult=c/, "Make form works 2");
$str = $cgix->make_form($form, ['foo']);
ok($str eq 'foo=bar', "Make form works with keys");
### can't test these without being in apache (well we could test STDOUT - but that is for another day - TODO)
foreach my $meth (qw(
apache_request
content_typed
expires
is_mod_perl_1
is_mod_perl_2
last_modified
location_bounce
mod_perl_version
print_content_type
print_js
send_status
send_header
set_apache_request
set_cookie
)) {
ok($cgix->can($meth), "Has method $meth");
}
### try out time_calc
my $sec;
ok(($sec = CGI::Ex::time_calc('1m')) == time + 60, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc('-1m')) == time - 60, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc('1 m')) == time + 60, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc('1 min')) == time + 60, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc('1')) == 1, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc('now')) == time, "Time_calc ($sec)");
ok(($sec = CGI::Ex::time_calc(__FILE__)), "Time_calc ($sec)");
###----------------------------------------------------------------###
my $html = "<input type=text name=foo value=''>";
$form = {foo => 'bar'};
my $out;
ok(($out = $cgix->fill(scalarref => \$html, form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
ok(($out = $cgix->fill(arrayref => [$html], form => $form)) =~ /value=([\"\'])bar\1/, "Filled $out");
$cgix->fill(text => \$html, form => $form);
ok($html =~ /value=([\"\'])bar\1/, "Filled $html");
$html = "<form name=foo><input type=text name=baz value=''></form><form name=bar><input type=password name=bim value=''></form>";
$form = {baz => 'bing', bim => 'bang'};
$out = $cgix->fill(scalarref => \$html, form => $form, target => 'foo');
ok($out =~ /bing/, "Got bing");
ok($out !~ /bang/, "Didn't get bang");
$out = $cgix->fill(scalarref => \$html, form => $form, target => 'bar');
ok($out =~ /bang/, "Got bang");
ok($out !~ /bing/, "Didn't get bing");
$out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['baz']);
ok($out =~ /bang/, "Got bang");
ok($out !~ /bing/, "Didn't get bing");
$out = $cgix->fill(scalarref => \$html, form => $form, ignore_fields => ['bim']);
ok($out =~ /bing/, "Got bing");
ok($out !~ /bang/, "Didn't get bang");
$out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 1);
ok($out =~ /bing/, "Got bing");
ok($out =~ /bang/, "Got bang");
$out = $cgix->fill(scalarref => \$html, form => $form, fill_password => undef);
ok($out =~ /bing/, "Got bing");
ok($out =~ /bang/, "Got bang");
$out = $cgix->fill(scalarref => \$html, form => $form, fill_password => 0);
ok($out =~ /bing/, "Got bing");
ok($out !~ /bang/, "Didn't get bang");
###----------------------------------------------------------------###
$form = {foo => 'bar'};
my $val = {foo => {'required' => 1}};
my $e = $cgix->validate($form, $val);
ok(! $e, "No error");
$form = {};
$e = $cgix->validate($form, $val);
ok($e, "Got error");
ok("$e" =~ /required/i, "Had error message ($e)");
###----------------------------------------------------------------###
### defer testing to the conf test modules
foreach my $meth (qw(
conf_obj
conf_read
)) {
ok($cgix->can($meth), "Has method $meth");
}
###----------------------------------------------------------------###
$form = {foo => 'bar'};
my $args = {VARIABLES => {bim => 'bam'}};
my $temp = "([% foo %])([% bim %])";
$out = $cgix->swap_template($temp, $form, $args);
ok($out =~ /bar/, "Got bar");
ok($out =~ /bam/, "Got bam");
$cgix->swap_template(\$temp, $form, $args);
ok($temp =~ /bar/, "Got bar");
ok($temp =~ /bam/, "Got bam");
###----------------------------------------------------------------###