view release on metacpan or  search on metacpan

t/0_ex_00_base.t  view on Meta::CPAN

=cut

use vars qw($test_stdout @ISA);
use strict;
use Test::More tests => 75;

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;

    {
        local *STDOUT;
        tie *STDOUT, __PACKAGE__;

        local $ENV{'CONTENT_TYPED'} = 0;
        is($cgix->set_cookie(name => 'test', value => 1), "Set-Cookie: test=1; path=/\r\n", 'Got correct Set-Cookie header');

        local $ENV{'CONTENT_TYPED'} = 1;
        is($cgix->set_cookie(name => 'test', value => 0), "<script>document.cookie = 'test=0; path=/'</script>\n", 'Got correct cookie js due to headers printing earlier');
    }

    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", 12);
  };
}

### 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