File Coverage

blib/lib/CGI/Test.pm
Criterion Covered Total %
statement 223 268 83.2
branch 60 112 53.5
condition 10 17 58.8
subroutine 26 31 83.8
pod 9 15 60.0
total 328 443 74.0


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   332926 use strict;
  23         43  
  23         784  
12 23     23   76 use warnings;
  23         31  
  23         445  
13              
14 23     23   79 use Carp;
  23         32  
  23         1419  
15 23     23   13453 use HTTP::Status;
  23         54411  
  23         4198  
16 23     23   9345 use URI;
  23         107296  
  23         599  
17 23     23   15375 use File::Temp qw(mkstemp);
  23         350097  
  23         1334  
18 23     23   150 use File::Spec;
  23         28  
  23         356  
19 23     23   78 use File::Basename;
  23         20  
  23         1534  
20 23     23   101 use Cwd qw(abs_path);
  23         33  
  23         745  
21              
22 23     23   248 use vars qw($VERSION);
  23         20  
  23         1625  
23              
24             $VERSION = '1.100';
25              
26 23     23   99 use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
  23         26  
  23         30  
  23         61482  
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 28659 my $this = bless {}, shift;
45 25         92 my %params = @_;
46              
47 25         74 my $ubase = $params{-base_url};
48 25         53 my $dir = $params{-cgi_dir};
49 25   50     154 my $doc = $params{-doc_dir} || ".";
50 25   50     339 my $tmp = $params{-tmp_dir} || $ENV{TMPDIR} || $ENV{TEMP} || "/tmp";
51 25         92 my $env = $params{-cgi_env};
52              
53 25         202 my $uri = URI->new($ubase);
54 25 50       111687 croak "-base_url $ubase is not within the http scheme"
55             unless $uri->scheme eq 'http';
56              
57 25         2703 my ($server, $path) = $this->split_uri($uri);
58 25         311 $this->{host_port} = $server;
59 25         75 $this->{scheme} = $uri->scheme;
60 25         315 $this->{host} = $uri->host;
61 25         586 $this->{port} = $uri->port;
62 25         438 $this->{base_path} = $path;
63 25         49 $this->{cgi_dir} = $dir;
64 25         47 $this->{tmp_dir} = $tmp;
65 25 100       68 $env = {} unless defined $env;
66 25         60 $this->{cgi_env} = $env;
67 25         58 $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         130 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         908 while (my ($key, $value) = each %dflt)
89             {
90 300 100       796 $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         89 $this->{_obj_type} = {'text/plain' => 'Text',
99             'text/html' => 'HTML',
100             };
101              
102 25         281 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 69 my $this = shift;
122 44         111 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 66 my $this = shift;
156 44         128 return $this->{base_path};
157             }
158              
159             ######################################################################
160             sub cgi_dir
161             {
162 44     44 1 74 my $this = shift;
163 44         108 return $this->{cgi_dir};
164             }
165              
166             ######################################################################
167             sub doc_dir
168             {
169 16     16 1 46 my $this = shift;
170 16         163 return $this->{doc_dir};
171             }
172              
173             ######################################################################
174             sub tmp_dir
175             {
176 44     44 1 70 my $this = shift;
177 44         534 return $this->{tmp_dir};
178             }
179              
180             ######################################################################
181             sub cgi_env
182             {
183 210     210 0 196 my $this = shift;
184 210         2184 return $this->{cgi_env};
185             }
186              
187             ######################################################################
188             sub _obj_type
189             {
190 28     28   60 my $this = shift;
191 28         218 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   2284 my $this = shift;
214 69         99 my ($dir) = @_;
215 69 50       360 my $root = ($dir =~ s|^/||) ? "/" : "";
216 69         79 my @cur;
217 69         256 foreach my $item (split(m|/|, $dir))
218             {
219 119 50       221 next if $item eq '.';
220 119 50       193 if ($item eq '..')
221             {
222 0         0 pop(@cur);
223             }
224             else
225             {
226 119         204 push(@cur, $item);
227             }
228             }
229 69         186 my $path = $root . join('/', @cur);
230 69         501 $path =~ tr|/||s;
231 69         343 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 110 my $this = shift;
244 69         99 my ($uri) = @_;
245 69         230 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 5990 my $this = shift;
263 42         69 my ($uri, $user) = @_;
264              
265 42         459 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   70 my $this = shift;
300 44         70 my ($uri, $user, $input) = @_; # $input defined for POST
301              
302 44         157 my $u = URI->new($uri);
303 44 50       2201 croak "URI $uri is not within the http scheme"
304             unless $u->scheme eq 'http';
305              
306 44         9714 require CGI::Test::Page::Error;
307 44         116 my $error = "CGI::Test::Page::Error";
308              
309 44         134 my ($userver, $upath, $uquery) = $this->split_uri($u);
310 44         576 my $server = $this->host_port;
311 44         127 my $base_path = $this->base_path . "/";
312              
313 44 50       149 croak "URI $uri is not located on server $server"
314             unless $userver eq $server;
315              
316 44 50       172 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         81 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         100 my $cgi_dir = $this->cgi_dir;
329 44         138 my @components = split(m|/|, $upath);
330 44         51 my @script;
331              
332 44         122 while (@components)
333             {
334 47         65 my $item = shift @components;
335 47 100       1501 if (-e File::Spec->catfile($cgi_dir, @script, $item))
336             {
337 44         159 push(@script, $item);
338             }
339             else
340             {
341 3         6 unshift @components, $item;
342 3         6 last;
343             }
344             }
345              
346 44         249 my $script = File::Spec->catfile($cgi_dir, @script); # Real
347 44         107 my $script_name = $base_path . join("/", @script); # Virtual
348 44         92 my $path = "/" . join("/", @components); # Virtual
349              
350 44 50       338 return $error->new(RC_NOT_FOUND, $this) unless -f $script;
351 44 50       349 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         672 local $SIG{PIPE} = 'IGNORE';
359 44         145 local (*PREAD, *PWRITE);
360            
361 44         55 my ($in_fh, $out_fh, $in_fname, $out_fname);
362            
363 44 100       121 if (defined $input) {
364             # In Windows, we use temp files instead of pipes to avoid
365             # stream duplication errors
366 2 50       14 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       44 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         8 -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         158 ($out_fh, $out_fname) =
399             mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_out.XXXXXX"));
400            
401 44 50       1952895 close $out_fh if WINDOWS;
402              
403 44         362 select((select(STDOUT), $| = 1)[ 0 ]);
404 44         145 print STDOUT ""; # Flush STDOUT before forking
405              
406             #
407             # Fork...
408             #
409              
410 44         34377 my $pid = fork;
411 44 50       1150 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       997 if ($pid == 0) {
421 16 100 66     770 close PWRITE if defined $input && !WINDOWS; # Writing side of the pipe
422            
423 16         1316 $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       1429 close $out_fh unless WINDOWS;
442            
443 28 100 66     280 if (defined $input && !WINDOWS)
444             { # Send POST input data
445 1         36 close PREAD;
446 1         81 syswrite PWRITE, $input->data, $input->length;
447 1 50       6 close PWRITE or warn "failure while closing pipe: $!";
448             }
449              
450 28         19475048 my $child = waitpid $pid, 0;
451              
452 28 50       315 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       145 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     329 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         114 $this->{http_headers} = $header;
487              
488             #
489             # Create proper page object, which will parse the results file as needed.
490             #
491              
492 28         111 my $type = $header->{'Content-Type'};
493 28         81 my $base_type = lc($type);
494 28         164 $base_type =~ s/;.*//; # Strip type parameters
495 28   50     194 my $objtype = $this->_obj_type->{$base_type} || "Other";
496 28         70 $objtype = "CGI::Test::Page::$objtype";
497              
498 28         3095 eval "require $objtype";
499 28 50       197 die "can't load module $objtype: $@" if chop $@;
500              
501 28         361 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       139 if ($in_fname) {
510 0 0       0 unlink $in_fname or warn "can't unlink $in_fname: $!";
511             }
512            
513 28 50       3125 unlink $out_fname or warn "can't unlink $out_fname: $!";
514              
515 28         898 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   187 my $this = shift;
536              
537 16         835 my %params = @_;
538              
539 16         142 my $script = $params{-script_file};
540 16         81 my $name = $params{-script_name};
541 16         137 my $user = $params{-user};
542 16         273 my $in = $params{-in};
543 16         88 my $in_fname = $params{-in_fname};
544 16         82 my $out = $params{-out};
545 16         100 my $out_fname = $params{-out_fname};
546 16         86 my $u = $params{-uri};
547 16         86 my $path = $params{-path_info};
548 16         51 my $input = $params{-input};
549              
550             #
551             # Connect file descriptors.
552             #
553              
554 16 50       239 if ( !WINDOWS ) {
555 16 100       248 if (defined $in)
556             {
557 1 50       62 open(STDIN, '<&=' . fileno($in)) || die "can't redirect STDIN: $!";
558             }
559             else
560             {
561 15         1194 my $devnull = File::Spec->devnull;
562 15 50       1792 open(STDIN, $devnull) || die "can't open $devnull: $!";
563             }
564 16 50       592 open(STDOUT, '>&=' . fileno($out)) || die "can't redirect STDOUT: $!";
565             }
566              
567             #
568             # Setup default CGI environment.
569             #
570              
571 16         57 while (my ($key, $value) = each %{$this->cgi_env})
  210         464  
572             {
573 194         1116 $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       105 if (defined $input)
582             {
583 1         9 $ENV{CONTENT_TYPE} = $input->mime_type;
584 1         22 $ENV{CONTENT_LENGTH} = $input->length;
585             }
586             else
587             {
588 15         137 delete $ENV{CONTENT_TYPE};
589 15         91 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       165 $ENV{REQUEST_METHOD} = defined $input ? "POST" : "GET";
598 16         103 $ENV{PATH_INFO} = $path;
599 16         77 $ENV{SCRIPT_NAME} = $name;
600 16         59 $ENV{SCRIPT_FILENAME} = $script;
601 16         528 $ENV{HTTP_HOST} = $u->host_port;
602              
603 16 50       1920 if (length $path)
604             {
605 16         140 $ENV{PATH_TRANSLATED} = $this->doc_dir . $path;
606             }
607             else
608             {
609 0         0 delete $ENV{PATH_TRANSLATED};
610             }
611              
612 16 100       67 if (defined $user)
613             {
614 1         9 $ENV{REMOTE_USER} = $user;
615             }
616             else
617             {
618 15         62 delete $ENV{REMOTE_USER};
619 15         47 delete $ENV{AUTH_TYPE};
620             }
621              
622 16 100       195 if (defined $u->query)
623             {
624 12         284 $ENV{QUERY_STRING} = $u->query;
625             }
626             else
627             {
628 4         111 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         211 $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       128 my $path_sep = WINDOWS ? ';' : ':';
648              
649 16 50       836 $ENV{PERL5LIB} = join($path_sep, map {-e $_ ? abs_path($_) : $_} @INC);
  167         9037  
650              
651             #
652             # Now run the script, changing the current directory to the location
653             # of the script, as a web server would.
654             #
655              
656 16         1993 my $directory = dirname($script);
657 16         414 my $basename = basename($script);
658              
659 16 50       326 chdir $directory or die "can't cd to $directory: $!";
660              
661 16 50       103 if ( WINDOWS ) {
662 0 0       0 my $cmd_line = $input ? "$basename < ${in_fname} > ${out_fname}"
663             : "$basename < NUL >${out_fname}"
664             ;
665              
666 0         0 exec $cmd_line;
667             }
668             else {
669 16         0 exec "./$basename";
670             }
671              
672 0         0 die "could not exec $script: $!";
673             }
674              
675             ######################################################################
676             #
677             # ->_parse_header
678             #
679             # Look for a set of leading HTTP headers in the file, and insert them
680             # into a hash table (we don't expect duplicates).
681             #
682             # Returns ref to hash containing the headers.
683             #
684             ######################################################################
685             sub _parse_header
686             {
687 28     28   122 my $this = shift;
688 28         141 my ($file) = @_;
689 28         73 my %header;
690 28         196 local *FILE;
691 28 50       1671 open(FILE, $file) || warn "can't open $file: $!";
692 28         176 local $_;
693 28         100 my $field;
694              
695 28         719 while ()
696             {
697 72 100 66     692 last if /^\015?\012$/ || /^\015\012$/;
698 44         396 s/\015?\012$//;
699 44 50       582 if (s/^\s+/ /)
    50          
700             {
701 0 0       0 last if $field eq ''; # Cannot be a header
702 0 0       0 $header{$field} .= $_ if $field ne '';
703             }
704             elsif (($field, my $value) = /^([\w-]+)\s*:\s*(.*)/)
705             {
706 44         514 $field =~ s/(\w+)/\u\L$1/g; # Normalize spelling
707 44 50       158 if (exists $header{$field})
708             {
709 0         0 warn "duplicate $field header in $file";
710 0         0 $header{$field} .= " ";
711             }
712 44         409 $header{$field} .= $value;
713             }
714             else
715             {
716 0         0 warn "mangled header in $file";
717 0         0 %header = (); # Discard what we read sofar
718 0         0 last;
719             }
720             }
721 28         254 close FILE;
722 28         237 return \%header;
723             }
724              
725             1;
726              
727             =head1 NAME
728              
729             CGI::Test - CGI regression test framework
730              
731             =head1 SYNOPSIS
732              
733             # In some t/script.t regression test, for instance
734             use CGI::Test;
735             use Test::More tests => 7;
736              
737             my $ct = CGI::Test->new(
738             -base_url => "http://some.server:1234/cgi-bin",
739             -cgi_dir => "/path/to/cgi-bin",
740             );
741              
742             my $page = $ct->GET("http://some.server:1234/cgi-bin/script?arg=1");
743             like $page->content_type, qr|text/html\b|, "Content type";
744              
745             my $form = $page->forms->[0];
746             is $form->action, "/cgi-bin/some_target", "Form action URI";
747              
748             my $menu = $form->menu_by_name("months");
749             ok $menu->is_selected("January"), "January selected";
750             ok !$menu->is_selected("March"), "March not selected";
751             ok $menu->multiple, "Menu is multi-choice";
752              
753             my $send = $form->submit_by_name("send_form");
754             ok defined $send, "Send form defined";
755              
756             #
757             # Now interact with the CGI
758             #
759              
760             $menu->select("March"); # "click" on the March label
761             my $answer = $send->press; # "click" on the send button
762            
763             # and make sure we don't get an HTTP error
764             ok $answer->is_ok, "Answer response";
765              
766             =head1 DESCRIPTION
767              
768             The C module provides a CGI regression test framework which
769             allows you to run your CGI programs offline, i.e. outside a web server,
770             and interact with them programmatically, without the need to type data
771             and click from a web browser.
772              
773             If you're using the C module, you may be familiar with its offline
774             testing mode. However, this mode is appropriate for simple things, and
775             there is no support for conducting a full session with a stateful script.
776             C fills this gap by providing the necessary infrastructure to
777             run CGI scripts, then parse the output to construct objects that can be
778             queried, and on which you can interact to "play" with the script's control
779             widgets, finally submitting data back. And so on...
780              
781             Note that the CGI scripts you can test with C need not be
782             implemented in Perl at all. As far as this framework is concerned, CGI
783             scripts are executables that are run on a CGI-like environment and which
784             produce an output.
785              
786             To use the C framework, you need to configure a C
787             object to act like a web server, by providing the URL base where
788             CGI scripts lie on this pseudo-server, and which physical directory
789             corresponds to that URL base.
790              
791             From then on, you may issue GET and POST requests giving an URL, and
792             the pseudo-server returns a C object representing the
793             outcome of the request. This page may be an error, plain text, some
794             binary data, or an HTML page (see L for details).
795              
796             The latter (an HTML page) can contain one or more CGI forms (identified
797             by CFORME> tags), which are described by instances of
798             C objects (see L for details).
799              
800             Forms can be queried to see whether they contain a particular type
801             of widget (menu, text area, button, etc...), of a particular name
802             (that's the CGI parameter name). Once found, one may interact with
803             a widget as the user would from a browser. Widgets are described by
804             polymorphic objects which conform to the C type.
805             The specific interaction that is offered depends on the dynamic type of
806             the object (see L for details).
807              
808             An interaction with a form ends by a submission of the form data to the
809             server, and getting a reply back. This is done by pressing a submit button,
810             and the press() routine returns a new page. Naturally, no server is
811             contacted at all within the C framework, and the CGI script is
812             ran through a proper call to one of the GET/POST method on the
813             C object.
814              
815             =head1 INTERFACE
816              
817             =head2 Creation Interface
818              
819             The creation routine C takes the following mandatory parameters:
820              
821             =over 4
822              
823             =item C<-base_url> => I
824              
825             Defines the URL domain which is handled by C.
826             This is the URL of the C directory.
827              
828             Note that there is no need to have something actually running on the
829             specified host or port, and the server name can be any host name,
830             whether it exists or not. For instance, if you say:
831              
832             -base_url => "http://foo.example.com:70/cgi-bin"
833              
834             you simply declare that the C object will know how to handle
835             a GET request for, say:
836              
837             http://foo.example.com:70/cgi-bin/script
838              
839             and it will do so I, without contacting C
840             on port 70...
841              
842             =item C<-cgi_dir> => I
843              
844             Defines the physical path corresponding to the C directory defined
845             by the C<-base_url> parameter.
846              
847             For instance, given the settings:
848              
849             -base_url => "http://foo.example.com:70/cgi-bin",
850             -cgi_dir => "/home/ram/cgi/test"
851              
852             then requesting
853              
854             http://foo.example.com:70/cgi-bin/script
855              
856             will actually run
857              
858             /home/ram/cgi/test/script
859              
860             Those things are really easier to understand via examples than via
861             formal descriptions, aren't they?
862              
863             =back
864              
865             The following optional arguments may also be provided:
866              
867             =over 4
868              
869             =item C<-cgi_env> => I
870              
871             Defines additional environment variables that must be set, or changes
872             hardwirted defaults. Some variables like C really depend
873             on the request and will be dynamically computed by C.
874              
875             For instance:
876              
877             -cgi_env => {
878             HTTP_USER_AGENT => "Mozilla/4.76",
879             AUTH_TYPE => "Digest",
880             }
881              
882             See L for more details on which environment
883             variables are defined, and which may be superseded.
884              
885             =item C<-doc_dir> => I
886              
887             This defines the root directory of the HTTP server, for path translation.
888             It defaults to C.
889              
890             B: C only serves CGI scripts for now, so this setting
891             is not terribly useful, unless you care about C.
892              
893             =item C<-tmp_dir> => I
894              
895             The temporary directory to use for internal files created while processing
896             requests. Defaults to the value of the environment variable C,
897             or C if it is not set.
898              
899             =back
900              
901             =head2 Object Interface
902              
903             The following methods, listed in alphabetical order, are available:
904              
905             =over 4
906              
907             =item C I [, I]
908              
909             Issues an HTTP GET request of the specified URL, given as the string
910             I. It must be in the http scheme, and must lie within the
911             configured CGI space (i.e. under the base URL given at creation time
912             via C<-base_url>).
913              
914             Optionally, you may specify the name of an authenticated user as the
915             I string. C will simply setup the CGI environment
916             variable C accordingly. Since we're in a testing framework,
917             you can pretend to be anyone you like. See L
918             for more information on environment variables, and in particular
919             C.
920              
921             C returns a C polymorphic object, i.e. an object whose
922             dynamic type is an heir of C. See L for
923             more information on this class hierarchy.
924              
925             =item C I, I [, I]
926              
927             Issues an HTTP POST request of the specified URL. See C above for
928             a discussion on I and I, which applies to C
929             as well.
930              
931             The I parameter must be a C object.
932             It specifies the CGI parameters to be sent to the script. Users normally
933             don't issue POST requests manually: they are the result of submits on
934             forms, which are obtained via an initial GET. Nonetheless, you can
935             create your own input easily and issue a "faked" POST request, to see
936             how your script might react to inconsistent (and probably malicious)
937             input for instance. See L to learn how to construct
938             suitable input.
939              
940             C returns a C polymorphic object, like C does.
941              
942             =item C
943              
944             The base path in the URL space of the base URL configured at creation time.
945             It's the URL with the scheme, host and port information removed.
946              
947             =item C
948              
949             The configured CGI root directory where scripts to be run are held.
950              
951             =item C
952              
953             The configured document root directory.
954              
955             =item C
956              
957             The host and port of the base URL you configured at creation time.
958              
959             =item C I
960              
961             Splits an URI object into server (host and port), path and query components.
962             The path is simplified using UNIX semantics, i.e. C is ignored and
963             stripped, and C is resolved by forgetting the path component that
964             immediately precedes it (no attempt is made to make sure the translated path
965             was indeed pointing to an existing directory: simplification happens in the
966             path space).
967              
968             Returns the list (host, path, query).
969              
970             =item C
971              
972             The temporary directory that is being used.
973              
974             =item C
975              
976             Returns hashref with parsed HTTP headers received from CGI script.
977              
978             =back
979              
980             =head1 CGI ENVIRONMENT VARIABLES
981              
982             The CGI protocol defines a set of environment variables which are to be set
983             by the web server before invoking the script. The environment created by
984             C conforms to the CGI/1.1 specifications.
985              
986             Here is a list of all the known variables. Some of those are marked
987             I. It means you may choose to set them via the C<-cgi_env>
988             switch of the C routine, but your settings will have no effect and
989             C will always compute a suitable value.
990              
991             Variables are listed in alphabetical order:
992              
993             =over 4
994              
995             =item C
996              
997             The authentication scheme used to authenticate the user given by C.
998             This variable is not present in the environment if there was no user specified
999             in the GET/POST requests.
1000              
1001             By default, it is set to "Basic" when present.
1002              
1003             =item C
1004              
1005             Read-only variable, giving the length of data to be read on STDIN by POST
1006             requests (as told by C). If is not present for GET requests.
1007              
1008             =item C
1009              
1010             Read-only variable, giving the MIME type of data to be read on STDIN by POST
1011             requests (as told by C). If is not present for GET requests.
1012              
1013             =item C
1014              
1015             The Common Gateway Interface (CGI) version specification.
1016             Defaults to "CGI/1.1".
1017              
1018             =item C
1019              
1020             The set of Content-Type that are said to be accepted by the client issuing
1021             the HTTP request. Since there is no browser making any request here, the
1022             default is set to "*/*".
1023              
1024             It is up to your script to honour the value of this variable if it wishes to
1025             be nice with the client.
1026              
1027             =item C
1028              
1029             The charset that is said to be accepted by the client issuing the HTTP
1030             request. Since there is no browser making any request here, the
1031             default is set to "iso-8859-1".
1032              
1033             =item C
1034              
1035             Whether the connection should be kept alive by the server or closed after
1036             this request. Defaults to "Close", but since there's no connection and
1037             no real client...
1038              
1039             =item C
1040              
1041             This is the host processing the HTTP request.
1042             It is a read-only variable, set to the hostname and port parts of the
1043             requested URL.
1044              
1045             =item C
1046              
1047             The user agent tag string. This can be used by scripts to emit code that
1048             can be understood by the client, and is also further abused to derive the
1049             OS type where the user agent runs.
1050              
1051             In order to be as neutral as possible, it is set to "CGI::Test" by default.
1052              
1053             =item C
1054              
1055             Read-only variable set to the extra path information part of the requested URL.
1056             Always present, even if empty.
1057              
1058             =item C
1059              
1060             This read-only variable is only present when there is a non-empty C
1061             variable. It is simply set to the value of C with the document
1062             rootdir path prepended to it (the value of the C<-doc_dir> creation argument).
1063              
1064             =item C
1065              
1066             This very important read-only variable is the query string present in the
1067             requested URL. Note that it may very well be set even for a POST request.
1068              
1069             =item C
1070              
1071             The IP address of the client making the requst. Can be used to implement
1072             an access policy from within the script. Here, given that there's no real
1073             client, the default is set to "127.0.0.1", which is the IP of the local
1074             loopback interface.
1075              
1076             =item C
1077              
1078             The DNS-translated hostname of the IP address held in C.
1079             Here, for testing purposes, it is not computed after C but can
1080             be freely set. Defaults to "localhost".
1081              
1082             =item C
1083              
1084             This read-only variable is only present when making an authenticated GET or
1085             POST request. Its value is the name of the user we are supposed to have
1086             successfully authenticated, using the scheme held in C.
1087              
1088             =item C
1089              
1090             Read-only variable, whose value is either C or C.
1091              
1092             =item C
1093              
1094             Read-only variable set to the filesystem path of the CGI script being run.
1095              
1096             =item C
1097              
1098             Read-only variable set to the virtual path of the CGI script being run,
1099             i.e. the path given in the requested URL.
1100              
1101             =item C
1102              
1103             The host name running the server, which defaults to the host name present
1104             in the base URL, provided at creation time as the C<-base_url> argument.
1105              
1106             =item C
1107              
1108             The port where the server listens, which defaults to the port present
1109             in the base URL, provided at creation time as the C<-base_url> argument.
1110             If no port was explicitely given, 80 is assumed.
1111              
1112             =item C
1113              
1114             The protocol which must be followed when replying to the client request.
1115             Set to "HTTP/1.1" by default.
1116              
1117             =item C
1118              
1119             The name of the server software. Defaults to "CGI::Test".
1120              
1121             =back
1122              
1123             =head1 BUGS
1124              
1125             There are some, most probably. Please notify me about them.
1126              
1127             The following limitations (in decreasing amount of importance)
1128             are known and may be lifted one day -- patches welcome:
1129              
1130             =over 4
1131              
1132             =item *
1133              
1134             There is no support for cookies. A CGI installing cookies and expecting
1135             them to be resent on further invocations to friendly scripts is bound
1136             to disappointment.
1137              
1138             =item *
1139              
1140             There is no support for plain document retrieval: only CGI scripts can
1141             be fetched by an HTTP request for now.
1142              
1143             =back
1144              
1145             =head1 PUBLIC REPOSITORY
1146              
1147             CGI::Test now has a publicly accessible Git server provided by Github.com:
1148             L
1149              
1150             =head1 REPORTING BUGS
1151              
1152             Please use Github issue tracker to open bug reports and maintenance
1153             requests.
1154              
1155             =head1 AUTHORS
1156              
1157             The original author is Raphael Manfredi.
1158              
1159             Steven Hilton was long time maintainer of this module.
1160              
1161             Current maintainer is Alex Tokarev Ftokarev@cpan.orgE>.
1162              
1163             =head1 LICENSE
1164              
1165             This program is free software; you can redistribute it and/or modify
1166             it under the terms of the Artistic License, a copy of which can be
1167             found with Perl 5.6.0.
1168              
1169             This program is distributed in the hope that it will be useful,
1170             but WITHOUT ANY WARRANTY; without even the implied warranty of
1171             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1172             Artistic License for more details.
1173              
1174             =head1 SEE ALSO
1175              
1176             CGI(3), CGI::Test::Page(3), CGI::Test::Form(3), CGI::Test::Input(3),
1177             CGI::Test::Form::Widget(3), HTTP::Status(3), URI(3).
1178              
1179             =cut
1180