Commit | Line | Data |
---|---|---|
be039708 CBW |
1 | #!/usr/local/bin/perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Test::More; | |
7 | ||
8 | use CGI (); | |
9 | use Config; | |
10 | ||
11 | my $loaded = 1; | |
12 | ||
13 | $| = 1; | |
14 | ||
15 | ######################### End of black magic. | |
16 | ||
17 | # Set up a CGI environment | |
18 | $ENV{REQUEST_METHOD} = 'DELETE'; | |
19 | $ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull'; | |
20 | $ENV{PATH_INFO} = '/somewhere/else'; | |
21 | $ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else'; | |
22 | $ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi'; | |
23 | $ENV{SERVER_PROTOCOL} = 'HTTP/1.0'; | |
24 | $ENV{SERVER_PORT} = 8080; | |
25 | $ENV{SERVER_NAME} = 'the.good.ship.lollypop.com'; | |
26 | $ENV{REQUEST_URI} = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}"; | |
27 | $ENV{HTTP_LOVE} = 'true'; | |
28 | ||
29 | my $q = new CGI; | |
30 | ok $q,"CGI::new()"; | |
31 | is $q->request_method => 'DELETE',"CGI::request_method()"; | |
32 | is $q->query_string => 'game=chess;game=checkers;weather=dull',"CGI::query_string()"; | |
33 | is $q->param(), 2,"CGI::param()"; | |
34 | is join(' ',sort $q->param()), 'game weather',"CGI::param()"; | |
35 | is $q->param('game'), 'chess',"CGI::param()"; | |
36 | is $q->param('weather'), 'dull',"CGI::param()"; | |
37 | is join(' ',$q->param('game')), 'chess checkers',"CGI::param()"; | |
38 | ok $q->param(-name=>'foo',-value=>'bar'),'CGI::param() put'; | |
39 | is $q->param(-name=>'foo'), 'bar','CGI::param() get'; | |
40 | is $q->query_string, 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux"; | |
41 | is $q->http('love'), 'true',"CGI::http()"; | |
42 | is $q->script_name, '/cgi-bin/foo.cgi',"CGI::script_name()"; | |
43 | is $q->url, 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()"; | |
44 | is $q->self_url, | |
45 | 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar', | |
46 | "CGI::url()"; | |
47 | is $q->url(-absolute=>1), '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)'; | |
48 | is $q->url(-relative=>1), 'foo.cgi','CGI::url(-relative=>1)'; | |
49 | is $q->url(-relative=>1,-path=>1), 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)'; | |
50 | is $q->url(-relative=>1,-path=>1,-query=>1), | |
51 | 'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar', | |
52 | 'CGI::url(-relative=>1,-path=>1,-query=>1)'; | |
53 | $q->delete('foo'); | |
54 | ok !$q->param('foo'),'CGI::delete()'; | |
55 | ||
56 | ||
57 | done_testing(); |