#!/usr/bin/perl -w
use strict;
-use Test::More tests => 26;
+use Test::More tests => 30;
use Test::MockModule;
require_ok('CGI::Maypole');
ok($CGI::Maypole::VERSION, 'defines $VERSION');
ok($INC{'CGI/Simple.pm'}, 'requires CGI::Simple');
+ok($INC{'Maypole/Headers.pm'}, 'requires Maypole::Headers');
ok(CGI::Maypole->isa('Maypole'), '@ISA = Maypole');
my %calls;
my $mock_cgi = new Test::MockModule('CGI::Simple');
$mock_cgi->mock(path_info => sub {
delete $_[0]->{'.path_info'};
- goto $mock_cgi->original('path_info')
+ my $orig_path_info = $mock_cgi->original('path_info');
+ goto $orig_path_info;
});
# run()
is($status, 'X', '... and returns its status');
my $r = bless {}, 'CGI::Maypole';
+$r->headers_out(Maypole::Headers->new);
$ENV{HTTP_HOST} = 'localhost';
$ENV{SCRIPT_NAME} = '/maypole/index.cgi';
$ENV{PATH_INFO} = '/';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'beer=1;beer=2;pub=red+lion;handpump';
$ENV{DOCUMENT_ROOT} = '/var/tmp/maypole';
+for (keys %ENV) {
+ delete $ENV{$_} if /^HTTPS?/;
+}
# get_request()
can_ok($r => 'get_request');
# parse_location()
can_ok($r => 'parse_location');
+$ENV{HTTP_REFERER} = 'http://maypole.perl.org/';
+$ENV{HTTP_USER_AGENT} = 'tty';
$r->parse_location;
+is($r->headers_in->get('Referer'), 'http://maypole.perl.org/',
+ '... sets headers_in() from HTTP variables');
+is_deeply([$r->headers_in->field_names], [qw(Referer User-Agent)],
+ '... loads only those HTTP variables');
is($r->path, 'frontpage', '... sets "path" to frontpage if undefined');
#delete $r->{cgi}{'.path_info'};
can_ok($r => 'send_output');
SKIP: {
eval "require IO::CaptureOutput";
- skip "IO::CaptureOutput not installed", 3 if $@;
+ skip "IO::CaptureOutput not installed", 2 if $@;
$r->content_type('text/plain');
$r->document_encoding('iso8859-1');
$r->output('Hello World!');
- my $stdout;
- IO::CaptureOutput::capture(sub {$r->send_output}, \$stdout);
+ my $stdout;
+ eval {
+ IO::CaptureOutput::capture(sub {$r->send_output}, \$stdout);
+ };
+ diag $@ if $@;
my $compare = join "\cM\cJ", 'Content-length: 12',
'Content-Type: text/plain; charset=iso8859-1', '', 'Hello World!';
is($stdout, $compare, '... prints output, including content-type header');
+
+ # test custom output headers
+ $r->headers_out->set(X_Bender => 'kiss my shiny metal ass');
+ eval {
+ IO::CaptureOutput::capture(sub {$r->send_output}, \$stdout);
+ };
+ diag $@ if $@;
+
+ my $CL = 'Content-length: 12';
+ my $XB = 'X-bender: kiss my shiny metal ass';
+ my $nl = "\cM\cJ";
+ my $re = join $nl, "($CL$nl$XB)|($XB$nl$CL)",
+ 'Content-Type: text/plain; charset=iso8859-1',
+ '', 'Hello World!';
+ like($stdout, qr/$re/, '... prints output, including custom headers');
}
# get_template_root()