#!./perl # Test ability to retrieve HTTP request info ######################### We start with some black magic to print on failure. BEGIN { chdir 't' if -d 't'; @INC = '../lib' if -d '../lib'; } BEGIN {$| = 1; print "1..17\n"; } END {print "not ok 1\n" unless $loaded;} use CGI (':standard','-no_debug'); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util sub test { local($^W) = 0; my($num, $true,$msg) = @_; print($true ? "ok $num\n" : "not ok $num $msg\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'; test(2,start_form(-action=>'foobar',-method=>GET) eq qq(
\n), "start_form()"); test(3,submit() eq qq(),"submit()"); test(4,submit(-name=>'foo',-value=>'bar') eq qq(),"submit(-name,-value)"); test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(),"submit({-name,-value})"); test(6,textfield(-name=>'weather') eq qq(),"textfield({-name})"); test(7,textfield(-name=>'weather',-value=>'nice') eq qq(),"textfield({-name,-value})"); test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(), "textfield({-name,-value,-override})"); test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(weather\n), "checkbox()"); test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq qq(forecast\n), "checkbox()"); test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq qq(forecast\n), "checkbox()"); test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq qq(forecast\n), "checkbox()"); test(13,radio_group(-name=>'game') eq qq(chess checkers), 'radio_group()'); test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq qq(ping pong checkers), 'radio_group()'); test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq qq(checkers chess cribbage), 'checkbox_group()'); test(16, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Defaults=>['cribbage'],-override=>1) eq qq(checkers chess cribbage), 'checkbox_group()'); test(17, popup_menu(-name=>'game',-Values=>[qw/checkers chess cribbage/],-Default=>'cribbage',-override=>1) eq <