#!/usr/local/bin/perl use strict; use warnings; use Test::More; use CGI (); use Config; my $loaded = 1; $| = 1; ######################### End of black magic. # Set up a CGI environment $ENV{REQUEST_METHOD} = 'DELETE'; $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{REQUEST_URI} = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}"; $ENV{HTTP_LOVE} = 'true'; my $q = new CGI; ok $q,"CGI::new()"; is $q->request_method => 'DELETE',"CGI::request_method()"; is $q->query_string => 'game=chess;game=checkers;weather=dull',"CGI::query_string()"; is $q->param(), 2,"CGI::param()"; is join(' ',sort $q->param()), 'game weather',"CGI::param()"; is $q->param('game'), 'chess',"CGI::param()"; is $q->param('weather'), 'dull',"CGI::param()"; is join(' ',$q->param('game')), 'chess checkers',"CGI::param()"; ok $q->param(-name=>'foo',-value=>'bar'),'CGI::param() put'; is $q->param(-name=>'foo'), 'bar','CGI::param() get'; is $q->query_string, 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux"; is $q->http('love'), 'true',"CGI::http()"; is $q->script_name, '/cgi-bin/foo.cgi',"CGI::script_name()"; is $q->url, 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()"; is $q->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 $q->url(-absolute=>1), '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)'; is $q->url(-relative=>1), 'foo.cgi','CGI::url(-relative=>1)'; is $q->url(-relative=>1,-path=>1), 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)'; is $q->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)'; $q->delete('foo'); ok !$q->param('foo'),'CGI::delete()'; done_testing();