# -*- perl -*- # use strict; use warnings; use Test::More; use Test::Differences; use File::Temp 'tempfile'; umask 077; my ($script_fh, $script_path) = tempfile( "CGI-Alert-t-03.script.XXXXXX" ); my (undef, $output_path) = tempfile( "CGI-Alert-t-03.output.XXXXXX" ); printf $script_fh <<'-', $^X, $output_path, $output_path; #!%s -Tw -Iblib/lib use CGI::Alert qw(nobody http_die); use CGI; # Not interested in any email being sent $SIG{__DIE__} = 'DEFAULT'; $SIG{__WARN__} = sub { print STDOUT @_ }; # FIXME-document package CGI; use subs qw(header start_html); package main; *CGI::header = sub { print "header()\n"; use Data::Dumper; print Dumper(\@_); }; *CGI::start_html = sub { print "start_html()\n"; use Data::Dumper; print Dumper(\@_); }; open STDOUT, '>', '%s' or die "Cannot create %s: $!\n"; CGI::Alert::extra_html_headers( -author => 'esm@cpan.org', -head => CGI::Link({-rel => 'shortcut icon', -href => '/foo.ico', -type => 'image/x-icon', }), -style => { -src => '/foo.css', }, ); # Here we go. http_die '400 Bad Request', 'this is the body'; - close $script_fh; chmod 0500 => $script_path; my $expect = do { local $/; ; }; plan tests => 2; { local %ENV = ( (map { $_ => $ENV{$_} || 'undef' } qw(HOME PATH LOGNAME USER SHELL)), HTTP_HOST => 'http-host-name', REQUEST_URI => '/sample/url', ); system "./$script_path"; } is $?, 0, 'exit code of sample script'; my $i = 0; open ERROR, '<', $output_path; my $actual = do { local $/; ; }; close ERROR; eq_or_diff $actual, $expect, "fixme"; unlink $script_path, $output_path; # # The output we expect # __END__ header() $VAR1 = [ '-status', '400 Bad Request' ]; start_html() $VAR1 = [ '-title', '400 Bad Request', '-author', 'esm@cpan.org', '-head', '', '-style', { '-src' => '/foo.css' } ]; 11

Bad Request

this is the body


Script error: 400 Bad Request : this is the body at blib/lib/CGI/Alert.pm line 549.