|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #################################################################  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  Copyright (c) 2001, Raphael Manfredi  | 
| 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  Copyright (c) 2011-2015, Alex Tokarev  | 
| 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  You may redistribute only under the terms of the Artistic License,  | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  as specified in the README file that comes with the distribution.  | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package CGI::Test;  | 
| 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
11
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
392717
 | 
 use strict;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
674
 | 
    | 
| 
12
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
76
 | 
 use warnings;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
428
 | 
    | 
| 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
14
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
287
 | 
 use Carp;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1415
 | 
    | 
| 
15
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
8913
 | 
 use HTTP::Status;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54820
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4253
 | 
    | 
| 
16
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
13222
 | 
 use URI;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91829
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
571
 | 
    | 
| 
17
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
13480
 | 
 use File::Temp qw(mkstemp);  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
298532
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1188
 | 
    | 
| 
18
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
122
 | 
 use File::Spec;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
306
 | 
    | 
| 
19
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
64
 | 
 use File::Basename;  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1231
 | 
    | 
| 
20
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
85
 | 
 use Cwd qw(abs_path);  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
730
 | 
    | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
22
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
210
 | 
 use vars qw($VERSION);  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1505
 | 
    | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $VERSION = '1.110';  | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
26
 | 
23
 | 
 
 | 
 
 | 
  
23
  
 | 
 
 | 
76
 | 
 use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };  | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
61893
 | 
    | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #############################################################################  | 
| 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->new  | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Creation routine  | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Arguments:  | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #    base_url		URL to cgi-bin, e.g. http://foo:18/cgi-bin  | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #    cgi_dir		physical location of base_url  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #    tmp_dir		(optional) temporary directory to use  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #    cgi_env		(optional) default CGI environment  | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #    doc_dir		(optional) physical location of docs, for path translation  | 
| 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #############################################################################  | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new  | 
| 
43
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
44
 | 
25
 | 
 
 | 
 
 | 
  
25
  
 | 
  
0
  
 | 
28910
 | 
     my $this = bless {}, shift;  | 
| 
45
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
96
 | 
     my %params = @_;  | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
47
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my $ubase = $params{-base_url};  | 
| 
48
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
57
 | 
     my $dir   = $params{-cgi_dir};  | 
| 
49
 | 
25
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
146
 | 
     my $doc   = $params{-doc_dir} || ".";  | 
| 
50
 | 
25
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
293
 | 
     my $tmp   = $params{-tmp_dir} || $ENV{TMPDIR} || $ENV{TEMP} || "/tmp";  | 
| 
51
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
     my $env   = $params{-cgi_env};  | 
| 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
53
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
190
 | 
     my $uri = URI->new($ubase);  | 
| 
54
 | 
25
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
115775
 | 
     croak "-base_url $ubase is not within the http scheme"  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         unless $uri->scheme eq 'http';  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
57
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2689
 | 
     my ($server, $path) = $this->split_uri($uri);  | 
| 
58
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
270
 | 
     $this->{host_port} = $server;  | 
| 
59
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
     $this->{scheme}    = $uri->scheme;  | 
| 
60
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
292
 | 
     $this->{host}      = $uri->host;  | 
| 
61
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
550
 | 
     $this->{port}      = $uri->port;  | 
| 
62
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
389
 | 
     $this->{base_path} = $path;  | 
| 
63
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
     $this->{cgi_dir}   = $dir;  | 
| 
64
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
     $this->{tmp_dir}   = $tmp;  | 
| 
65
 | 
25
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     $env = {} unless defined $env;  | 
| 
66
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54
 | 
     $this->{cgi_env} = $env;  | 
| 
67
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
     $this->{doc_dir} = $doc;  | 
| 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # The following default settings will apply unless alternatives given  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # by user via the -cgi_env parameter.  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
74
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
108
 | 
     my %dflt = (AUTH_TYPE           => "Basic",  | 
| 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 GATEWAY_INTERFACE   => "CGI/1.1",  | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 HTTP_ACCEPT         => "*/*",  | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 HTTP_CONNECTION     => "Close",  | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 HTTP_USER_AGENT     => "CGI::Test",  | 
| 
79
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 HTTP_ACCEPT_CHARSET => "iso-8859-1",  | 
| 
80
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 REMOTE_HOST         => "localhost",  | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 REMOTE_ADDR         => "127.0.0.1",  | 
| 
82
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 SERVER_NAME         => $uri->host,  | 
| 
83
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 SERVER_PORT         => $uri->port,  | 
| 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 SERVER_PROTOCOL     => "HTTP/1.1",  | 
| 
85
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 SERVER_SOFTWARE     => "CGI::Test",  | 
| 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 );  | 
| 
87
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
88
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
872
 | 
     while (my ($key, $value) = each %dflt)  | 
| 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
90
 | 
300
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
786
 | 
         $env->{$key} = $value unless exists $env->{$key};  | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
92
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
94
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Object types to create depending on returned content-type.  | 
| 
95
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # If not listed here, "Other" is assummed.  | 
| 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
97
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
98
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     $this->{_obj_type} = {'text/plain' => 'Text',  | 
| 
99
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                           'text/html'  => 'HTML',  | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                           };  | 
| 
101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
102
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
271
 | 
     return $this;  | 
| 
103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub make  | 
| 
109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
110
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
0
 | 
     my $class = shift;  | 
| 
111
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $class->new(@_);  | 
| 
112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Attribute access  | 
| 
116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub host_port  | 
| 
120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
121
 | 
44
 | 
 
 | 
 
 | 
  
44
  
 | 
  
1
  
 | 
65
 | 
     my $this = shift;  | 
| 
122
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     return $this->{host_port};  | 
| 
123
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
124
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
126
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base_uri  | 
| 
127
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
128
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
0
 | 
     my $this = shift;  | 
| 
129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
130
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $scheme = $this->{scheme};  | 
| 
131
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $host   = $this->{host};  | 
| 
132
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $port   = $this->{port};  | 
| 
133
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $base   = $this->{base_path};  | 
| 
134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
135
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $scheme . '://' . $host . ':' . $port . $base;  | 
| 
136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub host  | 
| 
140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
141
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
0
 | 
     my $this = shift;  | 
| 
142
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $this->{host};  | 
| 
143
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
144
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
145
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub port  | 
| 
147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
148
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
0
 | 
     my $this = shift;  | 
| 
149
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $this->{port};  | 
| 
150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base_path  | 
| 
154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
155
 | 
44
 | 
 
 | 
 
 | 
  
44
  
 | 
  
1
  
 | 
53
 | 
     my $this = shift;  | 
| 
156
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
141
 | 
     return $this->{base_path};  | 
| 
157
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
160
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub cgi_dir  | 
| 
161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
162
 | 
44
 | 
 
 | 
 
 | 
  
44
  
 | 
  
1
  
 | 
56
 | 
     my $this = shift;  | 
| 
163
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
120
 | 
     return $this->{cgi_dir};  | 
| 
164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub doc_dir  | 
| 
168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
169
 | 
16
 | 
 
 | 
 
 | 
  
16
  
 | 
  
1
  
 | 
47
 | 
     my $this = shift;  | 
| 
170
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
148
 | 
     return $this->{doc_dir};  | 
| 
171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub tmp_dir  | 
| 
175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
176
 | 
62
 | 
 
 | 
 
 | 
  
62
  
 | 
  
1
  
 | 
97
 | 
     my $this = shift;  | 
| 
177
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
772
 | 
     return $this->{tmp_dir};  | 
| 
178
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
179
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub cgi_env  | 
| 
182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
183
 | 
210
 | 
 
 | 
 
 | 
  
210
  
 | 
  
0
  
 | 
233
 | 
     my $this = shift;  | 
| 
184
 | 
210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2173
 | 
     return $this->{cgi_env};  | 
| 
185
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
187
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
188
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _obj_type  | 
| 
189
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
190
 | 
28
 | 
 
 | 
 
 | 
  
28
  
 | 
 
 | 
55
 | 
     my $this = shift;  | 
| 
191
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
205
 | 
     return $this->{_obj_type};  | 
| 
192
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
193
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub http_headers {  | 
| 
196
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
1
  
 | 
0
 | 
     my ($self) = @_;  | 
| 
197
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
198
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $self->{http_headers};  | 
| 
199
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
200
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
202
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->_dpath  | 
| 
204
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Returns direct path to final component of argument,  | 
| 
206
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # i.e. the original path with . and .. items removed.  | 
| 
207
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
208
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Will probably only work on Unix (possibly Win32 if paths given with "/").  | 
| 
209
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _dpath  | 
| 
212
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
213
 | 
69
 | 
 
 | 
 
 | 
  
69
  
 | 
 
 | 
2104
 | 
     my $this  = shift;  | 
| 
214
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
100
 | 
     my ($dir) = @_;  | 
| 
215
 | 
69
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
313
 | 
     my $root  = ($dir =~ s|^/||) ? "/" : "";  | 
| 
216
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
83
 | 
     my @cur;  | 
| 
217
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
244
 | 
     foreach my $item (split(m|/|, $dir))  | 
| 
218
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
219
 | 
119
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
477
 | 
         next if $item eq '.';  | 
| 
220
 | 
119
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
189
 | 
         if ($item eq '..')  | 
| 
221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
222
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             pop(@cur);  | 
| 
223
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
224
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         else  | 
| 
225
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
226
 | 
119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
350
 | 
             push(@cur, $item);  | 
| 
227
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
229
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
206
 | 
     my $path = $root . join('/', @cur);  | 
| 
230
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
438
 | 
     $path =~ tr|/||s;  | 
| 
231
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
315
 | 
     return $path;  | 
| 
232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
233
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
234
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
235
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->split_uri  | 
| 
237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
238
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Split down URI into (server, path, query) components.  | 
| 
239
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
240
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
241
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub split_uri  | 
| 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
243
 | 
69
 | 
 
 | 
 
 | 
  
69
  
 | 
  
1
  
 | 
91
 | 
     my $this = shift;  | 
| 
244
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
103
 | 
     my ($uri) = @_;  | 
| 
245
 | 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
392
 | 
     return ($uri->host_port, $this->_dpath($uri->path), $uri->query);  | 
| 
246
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
247
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
248
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
250
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->GET  | 
| 
251
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
252
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Perform an HTTP GET request on a CGI URI by running the script directly.  | 
| 
253
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Returns a CGI::Test::Page object representing the returned page, or the  | 
| 
254
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # error.  | 
| 
255
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
256
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Optional $user provides the name of the "authenticated" user running  | 
| 
257
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # this script.  | 
| 
258
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
259
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
260
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub GET  | 
| 
261
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
262
 | 
42
 | 
 
 | 
 
 | 
  
42
  
 | 
  
1
  
 | 
6769
 | 
     my $this = shift;  | 
| 
263
 | 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my ($uri, $user) = @_;  | 
| 
264
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
265
 | 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
162
 | 
     return $this->_cgi_request($uri, $user, undef);  | 
| 
266
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
267
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
268
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
269
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
270
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->POST  | 
| 
271
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
272
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Perform an HTTP POST request on a CGI URI by running the script directly.  | 
| 
273
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Returns a CGI::Test::Page object representing the returned page, or the  | 
| 
274
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # error.  | 
| 
275
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
276
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Data to send to the script are held in $input, a CGI::Test::Input object.  | 
| 
277
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Optional $user provides the name of the "authenticated" user running  | 
| 
279
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # this script.  | 
| 
280
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
281
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
282
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub POST  | 
| 
283
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
284
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
  
1
  
 | 
2
 | 
     my $this = shift;  | 
| 
285
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     my ($uri, $input, $user) = @_;  | 
| 
286
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
287
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     return $this->_cgi_request($uri, $user, $input);  | 
| 
288
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
289
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
290
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
291
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
292
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->_cgi_request  | 
| 
293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
294
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Common routine to handle GET and POST.  | 
| 
295
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
297
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _cgi_request  | 
| 
298
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
299
 | 
44
 | 
 
 | 
 
 | 
  
44
  
 | 
 
 | 
53
 | 
     my $this = shift;  | 
| 
300
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
63
 | 
     my ($uri, $user, $input) = @_;    # $input defined for POST  | 
| 
301
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
302
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
151
 | 
     my $u = URI->new($uri);  | 
| 
303
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
2157
 | 
     croak "URI $uri is not within the http scheme"  | 
| 
304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         unless $u->scheme eq 'http';  | 
| 
305
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
306
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9661
 | 
     require CGI::Test::Page::Error;  | 
| 
307
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
85
 | 
     my $error = "CGI::Test::Page::Error";  | 
| 
308
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
309
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
135
 | 
     my ($userver, $upath, $uquery) = $this->split_uri($u);  | 
| 
310
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
510
 | 
     my $server    = $this->host_port;  | 
| 
311
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
     my $base_path = $this->base_path . "/";  | 
| 
312
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
313
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
131
 | 
     croak "URI $uri is not located on server $server"  | 
| 
314
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         unless $userver eq $server;  | 
| 
315
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
316
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     croak "URI $uri is not located under the $base_path directory"  | 
| 
317
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         unless substr($upath, 0, length $base_path) eq $base_path;  | 
| 
318
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
319
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
106
 | 
     substr($upath, 0, length $base_path) = '';  | 
| 
320
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
322
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # We have script + path_info in the $upath variable.  To determine where  | 
| 
323
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # the path_info starts, we have to walk through the components and  | 
| 
324
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # compare, at each step, the current walk-through path with one on the  | 
| 
325
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # filesystem under cgi_dir.  | 
| 
326
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
328
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
106
 | 
     my $cgi_dir = $this->cgi_dir;  | 
| 
329
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
137
 | 
     my @components = split(m|/|, $upath);  | 
| 
330
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
     my @script;  | 
| 
331
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
332
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
117
 | 
     while (@components)  | 
| 
333
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
334
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
60
 | 
         my $item = shift @components;  | 
| 
335
 | 
47
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1480
 | 
         if (-e File::Spec->catfile($cgi_dir, @script, $item))  | 
| 
336
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
337
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
148
 | 
             push(@script, $item);  | 
| 
338
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
339
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         else  | 
| 
340
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
341
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
             unshift @components, $item;  | 
| 
342
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
             last;  | 
| 
343
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
344
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
345
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
346
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
230
 | 
     my $script      = File::Spec->catfile($cgi_dir, @script);        # Real  | 
| 
347
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
105
 | 
     my $script_name = $base_path . join("/",        @script);        # Virtual  | 
| 
348
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
82
 | 
     my $path        = "/" . join("/",               @components);    # Virtual  | 
| 
349
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
350
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
313
 | 
     return $error->new(RC_NOT_FOUND,    $this) unless -f $script;  | 
| 
351
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
300
 | 
     return $error->new(RC_UNAUTHORIZED, $this) unless -x $script;  | 
| 
352
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
354
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Prepare input for POST requests.  | 
| 
355
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
356
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
357
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
     my @post = ();  | 
| 
358
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
671
 | 
     local $SIG{PIPE} = 'IGNORE';  | 
| 
359
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
     local (*PREAD, *PWRITE);  | 
| 
360
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
361
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
     my ($in_fh, $out_fh, $in_fname, $out_fname);  | 
| 
362
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
363
 | 
44
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
113
 | 
     if (defined $input) {  | 
| 
364
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # In Windows, we use temp files instead of pipes to avoid  | 
| 
365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         # stream duplication errors  | 
| 
366
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
         if ( WINDOWS ) {  | 
| 
367
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             ($in_fh, $in_fname) =  | 
| 
368
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_in.XXXXXX"));  | 
| 
369
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
               | 
| 
370
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             binmode $in_fh;  | 
| 
371
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
               | 
| 
372
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             syswrite $in_fh, $input->data, $input->length;  | 
| 
373
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             close $in_fh;  | 
| 
374
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
               | 
| 
375
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             @post = (  | 
| 
376
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 -in_fname => $in_fname,  | 
| 
377
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 -input    => $input,  | 
| 
378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             );  | 
| 
379
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
380
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         else {  | 
| 
381
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
30
 | 
             if ( not pipe(PREAD, PWRITE) ) {  | 
| 
382
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 warn "can't open pipe: $!";  | 
| 
383
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 return $error->new(RC_INTERNAL_SERVER_ERROR, $this);  | 
| 
384
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
385
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
386
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             @post = (  | 
| 
387
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
                 -in    => \*PREAD,  | 
| 
388
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 -input => $input,  | 
| 
389
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             );  | 
| 
390
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
391
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
392
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
393
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Prepare temporary file for storing output, which we'll parse once  | 
| 
395
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # the script is done.  | 
| 
396
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
397
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
398
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     ($out_fh, $out_fname) =  | 
| 
399
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_out.XXXXXX"));  | 
| 
400
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
401
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
13853
 | 
     close $out_fh if WINDOWS;  | 
| 
402
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
403
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
315
 | 
     select((select(STDOUT), $| = 1)[ 0 ]);  | 
| 
404
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
122
 | 
     print STDOUT "";    # Flush STDOUT before forking  | 
| 
405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
407
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Fork...  | 
| 
408
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
409
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
410
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28736
 | 
     my $pid = fork;  | 
| 
411
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1287
 | 
     die "can't fork: $!" unless defined $pid;  | 
| 
412
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
413
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
414
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Child will run the CGI program with no input if it's a GET and  | 
| 
415
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # output stored to $fh.  When issuing a POST, data will be provided  | 
| 
416
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # by the parent through a pipe in Unixy systems, or through a temp file  | 
| 
417
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # in Windows.  | 
| 
418
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
419
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
420
 | 
44
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1146
 | 
     if ($pid == 0) {  | 
| 
421
 | 
16
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
696
 | 
         close PWRITE if defined $input && !WINDOWS; # Writing side of the pipe  | 
| 
422
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
           | 
| 
423
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1322
 | 
         $this->_run_cgi(  | 
| 
424
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -script_file => $script,         # Real path  | 
| 
425
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -script_name => $script_name,    # Virtual path, given in URI  | 
| 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -user        => $user,  | 
| 
427
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -out         => $out_fh,  | 
| 
428
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -out_fname   => $out_fname,  | 
| 
429
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -uri         => $u,  | 
| 
430
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             -path_info   => $path,  | 
| 
431
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             @post,                           # Additional params for POST  | 
| 
432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         );  | 
| 
433
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
           | 
| 
434
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         confess "not reachable!";  | 
| 
435
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
436
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
437
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
438
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Parent process  | 
| 
439
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
440
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
441
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1514
 | 
     close $out_fh unless WINDOWS;  | 
| 
442
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
443
 | 
28
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
219
 | 
     if (defined $input && !WINDOWS)  | 
| 
444
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {                                        # Send POST input data  | 
| 
445
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
         close PREAD;  | 
| 
446
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
47
 | 
         syswrite PWRITE, $input->data, $input->length;  | 
| 
447
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
         close PWRITE or warn "failure while closing pipe: $!";  | 
| 
448
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
449
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
450
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17700704
 | 
     my $child = waitpid $pid, 0;  | 
| 
451
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
452
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
268
 | 
     if ($pid != $child)  | 
| 
453
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
454
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         warn "waitpid returned with pid=$child, but expected pid=$pid";  | 
| 
455
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         kill 'TERM', $pid or warn "can't SIGTERM pid $pid: $!";  | 
| 
456
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         unlink $in_fname  or warn "can't unlink $in_fname: $!";  | 
| 
457
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         unlink $out_fname or warn "can't unlink $out_fname: $!";  | 
| 
458
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         return $error->new(RC_NO_CONTENT, $this);  | 
| 
459
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
460
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
461
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
462
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Get header within generated response, and determine Content-Type.  | 
| 
463
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
464
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
465
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
421
 | 
     my $header = $this->_parse_header($out_fname);  | 
| 
466
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     unless (scalar keys %$header)  | 
| 
467
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
468
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         warn "script $script_name generated no valid headers";  | 
| 
469
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         unlink $in_fname  or warn "can't unlink $in_fname: $!";  | 
| 
470
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         unlink $out_fname or warn "can't unlink $out_fname: $!";  | 
| 
471
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         return $error->new(RC_INTERNAL_SERVER_ERROR, $this);  | 
| 
472
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
473
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
474
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
475
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Return error page if we got 5xx status  | 
| 
476
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
477
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
478
 | 
28
 | 
  
 50
  
 | 
  
 50
  
 | 
 
 | 
 
 | 
315
 | 
     if ( my ($status) = ($header->{Status} || '') =~ /^(5\d\d)/ ) {  | 
| 
479
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         return $error->new($status, $this);  | 
| 
480
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
481
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
482
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
483
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Store headers for later retrieval  | 
| 
484
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
485
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
486
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     $this->{http_headers} = $header;  | 
| 
487
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
488
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
489
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Create proper page object, which will parse the results file as needed.  | 
| 
490
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
491
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
492
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
120
 | 
     my $type      = $header->{'Content-Type'};  | 
| 
493
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
70
 | 
     my $base_type = lc($type);  | 
| 
494
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
158
 | 
     $base_type =~ s/;.*//;    # Strip type parameters  | 
| 
495
 | 
28
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
189
 | 
     my $objtype = $this->_obj_type->{$base_type} || "Other";  | 
| 
496
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
     $objtype = "CGI::Test::Page::$objtype";  | 
| 
497
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
498
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3003
 | 
     eval "require $objtype";  | 
| 
499
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
210
 | 
     die "can't load module $objtype: $@" if chop $@;  | 
| 
500
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
501
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
322
 | 
     my $page = $objtype->new(  | 
| 
502
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         -server       => $this,  | 
| 
503
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         -file         => $out_fname,  | 
| 
504
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         -content_type => $type,    # raw type, with parameters  | 
| 
505
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         -user         => $user,  | 
| 
506
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         -uri          => $u,  | 
| 
507
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         );  | 
| 
508
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
509
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
108
 | 
     if ($in_fname) {  | 
| 
510
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         unlink $in_fname  or warn "can't unlink $in_fname: $!";  | 
| 
511
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
512
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
513
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3053
 | 
     unlink $out_fname or warn "can't unlink $out_fname: $!";  | 
| 
514
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
515
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
837
 | 
     return $page;  | 
| 
516
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
517
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
518
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
519
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
520
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->_run_cgi  | 
| 
521
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
522
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Run the specified script within a CGI environment.  | 
| 
523
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
524
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # The -user is the name of the authenticated user running this script.  | 
| 
525
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
526
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # The -in and -out parameters are file handles where STDIN and STDOUT  | 
| 
527
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # need to be connected to.  If $in is undefined, STDIN is connected  | 
| 
528
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # to /dev/null.  | 
| 
529
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
530
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Returns nothing.  | 
| 
531
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
532
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
533
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _run_cgi  | 
| 
534
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
535
 | 
16
 | 
 
 | 
 
 | 
  
16
  
 | 
 
 | 
192
 | 
     my $this = shift;  | 
| 
536
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
537
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
702
 | 
     my %params = @_;  | 
| 
538
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
539
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     my $script    = $params{-script_file};  | 
| 
540
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
104
 | 
     my $name      = $params{-script_name};  | 
| 
541
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
98
 | 
     my $user      = $params{-user};  | 
| 
542
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
271
 | 
     my $in        = $params{-in};  | 
| 
543
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
95
 | 
     my $in_fname  = $params{-in_fname};  | 
| 
544
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
89
 | 
     my $out       = $params{-out};  | 
| 
545
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
60
 | 
     my $out_fname = $params{-out_fname};  | 
| 
546
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
     my $u         = $params{-uri};  | 
| 
547
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
     my $path      = $params{-path_info};  | 
| 
548
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
79
 | 
     my $input     = $params{-input};  | 
| 
549
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
550
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
551
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Connect file descriptors.  | 
| 
552
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
553
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
554
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
304
 | 
     if ( !WINDOWS ) {  | 
| 
555
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
206
 | 
         if (defined $in)  | 
| 
556
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
557
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
58
 | 
             open(STDIN, '<&=' . fileno($in)) || die "can't redirect STDIN: $!";  | 
| 
558
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
559
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         else  | 
| 
560
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
561
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1057
 | 
             my $devnull = File::Spec->devnull;  | 
| 
562
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1790
 | 
             open(STDIN, $devnull) || die "can't open $devnull: $!";  | 
| 
563
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
564
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
597
 | 
         open(STDOUT, '>&=' . fileno($out)) || die "can't redirect STDOUT: $!";  | 
| 
565
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
566
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
567
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
568
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Setup default CGI environment.  | 
| 
569
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
570
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
571
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55
 | 
     while (my ($key, $value) = each %{$this->cgi_env})  | 
| 
 
 | 
210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
494
 | 
    | 
| 
572
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
573
 | 
194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1222
 | 
         $ENV{$key} = $value;  | 
| 
574
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
575
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
576
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
577
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Where there is a script input, setup CONTENT_* variables.  | 
| 
578
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # If there's no input, delete CONTENT_* variables.  | 
| 
579
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
580
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
581
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
148
 | 
     if (defined $input)  | 
| 
582
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
583
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
         $ENV{CONTENT_TYPE}   = $input->mime_type;  | 
| 
584
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
         $ENV{CONTENT_LENGTH} = $input->length;  | 
| 
585
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
586
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else  | 
| 
587
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
588
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
157
 | 
         delete $ENV{CONTENT_TYPE};  | 
| 
589
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
110
 | 
         delete $ENV{CONTENT_LENGTH};  | 
| 
590
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
591
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
592
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
593
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Supersede whatever they may have set for the following variables,  | 
| 
594
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # which are very request-specific:  | 
| 
595
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
596
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
597
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
191
 | 
     $ENV{REQUEST_METHOD}  = defined $input ? "POST" : "GET";  | 
| 
598
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
87
 | 
     $ENV{PATH_INFO}       = $path;  | 
| 
599
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
87
 | 
     $ENV{SCRIPT_NAME}     = $name;  | 
| 
600
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     $ENV{SCRIPT_FILENAME} = $script;  | 
| 
601
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
550
 | 
     $ENV{HTTP_HOST}       = $u->host_port;  | 
| 
602
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
603
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1944
 | 
     if (length $path)  | 
| 
604
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
605
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
102
 | 
         $ENV{PATH_TRANSLATED} = $this->doc_dir . $path;  | 
| 
606
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
607
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else  | 
| 
608
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
609
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         delete $ENV{PATH_TRANSLATED};  | 
| 
610
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
611
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
612
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
68
 | 
     if (defined $user)  | 
| 
613
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
614
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
         $ENV{REMOTE_USER} = $user;  | 
| 
615
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
616
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else  | 
| 
617
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
618
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
68
 | 
         delete $ENV{REMOTE_USER};  | 
| 
619
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
         delete $ENV{AUTH_TYPE};  | 
| 
620
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
621
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
622
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
185
 | 
     if (defined $u->query)  | 
| 
623
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
624
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
269
 | 
         $ENV{QUERY_STRING} = $u->query;  | 
| 
625
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
626
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else  | 
| 
627
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
628
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
138
 | 
         delete $ENV{QUERY_STRING};  | 
| 
629
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
630
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
631
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
632
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # This is a way of letting Perl test scripts to run under  | 
| 
633
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # the same Perl version that CGI::Test is running with  | 
| 
634
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
635
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
636
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
229
 | 
     $ENV{PERL} = $^X;  | 
| 
637
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
638
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
639
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Make sure the script sees the same @INC as we do currently.  | 
| 
640
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # This is very important when running a regression test suite, to  | 
| 
641
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # make sure any CGI script using the module we're testing will see  | 
| 
642
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # the files from the build directory.  | 
| 
643
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
644
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Since we're about to chdir() to the cgi-bin directory, we must anchor  | 
| 
645
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # any relative path to the current working directory.  | 
| 
646
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
647
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     my $path_sep = WINDOWS ? ';' : ':';  | 
| 
648
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
649
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
613
 | 
     $ENV{PERL5LIB} = join($path_sep, map {-e $_ ? abs_path($_) : $_} @INC);  | 
| 
 
 | 
167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8919
 | 
    | 
| 
650
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
651
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Also make sure that temp directory is available for the script,  | 
| 
652
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # else older CGI.pm may choke and default to some not-quite-sane  | 
| 
653
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # values that do not work in Windows  | 
| 
654
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
655
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
96
 | 
     $ENV{TMPDIR} = $this->tmp_dir;  | 
| 
656
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
657
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
658
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Now run the script, changing the current directory to the location  | 
| 
659
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # of the script, as a web server would.  | 
| 
660
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     #  | 
| 
661
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
662
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1918
 | 
     my $directory = dirname($script);  | 
| 
663
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
377
 | 
     my $basename  = basename($script);  | 
| 
664
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
665
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
286
 | 
     chdir $directory or die "can't cd to $directory: $!";  | 
| 
666
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
667
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
103
 | 
     if ( WINDOWS ) {  | 
| 
668
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         my $cmd_line = $input ? "$basename < ${in_fname} > ${out_fname}"  | 
| 
669
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                      :          "$basename < NUL >${out_fname}"  | 
| 
670
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                      ;  | 
| 
671
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
672
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         exec $cmd_line;  | 
| 
673
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
674
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
675
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
         exec "./$basename";  | 
| 
676
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
677
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
678
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     die "could not exec $script: $!";  | 
| 
679
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
680
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
681
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
682
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
683
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ->_parse_header  | 
| 
684
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
685
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Look for a set of leading HTTP headers in the file, and insert them  | 
| 
686
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # into a hash table (we don't expect duplicates).  | 
| 
687
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
688
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Returns ref to hash containing the headers.  | 
| 
689
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
690
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ######################################################################  | 
| 
691
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _parse_header  | 
| 
692
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 {  | 
| 
693
 | 
28
 | 
 
 | 
 
 | 
  
28
  
 | 
 
 | 
96
 | 
     my $this = shift;  | 
| 
694
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
126
 | 
     my ($file) = @_;  | 
| 
695
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
92
 | 
     my %header;  | 
| 
696
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
216
 | 
     local *FILE;  | 
| 
697
 | 
28
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1987
 | 
     open(FILE, $file) || warn "can't open $file: $!";  | 
| 
698
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
168
 | 
     local $_;  | 
| 
699
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     my $field;  | 
| 
700
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
701
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
772
 | 
     while ()  | 
| 
702
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
703
 | 
72
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
619
 | 
         last if /^\015?\012$/ || /^\015\012$/;  | 
| 
704
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
420
 | 
         s/\015?\012$//;  | 
| 
705
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
564
 | 
         if (s/^\s+/ /)  | 
| 
 
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
706
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
707
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             last if $field eq '';    # Cannot be a header  | 
| 
708
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             $header{$field} .= $_ if $field ne '';  | 
| 
709
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
710
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         elsif (($field, my $value) = /^([\w-]+)\s*:\s*(.*)/)  | 
| 
711
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
712
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
493
 | 
             $field =~ s/(\w+)/\u\L$1/g;    # Normalize spelling  | 
| 
713
 | 
44
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
148
 | 
             if (exists $header{$field})  | 
| 
714
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             {  | 
| 
715
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 warn "duplicate $field header in $file";  | 
| 
716
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 $header{$field} .= " ";  | 
| 
717
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
718
 | 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
390
 | 
             $header{$field} .= $value;  | 
| 
719
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
720
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         else  | 
| 
721
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         {  | 
| 
722
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             warn "mangled header in $file";  | 
| 
723
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             %header = ();                  # Discard what we read sofar  | 
| 
724
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
             last;  | 
| 
725
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
726
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
727
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
249
 | 
     close FILE;  | 
| 
728
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
225
 | 
     return \%header;  | 
| 
729
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
730
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
731
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
732
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
733
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 NAME  | 
| 
734
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
735
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CGI::Test - CGI regression test framework  | 
| 
736
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
737
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 SYNOPSIS  | 
| 
738
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
739
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # In some t/script.t regression test, for instance  | 
| 
740
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  use CGI::Test;  | 
| 
741
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  use Test::More tests => 7;  | 
| 
742
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
743
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $ct = CGI::Test->new(  | 
| 
744
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -base_url   => "http://some.server:1234/cgi-bin",  | 
| 
745
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -cgi_dir    => "/path/to/cgi-bin",  | 
| 
746
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  );  | 
| 
747
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
748
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $page = $ct->GET("http://some.server:1234/cgi-bin/script?arg=1");  | 
| 
749
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  like $page->content_type, qr|text/html\b|, "Content type";  | 
| 
750
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
751
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $form = $page->forms->[0];  | 
| 
752
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  is $form->action, "/cgi-bin/some_target", "Form action URI";  | 
| 
753
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
754
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $menu = $form->menu_by_name("months");  | 
| 
755
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  ok $menu->is_selected("January"), "January selected";  | 
| 
756
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  ok !$menu->is_selected("March"),  "March not selected";  | 
| 
757
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  ok $menu->multiple,               "Menu is multi-choice";  | 
| 
758
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
759
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $send = $form->submit_by_name("send_form");  | 
| 
760
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  ok defined $send, "Send form defined";  | 
| 
761
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
762
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  #  | 
| 
763
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # Now interact with the CGI  | 
| 
764
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  #  | 
| 
765
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
766
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $menu->select("March");        # "click" on the March label  | 
| 
767
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  my $answer = $send->press;     # "click" on the send button  | 
| 
768
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
769
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # and make sure we don't get an HTTP error  | 
| 
770
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  ok $answer->is_ok, "Answer response";  | 
| 
771
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
772
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 DESCRIPTION  | 
| 
773
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
774
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C module provides a CGI regression test framework which  | 
| 
775
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 allows you to run your CGI programs offline, i.e. outside a web server,  | 
| 
776
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and interact with them programmatically, without the need to type data  | 
| 
777
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and click from a web browser.  | 
| 
778
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
779
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If you're using the C module, you may be familiar with its offline  | 
| 
780
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 testing mode.  However, this mode is appropriate for simple things, and  | 
| 
781
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 there is no support for conducting a full session with a stateful script.  | 
| 
782
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C fills this gap by providing the necessary infrastructure to  | 
| 
783
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 run CGI scripts, then parse the output to construct objects that can be  | 
| 
784
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 queried, and on which you can interact to "play" with the script's control  | 
| 
785
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 widgets, finally submitting data back.  And so on...  | 
| 
786
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
787
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note that the CGI scripts you can test with C need not be  | 
| 
788
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 implemented in Perl at all.  As far as this framework is concerned, CGI  | 
| 
789
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 scripts are executables that are run on a CGI-like environment and which  | 
| 
790
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 produce an output.  | 
| 
791
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
792
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 To use the C framework, you need to configure a C  | 
| 
793
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 object to act like a web server, by providing the URL base where  | 
| 
794
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CGI scripts lie on this pseudo-server, and which physical directory  | 
| 
795
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 corresponds to that URL base.  | 
| 
796
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
797
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 From then on, you may issue GET and POST requests giving an URL, and  | 
| 
798
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the pseudo-server returns a C object representing the  | 
| 
799
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 outcome of the request.  This page may be an error, plain text, some  | 
| 
800
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 binary data, or an HTML page (see L for details).  | 
| 
801
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
802
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The latter (an HTML page) can contain one or more CGI forms (identified  | 
| 
803
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by CFORME> tags), which are described by instances of  | 
| 
804
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C objects (see L for details).  | 
| 
805
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
806
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Forms can be queried to see whether they contain a particular type  | 
| 
807
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 of widget (menu, text area, button, etc...), of a particular name  | 
| 
808
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (that's the CGI parameter name).  Once found, one may interact with  | 
| 
809
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a widget as the user would from a browser.  Widgets are described by  | 
| 
810
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 polymorphic objects which conform to the C type.  | 
| 
811
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The specific interaction that is offered depends on the dynamic type of  | 
| 
812
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the object (see L for details).  | 
| 
813
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
814
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 An interaction with a form ends by a submission of the form data to the  | 
| 
815
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 server, and getting a reply back.  This is done by pressing a submit button,  | 
| 
816
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and the press() routine returns a new page.  Naturally, no server is  | 
| 
817
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 contacted at all within the C framework, and the CGI script is  | 
| 
818
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ran through a proper call to one of the GET/POST method on the  | 
| 
819
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C object.  | 
| 
820
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
821
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 INTERFACE  | 
| 
822
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
823
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Creation Interface  | 
| 
824
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
825
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The creation routine C takes the following mandatory parameters:  | 
| 
826
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
827
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
828
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
829
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C<-base_url> => I  | 
| 
830
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
831
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Defines the URL domain which is handled by C.  | 
| 
832
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This is the URL of the C directory.  | 
| 
833
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
834
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note that there is no need to have something actually running on the  | 
| 
835
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 specified host or port, and the server name can be any host name,  | 
| 
836
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 whether it exists or not.  For instance, if you say:  | 
| 
837
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
838
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -base_url => "http://foo.example.com:70/cgi-bin"  | 
| 
839
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
840
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 you simply declare that the C object will know how to handle  | 
| 
841
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a GET request for, say:  | 
| 
842
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
843
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     http://foo.example.com:70/cgi-bin/script  | 
| 
844
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
845
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and it will do so I, without contacting C  | 
| 
846
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 on port 70...  | 
| 
847
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
848
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C<-cgi_dir> => I  | 
| 
849
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
850
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Defines the physical path corresponding to the C directory defined  | 
| 
851
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the C<-base_url> parameter.  | 
| 
852
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
853
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For instance, given the settings:  | 
| 
854
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
855
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -base_url => "http://foo.example.com:70/cgi-bin",  | 
| 
856
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -cgi_dir  => "/home/ram/cgi/test"  | 
| 
857
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
858
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 then requesting  | 
| 
859
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
860
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     http://foo.example.com:70/cgi-bin/script  | 
| 
861
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
862
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 will actually run  | 
| 
863
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
864
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     /home/ram/cgi/test/script  | 
| 
865
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
866
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Those things are really easier to understand via examples than via  | 
| 
867
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 formal descriptions, aren't they?  | 
| 
868
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
869
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
870
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
871
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The following optional arguments may also be provided:  | 
| 
872
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
873
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
874
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
875
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C<-cgi_env> => I  | 
| 
876
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
877
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Defines additional environment variables that must be set, or changes  | 
| 
878
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 hardwirted defaults.  Some variables like C really depend  | 
| 
879
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 on the request and will be dynamically computed by C.  | 
| 
880
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
881
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For instance:  | 
| 
882
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
883
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     -cgi_env => {  | 
| 
884
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         HTTP_USER_AGENT     => "Mozilla/4.76",  | 
| 
885
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         AUTH_TYPE           => "Digest",  | 
| 
886
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
887
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
888
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 See L for more details on which environment  | 
| 
889
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 variables are defined, and which may be superseded.  | 
| 
890
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
891
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C<-doc_dir> => I  | 
| 
892
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
893
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This defines the root directory of the HTTP server, for path translation.  | 
| 
894
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It defaults to C.  | 
| 
895
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
896
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 B: C only serves CGI scripts for now, so this setting  | 
| 
897
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 is not terribly useful, unless you care about C.  | 
| 
898
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
899
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C<-tmp_dir> => I  | 
| 
900
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
901
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The temporary directory to use for internal files created while processing  | 
| 
902
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requests.  Defaults to the value of the environment variable C,  | 
| 
903
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 or C if it is not set.  | 
| 
904
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
905
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
906
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
907
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Object Interface  | 
| 
908
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
909
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The following methods, listed in alphabetical order, are available:  | 
| 
910
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
911
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
912
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
913
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C I [, I]  | 
| 
914
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
915
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Issues an HTTP GET request of the specified URL, given as the string  | 
| 
916
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I.  It must be in the http scheme, and must lie within the  | 
| 
917
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 configured CGI space (i.e. under the base URL given at creation time  | 
| 
918
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 via C<-base_url>).  | 
| 
919
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
920
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Optionally, you may specify the name of an authenticated user as the  | 
| 
921
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I string. C will simply setup the CGI environment  | 
| 
922
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 variable C accordingly.  Since we're in a testing framework,  | 
| 
923
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 you can pretend to be anyone you like.  See L  | 
| 
924
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 for more information on environment variables, and in particular  | 
| 
925
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C.  | 
| 
926
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
927
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C returns a C polymorphic object, i.e. an object whose  | 
| 
928
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 dynamic type is an heir of C.  See L for  | 
| 
929
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 more information on this class hierarchy.  | 
| 
930
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
931
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C I, I [, I]  | 
| 
932
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
933
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Issues an HTTP POST request of the specified URL.  See C above for  | 
| 
934
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a discussion on I and I, which applies to C  | 
| 
935
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 as well.  | 
| 
936
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
937
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The I parameter must be a C object.  | 
| 
938
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It specifies the CGI parameters to be sent to the script.  Users normally  | 
| 
939
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 don't issue POST requests manually: they are the result of submits on  | 
| 
940
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 forms, which are obtained via an initial GET.  Nonetheless, you can  | 
| 
941
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 create your own input easily and issue a "faked" POST request, to see  | 
| 
942
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 how your script might react to inconsistent (and probably malicious)  | 
| 
943
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 input for instance.  See L to learn how to construct  | 
| 
944
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 suitable input.  | 
| 
945
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
946
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C returns a C polymorphic object, like C does.  | 
| 
947
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
948
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
949
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
950
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The base path in the URL space of the base URL configured at creation time.  | 
| 
951
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It's the URL with the scheme, host and port information removed.  | 
| 
952
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
953
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
954
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
955
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The configured CGI root directory where scripts to be run are held.  | 
| 
956
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
957
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
958
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
959
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The configured document root directory.  | 
| 
960
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
961
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
962
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
963
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The host and port of the base URL you configured at creation time.  | 
| 
964
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
965
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C I  | 
| 
966
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
967
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Splits an URI object into server (host and port), path and query components.  | 
| 
968
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The path is simplified using UNIX semantics, i.e. C is ignored and  | 
| 
969
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 stripped, and C is resolved by forgetting the path component that  | 
| 
970
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 immediately precedes it (no attempt is made to make sure the translated path  | 
| 
971
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 was indeed pointing to an existing directory: simplification happens in the  | 
| 
972
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 path space).  | 
| 
973
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
974
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the list (host, path, query).  | 
| 
975
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
976
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
977
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
978
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The temporary directory that is being used.  | 
| 
979
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
980
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
981
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
982
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns hashref with parsed HTTP headers received from CGI script.  | 
| 
983
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
984
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
985
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
986
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 CGI ENVIRONMENT VARIABLES  | 
| 
987
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
988
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The CGI protocol defines a set of environment variables which are to be set  | 
| 
989
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the web server before invoking the script.  The environment created by  | 
| 
990
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C conforms to the CGI/1.1 specifications.  | 
| 
991
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
992
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Here is a list of all the known variables.  Some of those are marked  | 
| 
993
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I.  It means you may choose to set them via the C<-cgi_env>  | 
| 
994
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 switch of the C routine, but your settings will have no effect and  | 
| 
995
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C will always compute a suitable value.  | 
| 
996
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
997
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Variables are listed in alphabetical order:  | 
| 
998
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
999
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
1000
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1001
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1002
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1003
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The authentication scheme used to authenticate the user given by C.  | 
| 
1004
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This variable is not present in the environment if there was no user specified  | 
| 
1005
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 in the GET/POST requests.  | 
| 
1006
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1007
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 By default, it is set to "Basic" when present.  | 
| 
1008
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1009
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1010
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1011
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable, giving the length of data to be read on STDIN by POST  | 
| 
1012
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requests (as told by C).  If is not present for GET requests.  | 
| 
1013
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1014
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1015
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1016
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable, giving the MIME type of data to be read on STDIN by POST  | 
| 
1017
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requests (as told by C).  If is not present for GET requests.  | 
| 
1018
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1019
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1020
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1021
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The Common Gateway Interface (CGI) version specification.  | 
| 
1022
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Defaults to "CGI/1.1".  | 
| 
1023
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1024
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1025
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1026
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The set of Content-Type that are said to be accepted by the client issuing  | 
| 
1027
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the HTTP request.  Since there is no browser making any request here, the  | 
| 
1028
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 default is set to "*/*".  | 
| 
1029
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1030
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It is up to your script to honour the value of this variable if it wishes to  | 
| 
1031
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 be nice with the client.  | 
| 
1032
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1033
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1034
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1035
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The charset that is said to be accepted by the client issuing the HTTP  | 
| 
1036
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 request.  Since there is no browser making any request here, the  | 
| 
1037
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 default is set to "iso-8859-1".  | 
| 
1038
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1039
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1040
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1041
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Whether the connection should be kept alive by the server or closed after  | 
| 
1042
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 this request.  Defaults to "Close", but since there's no connection and  | 
| 
1043
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 no real client...  | 
| 
1044
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1045
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1046
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1047
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This is the host processing the HTTP request.  | 
| 
1048
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It is a read-only variable, set to the hostname and port parts of the  | 
| 
1049
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requested URL.  | 
| 
1050
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1051
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1052
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1053
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The user agent tag string.  This can be used by scripts to emit code that  | 
| 
1054
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 can be understood by the client, and is also further abused to derive the  | 
| 
1055
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 OS type where the user agent runs.  | 
| 
1056
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1057
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 In order to be as neutral as possible, it is set to "CGI::Test" by default.  | 
| 
1058
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1059
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1060
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1061
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable set to the extra path information part of the requested URL.  | 
| 
1062
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Always present, even if empty.  | 
| 
1063
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1064
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1065
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1066
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This read-only variable is only present when there is a non-empty C  | 
| 
1067
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 variable.  It is simply set to the value of C with the document  | 
| 
1068
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 rootdir path prepended to it (the value of the C<-doc_dir> creation argument).  | 
| 
1069
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1070
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1071
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1072
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This very important read-only variable is the query string present in the  | 
| 
1073
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requested URL.  Note that it may very well be set even for a POST request.  | 
| 
1074
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1075
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1076
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1077
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The IP address of the client making the requst.  Can be used to implement  | 
| 
1078
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 an access policy from within the script.  Here, given that there's no real  | 
| 
1079
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 client, the default is set to "127.0.0.1", which is the IP of the local  | 
| 
1080
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 loopback interface.  | 
| 
1081
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1082
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1083
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1084
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The DNS-translated hostname of the IP address held in C.  | 
| 
1085
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Here, for testing purposes, it is not computed after C but can  | 
| 
1086
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 be freely set.  Defaults to "localhost".  | 
| 
1087
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1088
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1089
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1090
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This read-only variable is only present when making an authenticated GET or  | 
| 
1091
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 POST request.  Its value is the name of the user we are supposed to have  | 
| 
1092
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 successfully authenticated, using the scheme held in C.  | 
| 
1093
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1094
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1095
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1096
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable, whose value is either C or C.  | 
| 
1097
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1098
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1099
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable set to the filesystem path of the CGI script being run.  | 
| 
1101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Read-only variable set to the virtual  path of the CGI script being run,  | 
| 
1105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 i.e. the path given in the requested URL.  | 
| 
1106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The host name running the server, which defaults to the host name present  | 
| 
1110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 in the base URL, provided at creation time as the C<-base_url> argument.  | 
| 
1111
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The port where the server listens, which defaults to the port present  | 
| 
1115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 in the base URL, provided at creation time as the C<-base_url> argument.  | 
| 
1116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If no port was explicitely given, 80 is assumed.  | 
| 
1117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The protocol which must be followed when replying to the client request.  | 
| 
1121
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Set to "HTTP/1.1" by default.  | 
| 
1122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1123
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
1124
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The name of the server software.  Defaults to "CGI::Test".  | 
| 
1126
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1127
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
1128
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 BUGS  | 
| 
1130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1131
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 There are some, most probably.  Please notify me about them.  | 
| 
1132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The following limitations (in decreasing amount of importance)  | 
| 
1134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 are known and may be lifted one day -- patches welcome:  | 
| 
1135
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
1137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item *  | 
| 
1139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 There is no support for cookies.  A CGI installing cookies and expecting  | 
| 
1141
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 them to be resent on further invocations to friendly scripts is bound  | 
| 
1142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 to disappointment.  | 
| 
1143
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1144
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item *  | 
| 
1145
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 There is no support for plain document retrieval: only CGI scripts can  | 
| 
1147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 be fetched by an HTTP request for now.  | 
| 
1148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1149
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
1150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 PUBLIC REPOSITORY  | 
| 
1152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CGI::Test now has a publicly accessible Git server provided by Github.com:  | 
| 
1154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 L  | 
| 
1155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1156
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 REPORTING BUGS  | 
| 
1157
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Please use Github issue tracker to open bug reports and maintenance  | 
| 
1159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requests.  | 
| 
1160
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 AUTHORS  | 
| 
1162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1163
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The original author is Raphael Manfredi.  | 
| 
1164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Steven Hilton was long time maintainer of this module.  | 
| 
1166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Current maintainer is Alex Tokarev Ftokarev@cpan.orgE>.  | 
| 
1168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1169
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 LICENSE  | 
| 
1170
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This program is free software; you can redistribute it and/or modify  | 
| 
1172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it under the terms of the Artistic License, a copy of which can be  | 
| 
1173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 found with Perl 5.6.0.  | 
| 
1174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This program is distributed in the hope that it will be useful,  | 
| 
1176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 but WITHOUT ANY WARRANTY; without even the implied warranty of  | 
| 
1177
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  | 
| 
1178
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Artistic License for more details.  | 
| 
1179
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 SEE ALSO  | 
| 
1181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CGI(3), CGI::Test::Page(3), CGI::Test::Form(3), CGI::Test::Input(3),  | 
| 
1183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CGI::Test::Form::Widget(3), HTTP::Status(3), URI(3).  | 
| 
1184
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1185
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
1186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    |