File Coverage

blib/lib/CGI/Test.pm
Criterion Covered Total %
statement 224 269 83.2
branch 60 112 53.5
condition 10 17 58.8
subroutine 26 31 83.8
pod 9 15 60.0
total 329 444 74.1


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