use Test::More tests => 27; use strict; use Config; use CGI::Simple::Standard qw(:all -default); # Makes forked test work OK Test::More->builder->no_ending( 1 ); my $CRLF = "\015\012"; # A peculiarity of sending "\n" through MBX|Socket|web-server on VMS # is that a CR character gets inserted automatically in the web server # case but not internal to perl's double quoted strings "\n". This # test would need to be modified to use the "\015\012" on VMS if it # were actually run through a web server. # Thanks to Peter Prymmer for this if ( $^O eq 'VMS' ) { $CRLF = "\n"; } # Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII # translation hence CRLF is used as \r\n within CGI.pm on such machines. if ( ord( "\t" ) != 9 ) { $CRLF = "\r\n"; } # Set up a CGI environment $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull'; $ENV{PATH_INFO} = '/somewhere/else'; $ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else'; $ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi'; $ENV{SERVER_PROTOCOL} = 'HTTP/1.0'; $ENV{SERVER_PORT} = 8080; $ENV{SERVER_NAME} = 'the.good.ship.lollypop.com'; $ENV{HTTP_LOVE} = 'true'; is( request_method(), 'GET', "CGI::request_method()" ); is( query_string(), 'game=chess;game=checkers;weather=dull', "CGI::query_string()" ); is( param(), 2, "CGI::param()" ); is( join( ' ', sort { $a cmp $b } param() ), 'game weather', "CGI::param()" ); is( param( 'game' ), 'chess', "CGI::param()" ); is( param( 'weather' ), 'dull', "CGI::param()" ); is( join( ' ', param( 'game' ) ), 'chess checkers', "CGI::param()" ); ok( param( -name => 'foo', -value => 'bar' ), 'CGI::param() put' ); is( param( -name => 'foo' ), 'bar', 'CGI::param() get' ); is( query_string(), 'game=chess;game=checkers;weather=dull;foo=bar', "CGI::query_string() redux" ); is( http( 'love' ), 'true', "CGI::http()" ); is( script_name(), '/cgi-bin/foo.cgi', "CGI::script_name()" ); is( url(), 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi', "CGI::url()" ); is( self_url(), 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else' . '?game=chess;game=checkers;weather=dull;foo=bar', "CGI::url()" ); is( url( -absolute => 1 ), '/cgi-bin/foo.cgi', 'CGI::url(-absolute=>1)' ); is( url( -relative => 1 ), 'foo.cgi', 'CGI::url(-relative=>1)' ); is( url( -relative => 1, -path => 1 ), 'foo.cgi/somewhere/else', 'CGI::url(-relative=>1,-path=>1)' ); is( url( -relative => 1, -path => 1, -query => 1 ), 'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar', 'CGI::url(-relative=>1,-path=>1,-query=>1)' ); Delete( 'foo' ); ok( !param( 'foo' ), 'CGI::delete()' ); #CGI::_reset_globals(); $ENV{QUERY_STRING} = 'mary+had+a+little+lamb'; restore_parameters(); is( join( ' ', keywords() ), 'mary had a little lamb', 'CGI::keywords' ); is( join( ' ', param( 'keywords' ) ), 'mary had a little lamb', 'CGI::keywords' ); is( redirect( 'http://somewhere.else' ), "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}${CRLF}", "CGI::redirect() 1" ); my $h = redirect( -Location => 'http://somewhere.else', -Type => 'text/html' ); is( $h, "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}" . "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}", "CGI::redirect() 2" ); is( redirect( -Location => 'http://somewhere.else/bin/foo&bar', -Type => 'text/html' ), "Status: 302 Moved${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}" . "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}", "CGI::redirect() 2" ); is( escapeHTML( 'CGI' ), 'CGI', 'escapeHTML(CGI) failing again' ); SKIP: { skip "Fork not available on this platform", 2 unless $Config{d_fork}; my $test_string = 'game=soccer&game=baseball&weather=nice'; $ENV{REQUEST_METHOD} = 'POST'; $ENV{CONTENT_LENGTH} = length( $test_string ); $ENV{QUERY_STRING} = 'big_balls=basketball&small_balls=golf'; $ENV{CONTENT_TYPE} = 'application/x-www-form-urlencoded'; if ( open( CHILD, "|-" ) ) { # cparent print CHILD $test_string; close CHILD; exit 0; } # at this point, we're in a new (child) process restore_parameters(); # trigger a reinitialisaton is( param( 'weather' ), 'nice', "CGI::param() from POST" ); is( url_param( 'big_balls' ), 'basketball', "CGI::url_param()" ); }