X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=t%2Fcgi_maypole.t;h=e1798667303f12b20eabf887b729664b13317547;hb=73df58543e31b805fe123e4e818ab863eaac07de;hp=f4d4e82105675caac1846765fa56617506e2a9f2;hpb=b65ee86d592a4038c2bd7f354a29894145758893;p=maypole.git

diff --git a/t/cgi_maypole.t b/t/cgi_maypole.t
index f4d4e82..e179866 100644
--- a/t/cgi_maypole.t
+++ b/t/cgi_maypole.t
@@ -1,11 +1,12 @@
 #!/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;
@@ -13,7 +14,8 @@ my $mock_maypole = new Test::MockModule('CGI::Maypole');
 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()
@@ -26,12 +28,16 @@ is_deeply($calls{handler}, ['CGI::Maypole'],
 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');
@@ -41,7 +47,13 @@ is($cgi, $r->{cgi}, '... and stores it in the "cgi" slot');
 
 # 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'};
@@ -75,16 +87,32 @@ is_deeply($r->params, $r->query, '... query and params are identical');
 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 $@;
+
+    $compare = join "\cM\cJ", 'Content-length: 12',
+        'X-bender: kiss my shiny metal ass',
+        'Content-Type: text/plain; charset=iso8859-1',
+        '', 'Hello World!';
+    is($stdout, $compare, '... prints output, including custom headers');
 }
 
 # get_template_root()