File Coverage

blib/lib/CGI/Simple.pm
Criterion Covered Total %
statement 618 742 83.2
branch 363 506 71.7
condition 118 171 69.0
subroutine 114 126 90.4
pod 69 90 76.6
total 1282 1635 78.4


line stmt bran cond sub pod time code
1             package CGI::Simple;
2              
3             require 5.006001;
4              
5             # this module is both strict (and warnings) compliant, but they are only used
6             # in testing as they add an unnecessary compile time overhead in production.
7 19     19   1133763 use strict;
  19         168  
  19         568  
8             #use warnings;
9 19     19   90 use Carp;
  19         34  
  19         1332  
10              
11 19     19   140 use vars qw(*in);
  19         39  
  19         25826  
12             our ($VERSION, $USE_CGI_PM_DEFAULTS, $DISABLE_UPLOADS, $POST_MAX,
13             $NO_UNDEF_PARAMS, $USE_PARAM_SEMICOLONS, $PARAM_UTF8, $HEADERS_ONCE,
14             $NPH, $DEBUG, $NO_NULL, $FATAL);
15              
16             $VERSION = "1.280";
17              
18             # you can hard code the global variable settings here if you want.
19             # warning - do not delete the unless defined $VAR part unless you
20             # want to permanently remove the ability to change the variable.
21             sub _initialize_globals {
22              
23             # set this to 1 to use CGI.pm default global settings
24 105 100   105   377 $USE_CGI_PM_DEFAULTS = 0
25             unless defined $USE_CGI_PM_DEFAULTS;
26              
27             # see if user wants old CGI.pm defaults
28 105 100       259 if ( $USE_CGI_PM_DEFAULTS ) {
29 43         219 _use_cgi_pm_global_settings();
30 43         71 return;
31             }
32              
33             # no file uploads by default, set to 0 to enable uploads
34 62 100       132 $DISABLE_UPLOADS = 1
35             unless defined $DISABLE_UPLOADS;
36              
37             # use a post max of 100K, set to -1 for no limits
38 62 100       151 $POST_MAX = 102_400
39             unless defined $POST_MAX;
40              
41             # set to 1 to not include undefined params parsed from query string
42 62 100       121 $NO_UNDEF_PARAMS = 0
43             unless defined $NO_UNDEF_PARAMS;
44              
45             # separate the name=value pairs with ; rather than &
46 62 100       114 $USE_PARAM_SEMICOLONS = 0
47             unless defined $USE_PARAM_SEMICOLONS;
48              
49             # return everything as utf-8
50 62   50     260 $PARAM_UTF8 ||= 0;
51 62 50       112 $PARAM_UTF8 and require Encode;
52              
53             # only print headers once
54 62 100       121 $HEADERS_ONCE = 0
55             unless defined $HEADERS_ONCE;
56              
57             # Set this to 1 to enable NPH scripts
58 62 100       119 $NPH = 0
59             unless defined $NPH;
60              
61             # 0 => no debug, 1 => from @ARGV, 2 => from STDIN
62 62 100       136 $DEBUG = 0
63             unless defined $DEBUG;
64              
65             # filter out null bytes in param - value pairs
66 62 100       111 $NO_NULL = 1
67             unless defined $NO_NULL;
68              
69             # set behavior when cgi_err() called -1 => silent, 0 => carp, 1 => croak
70 62 100       131 $FATAL = -1
71             unless defined $FATAL;
72             }
73              
74             # I happen to disagree with many of the default global settings in CGI.pm
75             # This sub is called if you set $CGI::Simple::USE_CGI_PM_GLOBALS = 1; or
76             # invoke the '-default' pragma via a use CGI::Simple qw(-default);
77             sub _use_cgi_pm_global_settings {
78 66     66   5936 $USE_CGI_PM_DEFAULTS = 1;
79 66 100       242 $DISABLE_UPLOADS = 0 unless defined $DISABLE_UPLOADS;
80 66 100       237 $POST_MAX = -1 unless defined $POST_MAX;
81 66 100       151 $NO_UNDEF_PARAMS = 0 unless defined $NO_UNDEF_PARAMS;
82 66 100       149 $USE_PARAM_SEMICOLONS = 1 unless defined $USE_PARAM_SEMICOLONS;
83 66 100       125 $HEADERS_ONCE = 0 unless defined $HEADERS_ONCE;
84 66 100       149 $NPH = 0 unless defined $NPH;
85 66 100       134 $DEBUG = 1 unless defined $DEBUG;
86 66 100       161 $NO_NULL = 0 unless defined $NO_NULL;
87 66 100       240 $FATAL = -1 unless defined $FATAL;
88 66 100       218 $PARAM_UTF8 = 0 unless defined $PARAM_UTF8;
89             }
90              
91             # this is called by new, we will never directly reference the globals again
92             sub _store_globals {
93 111     111   10816 my $self = shift;
94              
95 111         638 $self->{'.globals'}->{'DISABLE_UPLOADS'} = $DISABLE_UPLOADS;
96 111         249 $self->{'.globals'}->{'POST_MAX'} = $POST_MAX;
97 111         213 $self->{'.globals'}->{'NO_UNDEF_PARAMS'} = $NO_UNDEF_PARAMS;
98 111         189 $self->{'.globals'}->{'USE_PARAM_SEMICOLONS'} = $USE_PARAM_SEMICOLONS;
99 111         316 $self->{'.globals'}->{'HEADERS_ONCE'} = $HEADERS_ONCE;
100 111         256 $self->{'.globals'}->{'NPH'} = $NPH;
101 111         314 $self->{'.globals'}->{'DEBUG'} = $DEBUG;
102 111         388 $self->{'.globals'}->{'NO_NULL'} = $NO_NULL;
103 111         313 $self->{'.globals'}->{'FATAL'} = $FATAL;
104 111         246 $self->{'.globals'}->{'USE_CGI_PM_DEFAULTS'} = $USE_CGI_PM_DEFAULTS;
105 111         248 $self->{'.globals'}->{'PARAM_UTF8'} = $PARAM_UTF8;
106             }
107              
108             # use the automatic calling of the import sub to set our pragmas. CGI.pm compat
109             sub import {
110 25     25   13652 my ( $self, @args ) = @_;
111              
112             # arguments supplied in the 'use CGI::Simple [ARGS];' will now be in @args
113 25         20574 foreach ( @args ) {
114 31 100       14416 $USE_CGI_PM_DEFAULTS = 1, next if m/^-default/i;
115 20 100       43 $DISABLE_UPLOADS = 1, next if m/^-no.?upload/i;
116 18 100       36 $DISABLE_UPLOADS = 0, next if m/^-upload/i;
117 16 100       42 $HEADERS_ONCE = 1, next if m/^-unique.?header/i;
118 14 100       29 $NPH = 1, next if m/^-nph/i;
119 11 100       22 $DEBUG = 0, next if m/^-no.?debug/i;
120 9 50       30 $DEBUG = defined $1 ? $1 : 2, next if m/^-debug(\d)?/i;
    100          
121 7 100       17 $USE_PARAM_SEMICOLONS = 1, next if m/^-newstyle.?url/i;
122 5 100       15 $USE_PARAM_SEMICOLONS = 0, next if m/^-oldstyle.?url/i;
123 3 50       14 $NO_UNDEF_PARAMS = 1, next if m/^-no.?undef.?param/i;
124 0 0       0 $FATAL = 0, next if m/^-carp/i;
125 0 0       0 $FATAL = 1, next if m/^-croak/i;
126 0         0 croak "Pragma '$_' is not defined in CGI::Simple\n";
127             }
128             }
129              
130             # used in CGI.pm .t files
131             sub _reset_globals {
132 21     21   1662 _use_cgi_pm_global_settings();
133             }
134              
135             binmode STDIN;
136             binmode STDOUT;
137              
138             # use correct encoding conversion to handle non ASCII char sets.
139             # we import and install the complex routines only if we have to.
140             BEGIN {
141              
142             sub url_decode {
143 622     622 1 1834 my ( $self, $decode ) = @_;
144 622 100       966 return () unless defined $decode;
145 620         896 $decode =~ tr/+/ /;
146 620         1334 $decode =~ s/%([a-fA-F0-9]{2})/ pack "C", hex $1 /eg;
  814         2007  
147 620         1325 return $decode;
148             }
149              
150             sub url_encode {
151 568     568 1 2856 my ( $self, $encode ) = @_;
152 568 100       851 return () unless defined $encode;
153 566         951 $encode
154 632         1558 =~ s/([^A-Za-z0-9\-_.!~*'() ])/ uc sprintf "%%%02x",ord $1 /eg;
155 566         727 $encode =~ tr/ /+/;
156 566         1339 return $encode;
157             }
158              
159 19     19   89492 if ( "\t" ne "\011" ) {
160             eval { require CGI::Simple::Util };
161             if ( $@ ) {
162             croak
163             "Your server is using not using ASCII, you must install CGI::Simple::Util, error: $@";
164             }
165              
166             # hack the symbol table and replace simple encode/decode subs
167             *CGI::Simple::url_encode
168             = sub { CGI::Simple::Util::escape( $_[1] ) };
169             *CGI::Simple::url_decode
170             = sub { CGI::Simple::Util::unescape( $_[1] ) };
171             }
172             }
173              
174             ################ The Guts ################
175              
176             sub new {
177 103     103 1 25514 my ( $class, $init ) = @_;
178 103   33     826 $class = ref( $class ) || $class;
179 103         442 my $self = {};
180 103         309 bless $self, $class;
181 103 50       390 if ( $self->_mod_perl ) {
182 0 0       0 if ( $init ) {
183 0         0 $self->{'.mod_perl_request'} = $init;
184 0         0 undef $init; # otherwise _initialize takes the wrong path
185             }
186 0         0 $self->_initialize_mod_perl();
187             }
188 103         514 $self->_initialize_globals;
189 103         457 $self->_store_globals;
190 103         414 $self->_initialize( $init );
191 103         1380 return $self;
192             }
193              
194             sub _mod_perl {
195             return (
196             exists $ENV{MOD_PERL}
197             or ( $ENV{GATEWAY_INTERFACE}
198 103   33 103   1047 and $ENV{GATEWAY_INTERFACE} =~ m{^CGI-Perl/} )
199             );
200             }
201              
202             # Return the global request object under mod_perl. If you use mod_perl 2
203             # and you don't set PerlOptions +GlobalRequest then the request must be
204             # passed in to the new() method.
205             sub _mod_perl_request {
206 0     0   0 my $self = shift;
207              
208 0         0 my $mp = $self->{'.mod_perl'};
209              
210 0 0       0 return unless $mp;
211              
212 0         0 my $req = $self->{'.mod_perl_request'};
213 0 0       0 return $req if $req;
214              
215 0         0 $self->{'.mod_perl_request'} = do {
216 0 0       0 if ( $mp == 2 ) {
217 0         0 Apache2::RequestUtil->request;
218             }
219             else {
220 0         0 Apache->request;
221             }
222             };
223             }
224              
225             sub _initialize_mod_perl {
226 0     0   0 my ( $self ) = @_;
227              
228 0         0 eval "require mod_perl";
229              
230 0 0       0 if ( defined $mod_perl::VERSION ) {
231              
232 0 0       0 if ( $mod_perl::VERSION >= 2.00 ) {
233 0         0 $self->{'.mod_perl'} = 2;
234              
235 0         0 require Apache2::RequestRec;
236 0         0 require Apache2::RequestIO;
237 0         0 require Apache2::RequestUtil;
238 0         0 require Apache2::Response;
239 0         0 require APR::Pool;
240              
241 0         0 my $r = $self->_mod_perl_request();
242              
243 0 0       0 if ( defined $r ) {
244 0 0       0 $r->subprocess_env unless exists $ENV{REQUEST_METHOD};
245 0         0 $r->pool->cleanup_register(
246             \&CGI::Simple::_initialize_globals );
247             }
248             }
249             else {
250 0         0 $self->{'.mod_perl'} = 1;
251              
252 0         0 require Apache;
253              
254 0         0 my $r = $self->_mod_perl_request();
255              
256 0 0       0 if ( defined $r ) {
257 0         0 $r->register_cleanup( \&CGI::Simple::_initialize_globals );
258             }
259             }
260             }
261             }
262              
263             sub _initialize {
264 103     103   239 my ( $self, $init ) = @_;
265              
266 103 100       527 if ( !defined $init ) {
    100          
    100          
    100          
267              
268             # initialize from QUERY_STRING, STDIN or @ARGV
269 71         299 $self->_read_parse();
270             }
271             elsif ( ( ref $init ) =~ m/HASH/i ) {
272              
273             # initialize from param hash
274 8         20 for my $param ( keys %{$init} ) {
  8         32  
275 14         42 $self->_add_param( $param, $init->{$param} );
276             }
277             }
278              
279             # chromatic's blessed GLOB patch
280             # elsif ( (ref $init) =~ m/GLOB/i ) { # initialize from a file
281             elsif ( UNIVERSAL::isa( $init, 'GLOB' ) ) { # initialize from a file
282 2         10 $self->_read_parse( $init );
283             }
284             elsif ( ( ref $init ) eq 'CGI::Simple' ) {
285              
286             # initialize from a CGI::Simple object
287 1         766 require Data::Dumper;
288              
289             # avoid problems with strict when Data::Dumper returns $VAR1
290 1         7366 my $VAR1;
291 1         4 my $clone = eval( Data::Dumper::Dumper( $init ) );
292 1 50       7 if ( $@ ) {
293 0         0 $self->cgi_error( "Can't clone CGI::Simple object: $@" );
294             }
295             else {
296 1         6 $_[0] = $clone;
297             }
298             }
299             else {
300 21         61 $self->_parse_params( $init ); # initialize from a query string
301             }
302             }
303              
304             sub _internal_read($*\$;$) {
305 14     14   128 my ( $self, $glob, $buffer, $len ) = @_;
306 14 100       179 $len = 4096 if !defined $len;
307 14 50       167 if ( $self->{'.mod_perl'} ) {
308 0         0 my $r = $self->_mod_perl_request();
309 0         0 $r->read( $$buffer, $len );
310             }
311             else {
312 14         10001518 read( $glob, $$buffer, $len );
313             }
314             }
315              
316             sub _read_parse {
317 73     73   138 my $self = shift;
318 73   100     604 my $handle = shift || \*STDIN;
319              
320 73         313 my $data = '';
321 73   100     427 my $type = $ENV{'CONTENT_TYPE'} || 'No CONTENT_TYPE received';
322 73   100     495 my $length = $ENV{'CONTENT_LENGTH'} || 0;
323 73   100     239 my $method = $ENV{'REQUEST_METHOD'} || 'No REQUEST_METHOD received';
324              
325             # first check POST_MAX Steve Purkis pointed out the previous bug
326 73 50 100     620 if ( ( $method eq 'POST' or $method eq "PUT" )
      100        
      66        
327             and $self->{'.globals'}->{'POST_MAX'} != -1
328             and $length > $self->{'.globals'}->{'POST_MAX'} ) {
329 0         0 $self->cgi_error(
330             "413 Request entity too large: $length bytes on STDIN exceeds \$POST_MAX!"
331             );
332              
333             # silently discard data ??? better to just close the socket ???
334 0         0 while ( $length > 0 ) {
335 0 0       0 last unless _internal_read( $self, $handle, my $buffer );
336 0         0 $length -= length( $buffer );
337             }
338              
339 0         0 return;
340             }
341              
342 73 100 100     1043 if ( $length and $type =~ m|^multipart/form-data|i ) {
    100 100        
    100 100        
343 2         10 my $got_length = $self->_parse_multipart( $handle );
344 2 50       19 if ( $length != $got_length ) {
345 0         0 $self->cgi_error(
346             "500 Bad read on multipart/form-data! wanted $length, got $got_length"
347             );
348             }
349              
350 2         8 return;
351             }
352             elsif ( $method eq 'POST' or $method eq 'PUT' ) {
353 12 50       130 if ( $length ) {
354              
355             # we may not get all the data we want with a single read on large
356             # POSTs as it may not be here yet! Credit Jason Luther for patch
357             # CGI.pm < 2.99 suffers from same bug
358 12         167 _internal_read( $self, $handle, $data, $length );
359 12         111 while ( length( $data ) < $length ) {
360 0 0       0 last unless _internal_read( $self, $handle, my $buffer );
361 0         0 $data .= $buffer;
362             }
363              
364 12 50       108 unless ( $length == length $data ) {
365 0         0 $self->cgi_error( "500 Bad read on POST! wanted $length, got "
366             . length( $data ) );
367 0         0 return;
368             }
369              
370 12 100       214 if ( $type !~ m|^application/x-www-form-urlencoded| ) {
371 6         225 $self->_add_param( $method . "DATA", $data );
372             }
373             else {
374 6         171 $self->_parse_params( $data );
375             }
376             }
377             }
378             elsif ( $method eq 'GET' or $method eq 'HEAD' ) {
379             $data
380             = $self->{'.mod_perl'}
381             ? $self->_mod_perl_request()->args()
382             : $ENV{'QUERY_STRING'}
383 54 50 100     440 || $ENV{'REDIRECT_QUERY_STRING'}
384             || '';
385 54         167 $self->_parse_params( $data );
386             }
387             else {
388 5 100 66     41 unless ( $self->{'.globals'}->{'DEBUG'}
389             and $data = $self->read_from_cmdline() ) {
390 3         19 $self->cgi_error( "400 Unknown method $method" );
391 3         9 return;
392             }
393              
394 2 50       6 unless ( $data ) {
395              
396             # I liked this reporting but CGI.pm does not behave like this so
397             # out it goes......
398             # $self->cgi_error("400 No data received via method: $method, type: $type");
399 0         0 return;
400             }
401              
402 2         5 $self->_parse_params( $data );
403             }
404             }
405              
406             sub _parse_params {
407 102     102   213 my ( $self, $data ) = @_;
408 102 50       246 return () unless defined $data;
409 102 100       571 unless ( $data =~ /[&=;]/ ) {
410 12         49 $self->{'keywords'} = [ $self->_parse_keywordlist( $data ) ];
411 12         39 return;
412             }
413 90         571 my @pairs = split /[&;]/, $data;
414 90         260 for my $pair ( @pairs ) {
415 300         982 my ( $param, $value ) = split /=/, $pair, 2;
416 300 50       606 next unless defined $param;
417 300 100       457 $value = '' unless defined $value;
418 300         634 $self->_add_param( $self->url_decode( $param ),
419             $self->url_decode( $value ) );
420             }
421             }
422              
423             sub _add_param {
424 388     388   862 my ( $self, $param, $value, $overwrite ) = @_;
425 388 100 66     1364 return () unless defined $param and defined $value;
426 384 100       859 $param =~ tr/\000//d if $self->{'.globals'}->{'NO_NULL'};
427 384 100       761 @{ $self->{$param} } = () if $overwrite;
  29         69  
428 384 100       743 @{ $self->{$param} } = () unless exists $self->{$param};
  199         571  
429 384 100       1072 my @values = ref $value ? @{$value} : ( $value );
  51         107  
430 384         790 for my $value ( @values ) {
431             next
432             if $value eq ''
433 440 100 100     816 and $self->{'.globals'}->{'NO_UNDEF_PARAMS'};
434             $value =~ tr/\000//d
435 436 50 66     1457 if $self->{'.globals'}->{'NO_NULL'} and $param ne 'PUTDATA' and $param ne 'POSTDATA';
      66        
436             $value = Encode::decode( utf8 => $value )
437 436 0 33     912 if $self->{'.globals'}->{PARAM_UTF8} and $param ne 'PUTDATA' and $param ne 'POSTDATA';
      33        
438 436         509 push @{ $self->{$param} }, $value;
  436         877  
439 436 100       1078 unless ( $self->{'.fieldnames'}->{$param} ) {
440 206         262 push @{ $self->{'.parameters'} }, $param;
  206         398  
441 206         496 $self->{'.fieldnames'}->{$param}++;
442             }
443             }
444 384         901 return scalar @values; # for compatibility with CGI.pm request.t
445             }
446              
447             sub _parse_keywordlist {
448 16     16   53 my ( $self, $data ) = @_;
449 16 50       57 return () unless defined $data;
450 16         46 $data = $self->url_decode( $data );
451 16 100       60 $data =~ tr/\000//d if $self->{'.globals'}->{'NO_NULL'};
452 16         131 my @keywords = split /\s+/, $data;
453 16         75 return @keywords;
454             }
455              
456             sub _massage_boundary {
457 2     2   6 my ( $self, $boundary ) = @_;
458              
459             # BUG: IE 3.01 on the Macintosh uses just the boundary,
460             # forgetting the --
461             $boundary = '--' . $boundary
462             unless exists $ENV{'HTTP_USER_AGENT'}
463 2 50 33     15 && $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+3\.0[12];\s*Mac/i;
464              
465 2         8 return quotemeta $boundary;
466             }
467              
468             sub _parse_multipart {
469 2     2   5 my $self = shift;
470 2 50       5 my $handle = shift or die "NEED A HANDLE!?";
471              
472             my ( $boundary )
473 2         16 = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
474              
475 2 50       14 $boundary = $self->_massage_boundary( $boundary ) if $boundary;
476              
477 2         4 my $got_data = 0;
478 2         6 my $data = '';
479 2   50     8 my $length = $ENV{'CONTENT_LENGTH'} || 0;
480 2         10 my $CRLF = $self->crlf;
481              
482             READ:
483              
484 2         20 while ( $got_data < $length ) {
485 2 50       11 last READ unless _internal_read( $self, $handle, my $buffer );
486 2         7 $data .= $buffer;
487 2         5 $got_data += length $buffer;
488              
489 2 50       10 unless ( $boundary ) {
490             # If we're going to guess the boundary we need a complete line.
491 0 0       0 next READ unless $data =~ /^(.*)$CRLF/o;
492 0         0 $boundary = $1;
493              
494             # Still no boundary? Give up...
495 0 0       0 unless ( $boundary ) {
496 0         0 $self->cgi_error(
497             '400 No boundary supplied for multipart/form-data' );
498 0         0 return 0;
499             }
500 0         0 $boundary = $self->_massage_boundary( $boundary );
501             }
502              
503             BOUNDARY:
504              
505 2         62 while ( $data =~ m/^$boundary$CRLF/ ) {
506             ## TAB and high ascii chars are definitivelly allowed in headers.
507             ## Not accepting them in the following regex prevents the upload of
508             ## files with filenames like "España.txt".
509             # next READ unless $data =~ m/^([\040-\176$CRLF]+?$CRLF$CRLF)/o;
510             next READ
511 7 50       106 unless $data =~ m/^([\x20-\x7E\x80-\xFF\x09$CRLF]+?$CRLF$CRLF)/o;
512 7         30 my $header = $1;
513 7         60 ( my $unfold = $1 ) =~ s/$CRLF\s+/ /og;
514 7         37 my ( $param ) = $unfold =~ m/form-data;\s+name="?([^\";]*)"?/;
515 7         186 my ( $filename )
516             = $unfold =~ m/name="?\Q$param\E"?;\s+filename="?([^\"]*)"?/;
517              
518 7 100       25 if ( defined $filename ) {
519 3         12 my ( $mime ) = $unfold =~ m/Content-Type:\s+([-\w\+\.\/]+)/io;
520 3         47 $data =~ s/^\Q$header\E//;
521 3         11 ( $got_data, $data, my $fh, my $size )
522             = $self->_save_tmpfile( $handle, $boundary, $filename,
523             $got_data, $data );
524 3         8 $self->_add_param( $param, $filename );
525 3         6 $self->{'.upload_fields'}->{$param} = $filename;
526 3 50       5 $self->{'.filehandles'}->{$filename} = $fh if $fh;
527 3 50       14 $self->{'.tmpfiles'}->{$filename}
528             = { 'size' => $size, 'mime' => $mime }
529             if $size;
530 3         16 next BOUNDARY;
531             }
532             next READ
533 4 50       142 unless $data =~ s/^\Q$header\E(.*?)$CRLF(?=$boundary)//s;
534 4         32 $self->_add_param( $param, $1 );
535             }
536 2 50       31 unless ( $data =~ m/^$boundary/ ) {
537             ## In a perfect world, $data should always begin with $boundary.
538             ## But sometimes, IE5 prepends garbage boundaries into POST(ed) data.
539             ## Then, $data does not start with $boundary and the previous block
540             ## never gets executed. The following fix attempts to remove those
541             ## extra boundaries from readed $data and restart boundary parsing.
542             ## Note about performance: with well formed data, previous check is
543             ## executed (generally) only once, when $data value is "$boundary--"
544             ## at end of parsing.
545 0 0       0 goto BOUNDARY if ( $data =~ s/.*?$CRLF(?=$boundary$CRLF)//s );
546             }
547             }
548 2         13 return $got_data;
549             }
550              
551             sub _save_tmpfile {
552 3     3   6 my ( $self, $handle, $boundary, $filename, $got_data, $data ) = @_;
553 3         4 my $fh;
554 3         6 my $CRLF = $self->crlf;
555 3   50     8 my $length = $ENV{'CONTENT_LENGTH'} || 0;
556 3         4 my $file_size = 0;
557 3 50       7 if ( $self->{'.globals'}->{'DISABLE_UPLOADS'} ) {
    0          
558 3         8 $self->cgi_error( "405 Not Allowed - File uploads are disabled" );
559             }
560             elsif ( $filename ) {
561 0         0 eval { require IO::File };
  0         0  
562 0 0       0 $self->cgi_error( "500 IO::File is not available $@" ) if $@;
563 0         0 $fh = new_tmpfile IO::File;
564 0 0       0 $self->cgi_error( "500 IO::File can't create new temp_file" )
565             unless $fh;
566             }
567              
568             # read in data until closing boundary found. buffer to catch split boundary
569             # we do this regardless of whether we save the file or not to read the file
570             # data from STDIN. if either uploads are disabled or no file has been sent
571             # $fh will be undef so only do file stuff if $fh is true using $fh && syntax
572 3 50       5 $fh && binmode $fh;
573 3         18 while ( $got_data < $length ) {
574              
575 0         0 my $buffer = $data;
576 0 0       0 last unless _internal_read( $self, \*STDIN, $data );
577              
578             # fixed hanging bug if browser terminates upload part way through
579             # thanks to Brandon Black
580 0 0       0 unless ( $data ) {
581 0         0 $self->cgi_error(
582             '400 Malformed multipart, no terminating boundary' );
583 0         0 undef $fh;
584 0         0 return $got_data;
585             }
586              
587 0         0 $got_data += length $data;
588 0 0       0 if ( "$buffer$data" =~ m/$boundary/ ) {
589 0         0 $data = $buffer . $data;
590 0         0 last;
591             }
592              
593             # we do not have partial boundary so print to file if valid $fh
594 0 0       0 $fh && print $fh $buffer;
595 0         0 $file_size += length $buffer;
596             }
597 3         30 $data =~ s/^(.*?)$CRLF(?=$boundary)//s;
598 3 50       7 $fh && print $fh $1; # print remainder of file if valid $fh
599 3         7 $file_size += length $1;
600 3         8 return $got_data, $data, $fh, $file_size;
601             }
602              
603             # Define the CRLF sequence. You can't use a simple "\r\n" because of system
604             # specific 'features'. On EBCDIC systems "\t" ne "\011" as the don't use ASCII
605             sub crlf {
606 78     78 1 2410 my ( $self, $CRLF ) = @_;
607 78 50       226 $self->{'.crlf'} = $CRLF if $CRLF; # allow value to be set manually
608 78 100       167 unless ( $self->{'.crlf'} ) {
609             my $OS = $^O
610 15   33     74 || do { require Config; $Config::Config{'osname'} };
611 15 50       86 $self->{'.crlf'}
612             = ( $OS =~ m/VMS/i ) ? "\n"
613             : ( "\t" ne "\011" ) ? "\r\n"
614             : "\015\012";
615             }
616 78         171 return $self->{'.crlf'};
617             }
618              
619             ################ The Core Methods ################
620              
621             sub param {
622 535     535 1 15485 my ( $self, $param, @p ) = @_;
623 535 100       1083 unless ( defined $param ) { # return list of all params
624             my @params
625 141 100       388 = $self->{'.parameters'} ? @{ $self->{'.parameters'} } : ();
  129         392  
626 141         582 return @params;
627             }
628 394 100       737 unless ( @p ) { # return values for $param
629 354 100       885 return () unless exists $self->{$param};
630 339 100       1030 return wantarray ? @{ $self->{$param} } : $self->{$param}->[0];
  263         948  
631             }
632 40 100 100     246 if ( $param =~ m/^-name$/i and @p == 1 ) {
633 15 100       64 return () unless exists $self->{ $p[0] };
634 11 100       66 return wantarray ? @{ $self->{ $p[0] } } : $self->{ $p[0] }->[0];
  2         8  
635             }
636              
637             # set values using -name=>'foo',-value=>'bar' syntax.
638             # also allows for $q->param( 'foo', 'some', 'new', 'values' ) syntax
639 25 100       100 ( $param, undef, @p ) = @p
640             if $param =~ m/^-name$/i; # undef represents -value token
641 25 100       136 $self->_add_param( $param, ( ref $p[0] eq 'ARRAY' ? $p[0] : [@p] ),
642             'overwrite' );
643 25 100       114 return wantarray ? @{ $self->{$param} } : $self->{$param}->[0];
  6         22  
644             }
645              
646             # a new method that provides access to a new internal routine. Useage:
647             # $q->add_param( $param, $value, $overwrite )
648             # $param must be a plain scalar
649             # $value may be either a scalar or an array ref
650             # if $overwrite is a true value $param will be overwritten with new values.
651             sub add_param {
652 16     16 1 5647 _add_param( @_ );
653             }
654              
655             sub param_fetch {
656 6     6 1 2005 my ( $self, $param, @p ) = @_;
657 6 100 100     41 $param
658             = ( defined $param and $param =~ m/^-name$/i ) ? $p[0] : $param;
659 6 100       20 return undef unless defined $param;
660 4 50       14 $self->_add_param( $param, [] ) unless exists $self->{$param};
661 4         12 return $self->{$param};
662             }
663              
664             # Return a parameter in the QUERY_STRING, regardless of whether a POST or GET
665             sub url_param {
666 17     17 1 3260 my ( $self, $param ) = @_;
667 17 50       67 return () unless $ENV{'QUERY_STRING'};
668 17         125 $self->{'.url_param'} = {};
669 17         45 bless $self->{'.url_param'}, 'CGI::Simple';
670 17         63 $self->{'.url_param'}->_parse_params( $ENV{'QUERY_STRING'} );
671 17         90 return $self->{'.url_param'}->param( $param );
672             }
673              
674             sub keywords {
675 19     19 1 1175 my ( $self, @values ) = @_;
676 19 100       68 $self->{'keywords'}
    100          
677             = ref $values[0] eq 'ARRAY' ? $values[0] : [@values]
678             if @values;
679             my @result
680 19 50       56 = defined( $self->{'keywords'} ) ? @{ $self->{'keywords'} } : ();
  19         58  
681 19         96 return @result;
682             }
683              
684             sub Vars {
685 17     17 1 1730 my $self = shift;
686 17   100     116 $self->{'.sep'} = shift || $self->{'.sep'} || "\0";
687 17 100       87 if ( wantarray ) {
688 10         15 my %hash;
689 10         27 for my $param ( $self->param ) {
690 20         41 $hash{$param} = join $self->{'.sep'}, $self->param( $param );
691             }
692 10         57 return %hash;
693             }
694             else {
695 7         19 my %tied;
696 7         41 tie %tied, "CGI::Simple", $self;
697 7         30 return \%tied;
698             }
699             }
700              
701 7 50   7   36 sub TIEHASH { $_[1] ? $_[1] : new $_[0] }
702              
703             sub STORE {
704 6     6   3289 my ( $q, $p, $v ) = @_;
705 6 50       26 return unless defined $v;
706 6         119 $q->param( $p, split $q->{'.sep'}, $v );
707             }
708              
709             sub FETCH {
710 7     7   201 my ( $q, $p ) = @_;
711 7 50       43 ref $q->{$p} eq "ARRAY" ? join $q->{'.sep'}, @{ $q->{$p} } : $q->{$p};
  7         42  
712             }
713 0     0   0 sub FIRSTKEY { my $a = scalar keys %{ $_[0] }; each %{ $_[0] } }
  0         0  
  0         0  
  0         0  
714 0     0   0 sub NEXTKEY { each %{ $_[0] } }
  0         0  
715 0     0   0 sub EXISTS { exists $_[0]->{ $_[1] } }
716 0     0   0 sub DELETE { $_[0]->delete( $_[1] ) }
717 0     0   0 sub CLEAR { %{ $_[0] } = () }
  0         0  
718              
719             sub append {
720 24     24 1 3826 my ( $self, $param, @p ) = @_;
721 24 100       54 return () unless defined $param;
722              
723             # set values using $q->append(-name=>'foo',-value=>'bar') syntax
724             # also allows for $q->append( 'foo', 'some', 'new', 'values' ) syntax
725 20 100       71 ( $param, undef, @p ) = @p
726             if $param =~ m/^-name$/i; # undef represents -value token
727 20 100 66     109 $self->_add_param( $param,
728             ( ( defined $p[0] and ref $p[0] ) ? $p[0] : [@p] ) );
729 20         43 return $self->param( $param );
730             }
731              
732             sub delete {
733 15     15 1 1069 my ( $self, $param ) = @_;
734 15 100       54 return () unless defined $param;
735 11 50       49 $param
736             = $param =~ m/^-name$/i
737             ? shift
738             : $param; # allow delete(-name=>'foo') syntax
739 11 50       37 return undef unless defined $self->{$param};
740 11         32 delete $self->{$param};
741 11         28 delete $self->{'.fieldnames'}->{$param};
742             $self->{'.parameters'}
743 11         21 = [ grep { $_ ne $param } @{ $self->{'.parameters'} } ];
  35         102  
  11         36  
744             }
745              
746 8     8 0 24 sub Delete { CGI::Simple::delete( @_ ) } # for method style interface
747              
748             sub delete_all {
749 6     6 1 602 my $self = shift;
750 6         12 undef %{$self};
  6         28  
751 6         15 $self->_store_globals;
752             }
753              
754 2     2 0 9 sub Delete_all { $_[0]->delete_all } # as used by CGI.pm
755              
756             sub upload {
757 17     17 1 4574 my ( $self, $filename, $writefile ) = @_;
758 17 100       39 unless ( $filename ) {
759 8 50       17 $self->cgi_error( "No filename submitted for upload to $writefile" )
760             if $writefile;
761             return $self->{'.filehandles'}
762 8 100       26 ? keys %{ $self->{'.filehandles'} }
  4         23  
763             : ();
764             }
765 9 100       47 unless ( $ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|i ) {
766 1         6 $self->cgi_error(
767             'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your
tag'
768             );
769 1         4 return undef;
770             }
771 8         18 my $fh = $self->{'.filehandles'}->{$filename};
772              
773             # allow use of upload fieldname to get filehandle
774             # this has limitation that in the event of duplicate
775             # upload field names there can only be one filehandle
776             # which will point to the last upload file
777             # access by filename does not suffer from this issue.
778             $fh
779             = $self->{'.filehandles'}->{ $self->{'.upload_fields'}->{$filename} }
780 8 50 66     46 if !$fh and defined $self->{'.upload_fields'}->{$filename};
781              
782 8 100       18 if ( $fh ) {
783 4         43 seek $fh, 0, 0; # get ready for reading
784 4 100       22 return $fh unless $writefile;
785 2         7 my $buffer;
786             my $out;
787 2 50       238 unless ( open $out, '>', $writefile ) {
788 0         0 $self->cgi_error( "500 Can't write to $writefile: $!\n" );
789 0         0 return undef;
790             }
791 2         13 binmode $out;
792 2         6 binmode $fh;
793 2         77 print $out $buffer while read( $fh, $buffer, 4096 );
794 2         116 close $out;
795 2         11 $self->{'.filehandles'}->{$filename} = undef;
796 2         5 undef $fh;
797 2         16 return 1;
798             }
799             else {
800 4         23 $self->cgi_error(
801             "No filehandle for '$filename'. Are uploads enabled (\$DISABLE_UPLOADS = 0)? Is \$POST_MAX big enough?"
802             );
803 4         12 return undef;
804             }
805             }
806              
807             sub upload_fieldnames {
808 0     0 0 0 my ( $self ) = @_;
809             return wantarray
810 0         0 ? ( keys %{ $self->{'.upload_fields'} } )
811 0 0       0 : [ keys %{ $self->{'.upload_fields'} } ];
  0         0  
812             }
813              
814             # return the file size of an uploaded file
815             sub upload_info {
816 3     3 1 7 my ( $self, $filename, $info ) = @_;
817 3 50       14 unless ( $ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|i ) {
818 0         0 $self->cgi_error(
819             'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your tag'
820             );
821 0         0 return undef;
822             }
823 3 50       5 return keys %{ $self->{'.tmpfiles'} } unless $filename;
  0         0  
824 3 50       30 return $self->{'.tmpfiles'}->{$filename}->{'mime'}
825             if $info =~ /mime/i;
826 0         0 return $self->{'.tmpfiles'}->{$filename}->{'size'};
827             }
828              
829 0     0 0 0 sub uploadInfo { &upload_info } # alias for CGI.pm compatibility
830              
831             # return all params/values in object as a query string suitable for 'GET'
832             sub query_string {
833 70     70 0 138 my $self = shift;
834 70         101 my @pairs;
835 70         175 for my $param ( $self->param ) {
836 171         330 for my $value ( $self->param( $param ) ) {
837 265 50       460 next unless defined $value;
838 265         512 push @pairs,
839             $self->url_encode( $param ) . '=' . $self->url_encode( $value );
840             }
841             }
842 70 100       435 return join $self->{'.globals'}->{'USE_PARAM_SEMICOLONS'} ? ';' : '&',
843             @pairs;
844             }
845              
846             # new method that will add QUERY_STRING data to our CGI::Simple object
847             # if the REQUEST_METHOD was 'POST'
848             sub parse_query_string {
849 2     2 1 6 my $self = shift;
850             $self->_parse_params( $ENV{'QUERY_STRING'} )
851             if defined $ENV{'QUERY_STRING'}
852 2 50 33     20 and $ENV{'REQUEST_METHOD'} eq 'POST';
853             }
854              
855             ################ Save and Restore params from file ###############
856              
857             sub _init_from_file {
858 19     19   280 use Carp qw(confess);
  19         54  
  19         35836  
859 0     0   0 confess "INIT_FROM_FILE called, stupid fucker!";
860 0         0 my ( $self, $fh ) = @_;
861 0         0 local $/ = "\n";
862 0         0 while ( my $pair = <$fh> ) {
863 0         0 chomp $pair;
864 0 0       0 return if $pair eq '=';
865 0         0 $self->_parse_params( $pair );
866             }
867             }
868              
869             sub save {
870 4     4 1 177 my ( $self, $fh ) = @_;
871 4         23 local ( $,, $\ ) = ( '', '' );
872 4 50 33     28 unless ( $fh and fileno $fh ) {
873 0         0 $self->cgi_error( 'Invalid filehandle' );
874 0         0 return undef;
875             }
876 4         13 for my $param ( $self->param ) {
877 8         21 for my $value ( $self->param( $param ) ) {
878             ;
879 16         31 print $fh $self->url_encode( $param ), '=',
880             $self->url_encode( $value ), "\n";
881             }
882             }
883 4         19 print $fh "=\n";
884             }
885              
886 3     3 0 583 sub save_parameters { save( @_ ) } # CGI.pm alias for save
887              
888             ################ Miscellaneous Methods ################
889              
890             sub parse_keywordlist {
891 4     4 1 571 _parse_keywordlist( @_ );
892             } # CGI.pm compatibility
893              
894             sub escapeHTML {
895 18     18 1 985 my ( $self, $escape, $newlinestoo ) = @_;
896 18         98 require CGI::Simple::Util;
897 18         65 $escape = CGI::Simple::Util::escapeHTML( $escape );
898 18 100       52 $escape =~ s/([\012\015])/'&#'.(ord $1).';'/eg if $newlinestoo;
  8         28  
899 18         159 return $escape;
900             }
901              
902             sub unescapeHTML {
903 135     135 1 1859 require CGI::Simple::Util;
904 135         293 return CGI::Simple::Util::unescapeHTML( $_[1] );
905             }
906              
907             sub put {
908 2     2 1 551 my $self = shift;
909 2         8 $self->print( @_ );
910             } # send output to browser
911              
912             sub print {
913 3     3 1 7 shift;
914 3         19 CORE::print( @_ );
915             } # print to standard output (for overriding in mod_perl)
916              
917             ################# Cookie Methods ################
918              
919             sub cookie {
920 28     28 1 5383 my ( $self, @params ) = @_;
921 28         124 require CGI::Simple::Cookie;
922 28         103 require CGI::Simple::Util;
923 28         117 my ( $name, $value, $path, $domain, $secure, $expires, $httponly, $samesite )
924             = CGI::Simple::Util::rearrange(
925             [
926             'NAME', [ 'VALUE', 'VALUES' ],
927             'PATH', 'DOMAIN',
928             'SECURE', 'EXPIRES',
929             'HTTPONLY', 'SAMESITE'
930             ],
931             @params
932             );
933              
934             # retrieve the value of the cookie, if no value is supplied
935 28 100       83 unless ( defined( $value ) ) {
936             $self->{'.cookies'} = CGI::Simple::Cookie->fetch
937 16 100       34 unless $self->{'.cookies'};
938 16 50       31 return () unless $self->{'.cookies'};
939              
940             # if no name is supplied, then retrieve the names of all our cookies.
941 16 100       57 return keys %{ $self->{'.cookies'} } unless $name;
  4         25  
942              
943             # return the value of the cookie
944             return
945             exists $self->{'.cookies'}->{$name}
946 12 100       47 ? $self->{'.cookies'}->{$name}->value
947             : ();
948             }
949              
950             # If we get here, we're creating a new cookie
951 12 50       380 return undef unless $name; # this is an error
952 12         23 @params = ();
953 12         24 push @params, '-name' => $name;
954 12         20 push @params, '-value' => $value;
955 12 100       23 push @params, '-domain' => $domain if $domain;
956 12 100       24 push @params, '-path' => $path if $path;
957 12 100       21 push @params, '-expires' => $expires if $expires;
958 12 100       25 push @params, '-secure' => $secure if $secure;
959 12 100       19 push @params, '-httponly' => $httponly if $httponly;
960 12 50       21 push @params, '-samesite' => $samesite if $samesite;
961 12         39 return CGI::Simple::Cookie->new( @params );
962             }
963              
964             sub raw_cookie {
965 12     12 1 2367 my ( $self, $key ) = @_;
966 12 100       28 if ( defined $key ) {
967 8 100       20 unless ( $self->{'.raw_cookies'} ) {
968 2         1788 require CGI::Simple::Cookie;
969 2         11 $self->{'.raw_cookies'} = CGI::Simple::Cookie->raw_fetch;
970             }
971 8   66     41 return $self->{'.raw_cookies'}->{$key} || ();
972             }
973 4   50     29 return $ENV{'HTTP_COOKIE'} || $ENV{'COOKIE'} || '';
974             }
975              
976             ################# Header Methods ################
977              
978             sub header {
979 45     45 1 3567 my ( $self, @params ) = @_;
980 45         198 require CGI::Simple::Util;
981 45         67 my @header;
982             return undef
983             if $self->{'.header_printed'}++
984 45 50 66     201 and $self->{'.globals'}->{'HEADERS_ONCE'};
985             my (
986 45         225 $type, $status, $cookie, $target, $expires,
987             $nph, $charset, $attachment, $p3p, @other
988             )
989             = CGI::Simple::Util::rearrange(
990             [
991             [ 'TYPE', 'CONTENT_TYPE', 'CONTENT-TYPE' ], 'STATUS',
992             [ 'COOKIE', 'COOKIES', 'SET-COOKIE' ], 'TARGET',
993             'EXPIRES', 'NPH',
994             'CHARSET', 'ATTACHMENT',
995             'P3P'
996             ],
997             @params
998             );
999              
1000 45         155 my $CRLF = $self->crlf;
1001              
1002             # CR escaping for values, per RFC 822
1003 45         100 for my $header (
1004             $type, $status, $cookie, $target, $expires,
1005             $nph, $charset, $attachment, $p3p, @other
1006             ) {
1007 408 100       691 if ( defined $header ) {
1008             # From RFC 822:
1009             # Unfolding is accomplished by regarding CRLF immediately
1010             # followed by a LWSP-char as equivalent to the LWSP-char.
1011 87         395 $header =~ s/$CRLF(\s)/$1/g;
1012              
1013             # All other uses of newlines are invalid input.
1014 87 100       268 if ( $header =~ m/$CRLF/ ) {
1015             # shorten very long values in the diagnostic
1016 6 50       15 $header = substr( $header, 0, 72 ) . '...'
1017             if ( length $header > 72 );
1018 6         60 die
1019             "Invalid header value contains a newline not followed by whitespace: $header";
1020             }
1021             }
1022             }
1023              
1024 39   66     150 $nph ||= $self->{'.globals'}->{'NPH'};
1025 39         95 $charset = $self->charset( $charset )
1026             ; # get charset (and set new charset if supplied)
1027             # rearrange() was designed for the HTML portion, so we need to fix it up a little.
1028              
1029 39         152 for ( @other ) {
1030              
1031             # Don't use \s because of perl bug 21951
1032             next
1033 14 50       267 unless my ( $header, $value ) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
1034 14         74 ( $_ = $header )
1035 14         90 =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
1036             }
1037 39 100 50     141 $type ||= 'text/html' unless defined $type;
1038 39 100 100     265 $type .= "; charset=$charset"
      66        
1039             if $type
1040             and $type =~ m!^text/!
1041             and $type !~ /\bcharset\b/;
1042 39   100     132 my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
1043 39 100 100     115 push @header, $protocol . ' ' . ( $status || '200 OK' ) if $nph;
1044 39 100       89 push @header, "Server: " . server_software() if $nph;
1045 39 100       78 push @header, "Status: $status" if $status;
1046 39 50       75 push @header, "Window-Target: $target" if $target;
1047              
1048 39 50       66 if ( $p3p ) {
1049 0 0       0 $p3p = join ' ', @$p3p if ref( $p3p ) eq 'ARRAY';
1050 0         0 push( @header, qq(P3P: policyref="/w3c/p3p.xml", CP="$p3p") );
1051             }
1052              
1053             # push all the cookies -- there may be several
1054 39 100       76 if ( $cookie ) {
1055 3 100       22 my @cookie = ref $cookie eq 'ARRAY' ? @{$cookie} : $cookie;
  1         3  
1056 3         10 for my $cookie ( @cookie ) {
1057 4 100       19 my $cs
1058             = ref $cookie eq 'CGI::Simple::Cookie'
1059             ? $cookie->as_string
1060             : $cookie;
1061 4 50       31 push @header, "Set-Cookie: $cs" if $cs;
1062             }
1063             }
1064              
1065             # if the user indicates an expiration time, then we need both an Expires
1066             # and a Date header (so that the browser is using OUR clock)
1067 39 100       94 $expires = 'now'
1068             if $self->no_cache; # encourage no caching via expires now
1069 39 100       81 push @header,
1070             "Expires: " . CGI::Simple::Util::expires( $expires, 'http' )
1071             if $expires;
1072 39 100 100     181 push @header, "Date: " . CGI::Simple::Util::expires( 0, 'http' )
      100        
1073             if defined $expires || $cookie || $nph;
1074 39 100 66     95 push @header, "Pragma: no-cache" if $self->cache or $self->no_cache;
1075 39 100       83 push @header,
1076             "Content-Disposition: attachment; filename=\"$attachment\""
1077             if $attachment;
1078 39         58 push @header, @other;
1079 39 100       130 push @header, "Content-Type: $type" if $type;
1080 39         110 my $header = join $CRLF, @header;
1081 39         71 $header .= $CRLF . $CRLF; # add the statutory two CRLFs
1082              
1083 39 50 33     104 if ( $self->{'.mod_perl'} and not $nph ) {
1084 0         0 my $r = $self->_mod_perl_request();
1085 0         0 $r->send_cgi_header( $header );
1086 0         0 return '';
1087             }
1088 39         282 return $header;
1089             }
1090              
1091             # Control whether header() will produce the no-cache Pragma directive.
1092             sub cache {
1093 43     43 1 1087 my ( $self, $value ) = @_;
1094 43 100       88 $self->{'.cache'} = $value if defined $value;
1095 43         164 return $self->{'.cache'};
1096             }
1097              
1098             # Control whether header() will produce expires now + the no-cache Pragma.
1099             sub no_cache {
1100 74     74 1 1053 my ( $self, $value ) = @_;
1101 74 100       150 $self->{'.no_cache'} = $value if defined $value;
1102 74         180 return $self->{'.no_cache'};
1103             }
1104              
1105             sub redirect {
1106 13     13 1 1977 my ( $self, @params ) = @_;
1107 13         65 require CGI::Simple::Util;
1108 13         68 my ( $url, $target, $cookie, $nph, @other )
1109             = CGI::Simple::Util::rearrange(
1110             [
1111             [ 'LOCATION', 'URI', 'URL' ], 'TARGET',
1112             [ 'COOKIE', 'COOKIES' ], 'NPH'
1113             ],
1114             @params
1115             );
1116 13   66     50 $url ||= $self->self_url;
1117 13         21 my @o;
1118 13         27 for ( @other ) { tr/\"//d; push @o, split "=", $_, 2; }
  6         15  
  6         19  
1119 13         43 unshift @o,
1120             '-Status' => '302 Found',
1121             '-Location' => $url,
1122             '-nph' => $nph;
1123 13 50       29 unshift @o, '-Target' => $target if $target;
1124 13 50       27 unshift @o, '-Cookie' => $cookie if $cookie;
1125 13         34 unshift @o, '-Type' => '';
1126 13         18 my @unescaped;
1127 13 50       29 unshift( @unescaped, '-Cookie' => $cookie ) if $cookie;
1128 13         27 return $self->header( ( map { $self->unescapeHTML( $_ ) } @o ),
  116         178  
1129             @unescaped );
1130             }
1131              
1132             ################# Server Push Methods #################
1133             # Return a Content-Type: style header for server-push
1134             # This has to be NPH, and it is advisable to set $| = 1
1135             # Credit to Ed Jordan and
1136             # Andrew Benham for this section
1137              
1138             sub multipart_init {
1139 10     10 1 2390 my ( $self, @p ) = @_;
1140 19     19   10214 use CGI::Simple::Util qw(rearrange);
  19         70  
  19         6309  
1141 10         44 my ( $boundary, @other ) = rearrange( ['BOUNDARY'], @p );
1142 10 100       29 if ( !$boundary ) {
1143 6         12 $boundary = '------- =_';
1144 6         64 my @chrs = ( '0' .. '9', 'A' .. 'Z', 'a' .. 'z' );
1145 6         15 for ( 1 .. 17 ) {
1146 102         171 $boundary .= $chrs[ rand( scalar @chrs ) ];
1147             }
1148             }
1149              
1150 10         26 my $CRLF = $self->crlf; # get CRLF sequence
1151 10         15 my $warning
1152             = "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.";
1153 10         27 $self->{'.separator'} = "$CRLF--$boundary$CRLF";
1154 10         27 $self->{'.final_separator'} = "$CRLF--$boundary--$CRLF$warning$CRLF";
1155 10         18 my $type = 'multipart/x-mixed-replace;boundary="' . $boundary . '"';
1156             return $self->header(
1157             -nph => 1,
1158             -type => $type,
1159 10         34 map { split "=", $_, 2 } @other
  0         0  
1160             )
1161             . $warning
1162             . $self->multipart_end;
1163             }
1164              
1165             sub multipart_start {
1166 6     6 1 1647 my ( $self, @p ) = @_;
1167 19     19   164 use CGI::Simple::Util qw(rearrange);
  19         31  
  19         14437  
1168 6         26 my ( $type, @other ) = rearrange( ['TYPE'], @p );
1169 6         15 foreach ( @other ) { # fix return from rearange
1170 0 0       0 next unless my ( $header, $value ) = /([^\s=]+)=\"?(.+?)\"?$/;
1171 0         0 $_ = ucfirst( lc $header ) . ': ' . unescapeHTML( 1, $value );
1172             }
1173 6   100     23 $type = $type || 'text/html';
1174 6         14 my @header = ( "Content-Type: $type" );
1175 6         12 push @header, @other;
1176 6         14 my $CRLF = $self->crlf; # get CRLF sequence
1177 6         31 return ( join $CRLF, @header ) . $CRLF . $CRLF;
1178             }
1179              
1180 12     12 1 578 sub multipart_end { return $_[0]->{'.separator'} }
1181              
1182 2     2 1 526 sub multipart_final { return $_[0]->{'.final_separator'} }
1183              
1184             ################# Debugging Methods ################
1185              
1186             sub read_from_cmdline {
1187 2     2 0 5 my @words;
1188 2 50 33     14 if ( $_[0]->{'.globals'}->{'DEBUG'} == 1 and @ARGV ) {
    0          
1189 2         7 @words = @ARGV;
1190             }
1191             elsif ( $_[0]->{'.globals'}->{'DEBUG'} == 2 ) {
1192 0         0 require "shellwords.pl";
1193 0         0 print "(offline mode: enter name=value pairs on standard input)\n";
1194 0         0 chomp( my @lines = );
1195 0         0 @words = &shellwords( join " ", @lines );
1196             }
1197             else {
1198 0         0 return '';
1199             }
1200 2         7 @words = map { s/\\=/%3D/g; s/\\&/%26/g; $_ } @words;
  4         13  
  4         9  
  4         14  
1201 2 50       21 return "@words" =~ m/=/ ? join '&', @words : join '+', @words;
1202             }
1203              
1204             sub Dump {
1205 10     10 1 1296 require Data::Dumper; # short and sweet way of doing it
1206 10         5958 ( my $dump = Data::Dumper::Dumper( @_ ) )
1207             =~ tr/\000/0/; # remove null bytes cgi-lib.pl
1208 10         1853 return '
' . escapeHTML( 1, $dump ) . '
';
1209             }
1210              
1211 2     2 0 591 sub as_string { Dump( @_ ) } # CGI.pm alias for Dump()
1212              
1213             sub cgi_error {
1214 16     16 1 795 my ( $self, $err ) = @_;
1215 16 100       45 if ( $err ) {
1216 11         39 $self->{'.cgi_error'} = $err;
1217             $self->{'.globals'}->{'FATAL'} == 1 ? croak $err
1218 11 50       50 : $self->{'.globals'}->{'FATAL'} == 0 ? carp $err
    50          
1219             : return $err;
1220             }
1221 5         35 return $self->{'.cgi_error'};
1222             }
1223              
1224             ################# cgi-lib.pl Compatibility Methods #################
1225             # Lightly GOLFED but the original functionality remains. You can call
1226             # them using either: # $q->MethodName or CGI::Simple::MethodName
1227              
1228 17 100   17   71 sub _shift_if_ref { shift if ref $_[0] eq 'CGI::Simple' }
1229              
1230             sub ReadParse {
1231 6   66 6 0 598 my $q = &_shift_if_ref || CGI::Simple->new;
1232 6         15 my $pkg = caller();
1233 19     19   149 no strict 'refs';
  19         94  
  19         40430  
1234             *in
1235             = @_
1236             ? $_[0]
1237 6 100       19 : *{"${pkg}::in"}; # set *in to passed glob or export *in
  2         12  
1238 6         23 %in = $q->Vars;
1239 6         12 $in{'CGI'} = $q;
1240 6         18 return scalar %in;
1241             }
1242              
1243             sub SplitParam {
1244 6     6 0 21 &_shift_if_ref;
1245 6 100       64 defined $_[0]
    50          
1246             && ( wantarray ? split "\0", $_[0] : ( split "\0", $_[0] )[0] );
1247             }
1248              
1249 2     2 0 11 sub MethGet { request_method() eq 'GET' }
1250              
1251 2     2 0 7 sub MethPost { request_method() eq 'POST' }
1252              
1253             sub MyBaseUrl {
1254 10     10 0 27 local $^W = 0;
1255 10 100       26 'http://'
1256             . server_name()
1257             . ( server_port() != 80 ? ':' . server_port() : '' )
1258             . script_name();
1259             }
1260              
1261 2     2 0 7 sub MyURL { MyBaseUrl() }
1262              
1263             sub MyFullUrl {
1264 4     4 0 15 local $^W = 0;
1265             MyBaseUrl()
1266             . $ENV{'PATH_INFO'}
1267 4 100       12 . ( $ENV{'QUERY_STRING'} ? "?$ENV{'QUERY_STRING'}" : '' );
1268             }
1269              
1270             sub PrintHeader {
1271 2 50   2 0 30 ref $_[0] ? $_[0]->header() : "Content-Type: text/html\n\n";
1272             }
1273              
1274             sub HtmlTop {
1275 3     3 0 12 &_shift_if_ref;
1276 3         20 "\n\n$_[0]\n\n\n

$_[0]

\n";
1277             }
1278              
1279 2     2 0 12 sub HtmlBot { "\n\n" }
1280              
1281 2     2 0 8 sub PrintVariables { &_shift_if_ref; &Dump }
  2         7  
1282              
1283 2     2 1 9 sub PrintEnv { &Dump( \%ENV ) }
1284              
1285 0     0 0 0 sub CgiDie { CgiError( @_ ); die @_ }
  0         0  
1286              
1287             sub CgiError {
1288 0     0 0 0 &_shift_if_ref;
1289             @_
1290 0 0       0 = @_
1291             ? @_
1292             : ( "Error: script " . MyFullUrl() . " encountered fatal error\n" );
1293 0         0 print PrintHeader(), HtmlTop( shift ), ( map { "

$_

\n" } @_ ),
  0         0  
1294             HtmlBot();
1295             }
1296              
1297             ################ Accessor Methods ################
1298              
1299 2     2 1 20 sub version { $VERSION }
1300              
1301             sub nph {
1302 4 100   4 1 34 $_[0]->{'.globals'}->{'NPH'} = $_[1] if defined $_[1];
1303 4         21 return $_[0]->{'.globals'}->{'NPH'};
1304             }
1305              
1306 4     4 1 16 sub all_parameters { $_[0]->param }
1307              
1308             sub charset {
1309 45     45 1 2315 require CGI::Simple::Util;
1310 45         153 $CGI::Simple::Util::UTIL->charset( $_[1] );
1311             }
1312              
1313             sub globals {
1314 16     16 1 2133 my ( $self, $global, $value ) = @_;
1315 16 100       40 return keys %{ $self->{'.globals'} } unless $global;
  6         38  
1316 10 100       27 $self->{'.globals'}->{$global} = $value if defined $value;
1317 10         39 return $self->{'.globals'}->{$global};
1318             }
1319              
1320 2     2 1 10 sub auth_type { $ENV{'AUTH_TYPE'} }
1321 2     2 1 519 sub content_length { $ENV{'CONTENT_LENGTH'} }
1322 2     2 1 541 sub content_type { $ENV{'CONTENT_TYPE'} }
1323 2     2 1 518 sub document_root { $ENV{'DOCUMENT_ROOT'} }
1324 2     2 1 565 sub gateway_interface { $ENV{'GATEWAY_INTERFACE'} }
1325 2     2 1 535 sub path_translated { $ENV{'PATH_TRANSLATED'} }
1326 2     2 1 518 sub referer { $ENV{'HTTP_REFERER'} }
1327 2 50   2 1 519 sub remote_addr { $ENV{'REMOTE_ADDR'} || '127.0.0.1' }
1328              
1329             sub remote_host {
1330 2 0 33 2 1 521 $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || 'localhost';
1331             }
1332              
1333 2     2 1 582 sub remote_ident { $ENV{'REMOTE_IDENT'} }
1334 2     2 1 520 sub remote_user { $ENV{'REMOTE_USER'} }
1335 13     13 1 2849 sub request_method { $ENV{'REQUEST_METHOD'} }
1336 81 50 66 81 1 834 sub script_name { $ENV{'SCRIPT_NAME'} || $0 || '' }
1337 38 100   38 1 667 sub server_name { $ENV{'SERVER_NAME'} || 'localhost' }
1338 76 100   76 1 780 sub server_port { $ENV{'SERVER_PORT'} || 80 }
1339 30 100   30 1 661 sub server_protocol { $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0' }
1340 16 50   16 1 598 sub server_software { $ENV{'SERVER_SOFTWARE'} || 'cmdline' }
1341              
1342             sub user_name {
1343 2 0 33 2 1 648 $ENV{'HTTP_FROM'} || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
1344             }
1345              
1346             sub user_agent {
1347 6     6 1 1661 my ( $self, $match ) = @_;
1348             return $match
1349             ? $ENV{'HTTP_USER_AGENT'} =~ /\Q$match\E/i
1350 6 100       84 : $ENV{'HTTP_USER_AGENT'};
1351             }
1352              
1353             sub virtual_host {
1354 2   33 2 1 839 my $vh = $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'};
1355 2         8 $vh =~ s/:\d+$//; # get rid of port number
1356 2         9 return $vh;
1357             }
1358              
1359             sub path_info {
1360 70     70 1 2303 my ( $self, $info ) = @_;
1361 70 100       241 if ( defined $info ) {
    100          
1362 4 100       26 $info = "/$info" if $info !~ m|^/|;
1363 4         12 $self->{'.path_info'} = $info;
1364             }
1365             elsif ( !defined( $self->{'.path_info'} ) ) {
1366             $self->{'.path_info'}
1367 10 100       53 = defined( $ENV{'PATH_INFO'} ) ? $ENV{'PATH_INFO'} : '';
1368              
1369             # hack to fix broken path info in IIS source CGI.pm
1370             $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E//
1371             if defined( $ENV{'SERVER_SOFTWARE'} )
1372 10 50 66     52 && $ENV{'SERVER_SOFTWARE'} =~ /IIS/;
1373             }
1374 70         140 return $self->{'.path_info'};
1375             }
1376              
1377             sub accept {
1378 8     8 1 14 my ( $self, $search ) = @_;
1379 8         13 my %prefs;
1380 8         30 for my $accept ( split ',', $ENV{'HTTP_ACCEPT'} ) {
1381 40         113 ( my $pref ) = $accept =~ m|q=([\d\.]+)|;
1382 40         119 ( my $type ) = $accept =~ m|(\S+/[^;]+)|;
1383 40 50       72 next unless $type;
1384 40   100     107 $prefs{$type} = $pref || 1;
1385             }
1386 8 100       39 return keys %prefs unless $search;
1387 4 100       18 return $prefs{$search} if $prefs{$search};
1388              
1389             # Didn't get it, so try pattern matching.
1390 2         9 for my $pref ( keys %prefs ) {
1391 5 100       16 next unless $pref =~ m/\*/; # not a pattern match
1392 2         17 ( my $pat = $pref ) =~ s/([^\w*])/\\$1/g; # escape meta characters
1393 2         8 $pat =~ s/\*/.*/g; # turn it into a pattern
1394 2 50       40 return $prefs{$pref} if $search =~ /$pat/;
1395             }
1396             }
1397              
1398 8     8 1 1638 sub Accept { my $self = shift; $self->accept( @_ ) }
  8         24  
1399              
1400             sub http {
1401 45     45 1 2833 my ( $self, $parameter ) = @_;
1402 45 100       117 if ( defined $parameter ) {
1403 41         107 ( $parameter = uc $parameter ) =~ tr/-/_/;
1404 41 100       145 return $ENV{$parameter} if $parameter =~ m/^HTTP/;
1405 37 50       167 return $ENV{"HTTP_$parameter"} if $parameter;
1406             }
1407 4         42 return grep { /^HTTP/ } keys %ENV;
  252         374  
1408             }
1409              
1410             sub https {
1411 8     8 1 1996 my ( $self, $parameter ) = @_;
1412 8 100       28 return $ENV{'HTTPS'} unless $parameter;
1413 6         18 ( $parameter = uc $parameter ) =~ tr/-/_/;
1414 6 100       27 return $ENV{$parameter} if $parameter =~ /^HTTPS/;
1415 4         17 return $ENV{"HTTPS_$parameter"};
1416             }
1417              
1418             sub protocol {
1419 32     32 1 1849 local ( $^W ) = 0;
1420 32         64 my $self = shift;
1421 32 100       104 return 'https' if uc $ENV{'HTTPS'} eq 'ON';
1422 30 100       74 return 'https' if $self->server_port == 443;
1423 28         81 my ( $protocol, $version ) = split '/', $self->server_protocol;
1424 28         94 return lc $protocol;
1425             }
1426              
1427             sub url {
1428 62     62 1 856 my ( $self, @p ) = @_;
1429 19     19   191 use CGI::Simple::Util 'rearrange';
  19         42  
  19         15359  
1430 62         324 my ( $relative, $absolute, $full, $path_info, $query, $base )
1431             = rearrange(
1432             [
1433             'RELATIVE', 'ABSOLUTE', 'FULL',
1434             [ 'PATH', 'PATH_INFO' ],
1435             [ 'QUERY', 'QUERY_STRING' ], 'BASE'
1436             ],
1437             @p
1438             );
1439 62         152 my $url;
1440 62 100 100     324 $full++ if $base || !( $relative || $absolute );
      66        
1441 62         147 my $path = $self->path_info;
1442 62         149 my $script_name = $self->script_name;
1443 62 100       199 if ( $full ) {
    100          
    50          
1444 26         62 my $protocol = $self->protocol();
1445 26         54 $url = "$protocol://";
1446 26         59 my $vh = $self->http( 'host' );
1447 26 50       64 if ( $vh ) {
1448 0         0 $url .= $vh;
1449             }
1450             else {
1451 26         62 $url .= server_name();
1452 26         59 my $port = $self->server_port;
1453 26 50 66     268 $url .= ":" . $port
      33        
      66        
1454             unless ( lc( $protocol ) eq 'http' && $port == 80 )
1455             or ( lc( $protocol ) eq 'https' && $port == 443 );
1456             }
1457 26 50       85 return $url if $base;
1458 26         66 $url .= $script_name;
1459             }
1460             elsif ( $relative ) {
1461 27         202 ( $url ) = $script_name =~ m#([^/]+)$#;
1462             }
1463             elsif ( $absolute ) {
1464 9         19 $url = $script_name;
1465             }
1466 62 100 66     234 $url .= $path if $path_info and defined $path;
1467 62 100 100     189 $url .= "?" . $self->query_string if $query and $self->query_string;
1468 62 50       124 $url = '' unless defined $url;
1469 62         159 $url
1470 0         0 =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/uc sprintf("%%%02x",ord($1))/eg;
1471 62         376 return $url;
1472             }
1473              
1474             sub self_url {
1475 17     17 1 46 my ( $self, @params ) = @_;
1476 17         55 return $self->url(
1477             '-path_info' => 1,
1478             '-query' => 1,
1479             '-full' => 1,
1480             @params
1481             );
1482             }
1483              
1484 2     2 1 546 sub state { self_url( @_ ) } # CGI.pm synonym routine
1485              
1486             1;
1487              
1488             =head1 NAME
1489              
1490             CGI::Simple - A Simple totally OO CGI interface that is CGI.pm compliant
1491              
1492             =head1 VERSION
1493              
1494             This document describes CGI::Simple version 1.280.
1495              
1496             =head1 SYNOPSIS
1497              
1498             use CGI::Simple;
1499             $CGI::Simple::POST_MAX = 1024; # max upload via post default 100kB
1500             $CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
1501              
1502             $q = CGI::Simple->new;
1503             $q = CGI::Simple->new( { 'foo'=>'1', 'bar'=>[2,3,4] } );
1504             $q = CGI::Simple->new( 'foo=1&bar=2&bar=3&bar=4' );
1505             $q = CGI::Simple->new( \*FILEHANDLE );
1506              
1507             $q->save( \*FILEHANDLE ); # save current object to a file as used by new
1508              
1509             @params = $q->param; # return all param names as a list
1510             $value = $q->param('foo'); # return the first value supplied for 'foo'
1511             @values = $q->param('foo'); # return all values supplied for foo
1512              
1513             %fields = $q->Vars; # returns untied key value pair hash
1514             $hash_ref = $q->Vars; # or as a hash ref
1515             %fields = $q->Vars("|"); # packs multiple values with "|" rather than "\0";
1516              
1517             @keywords = $q->keywords; # return all keywords as a list
1518              
1519             $q->param( 'foo', 'some', 'new', 'values' ); # set new 'foo' values
1520             $q->param( -name=>'foo', -value=>'bar' );
1521             $q->param( -name=>'foo', -value=>['bar','baz'] );
1522              
1523             $q->param( 'foo', 'some', 'new', 'values' ); # append values to 'foo'
1524             $q->append( -name=>'foo', -value=>'bar' );
1525             $q->append( -name=>'foo', -value=>['some', 'new', 'values'] );
1526              
1527             $q->delete('foo'); # delete param 'foo' and all its values
1528             $q->delete_all; # delete everything
1529              
1530            
1531              
1532             $files = $q->upload() # number of files uploaded
1533             @files = $q->upload(); # names of all uploaded files
1534             $filename = $q->param('upload_file') # filename of uploaded file
1535             $mime = $q->upload_info($filename,'mime'); # MIME type of uploaded file
1536             $size = $q->upload_info($filename,'size'); # size of uploaded file
1537              
1538             my $fh = $q->upload($filename); # get filehandle to read from
1539             while ( read( $fh, $buffer, 1024 ) ) { ... }
1540              
1541             # short and sweet upload
1542             $ok = $q->upload( $q->param('upload_file'), '/path/to/write/file.name' );
1543             print "Uploaded ".$q->param('upload_file')." and wrote it OK!" if $ok;
1544              
1545             $decoded = $q->url_decode($encoded);
1546             $encoded = $q->url_encode($unencoded);
1547             $escaped = $q->escapeHTML('<>"&');
1548             $unescaped = $q->unescapeHTML('<>"&');
1549              
1550             $qs = $q->query_string; # get all data in $q as a query string OK for GET
1551              
1552             $q->no_cache(1); # set Pragma: no-cache + expires
1553             print $q->header(); # print a simple header
1554             # get a complex header
1555             $header = $q->header( -type => 'image/gif'
1556             -nph => 1,
1557             -status => '402 Payment required',
1558             -expires =>'+24h',
1559             -cookie => $cookie,
1560             -charset => 'utf-7',
1561             -attachment => 'foo.gif',
1562             -Cost => '$2.00'
1563             );
1564             # a p3p header (OK for redirect use as well)
1565             $header = $q->header( -p3p => 'policyref="http://somesite.com/P3P/PolicyReferences.xml' );
1566              
1567             @cookies = $q->cookie(); # get names of all available cookies
1568             $value = $q->cookie('foo') # get first value of cookie 'foo'
1569             @value = $q->cookie('foo') # get all values of cookie 'foo'
1570             # get a cookie formatted for header() method
1571             $cookie = $q->cookie( -name => 'Password',
1572             -values => ['superuser','god','my dog woofie'],
1573             -expires => '+3d',
1574             -domain => '.nowhere.com',
1575             -path => '/cgi-bin/database',
1576             -secure => 1
1577             );
1578             print $q->header( -cookie=>$cookie ); # set cookie
1579              
1580             print $q->redirect('http://go.away.now'); # print a redirect header
1581              
1582             dienice( $q->cgi_error ) if $q->cgi_error;
1583              
1584             =head1 DESCRIPTION
1585              
1586             CGI::Simple provides a relatively lightweight drop in replacement for CGI.pm.
1587             It shares an identical OO interface to CGI.pm for parameter parsing, file
1588             upload, cookie handling and header generation. This module is entirely object
1589             oriented, however a complete functional interface is available by using the
1590             CGI::Simple::Standard module.
1591              
1592             Essentially everything in CGI.pm that relates to the CGI (not HTML) side of
1593             things is available. There are even a few new methods and additions to old
1594             ones! If you are interested in what has gone on under the hood see the
1595             Compatibility with CGI.pm section at the end.
1596              
1597             In practical testing this module loads and runs about twice as fast as CGI.pm
1598             depending on the precise task.
1599              
1600             =head1 CALLING CGI::Simple ROUTINES USING THE OBJECT INTERFACE
1601              
1602             Here is a very brief rundown on how you use the interface. Full details
1603             follow.
1604              
1605             =head2 First you need to initialize an object
1606              
1607             Before you can call a CGI::Simple method you must create a CGI::Simple object.
1608             You do that by using the module and then calling the new() constructor:
1609              
1610             use CGI::Simple;
1611             my $q = CGI::Simple->new;
1612              
1613             It is traditional to call your object $q for query or perhaps $cgi.
1614              
1615             =head2 Next you call methods on that object
1616              
1617             Once you have your object you can call methods on it using the -> arrow
1618             syntax For example to get the names of all the parameters passed to your
1619             script you would just write:
1620              
1621             @names = $q->param();
1622              
1623             Many methods are sensitive to the context in which you call them. In the
1624             example above the B method returns a list of all the parameter names
1625             when called without any arguments.
1626              
1627             When you call B with a single argument it assumes you want
1628             to get the value(s) associated with that argument (parameter). If you ask
1629             for an array it gives you an array of all the values associated with it's
1630             argument:
1631              
1632             @values = $q->param('foo'); # get all the values for 'foo'
1633              
1634             whereas if you ask for a scalar like this:
1635              
1636             $value = $q->param('foo'); # get only the first value for 'foo'
1637              
1638             then it returns only the first value (if more than one value for
1639             'foo' exists).
1640              
1641             In case you ased for a list it will return all the values preserving the
1642             order in which the values of the given key were passed in the request.
1643              
1644             Most CGI::Simple routines accept several arguments, sometimes as many as
1645             10 optional ones! To simplify this interface, all routines use a named
1646             argument calling style that looks like this:
1647              
1648             print $q->header( -type=>'image/gif', -expires=>'+3d' );
1649              
1650             Each argument name is preceded by a dash. Neither case nor order
1651             matters in the argument list. -type, -Type, and -TYPE are all
1652             acceptable.
1653              
1654             Several routines are commonly called with just one argument. In the
1655             case of these routines you can provide the single argument without an
1656             argument name. B happens to be one of these routines. In this
1657             case, the single argument is the document type.
1658              
1659             print $q->header('text/html');
1660              
1661             Sometimes methods expect a scalar, sometimes a reference to an
1662             array, and sometimes a reference to a hash. Often, you can pass any
1663             type of argument and the routine will do whatever is most appropriate.
1664             For example, the B method can be used to set a CGI parameter to a
1665             single or a multi-valued value. The two cases are shown below:
1666              
1667             $q->param(-name=>'veggie',-value=>'tomato');
1668             $q->param(-name=>'veggie',-value=>['tomato','tomahto','potato','potahto']);
1669              
1670             =head1 CALLING CGI::Simple ROUTINES USING THE FUNCTION INTERFACE
1671              
1672             For convenience a functional interface is provided by the
1673             CGI::Simple::Standard module. This hides the OO details from you and allows
1674             you to simply call methods. You may either use AUTOLOADING of methods or
1675             import specific method sets into you namespace. Here are the first few
1676             examples again using the function interface.
1677              
1678             use CGI::Simple::Standard qw(-autoload);
1679             @names = param();
1680             @values = param('foo');
1681             $value = param('foo');
1682             print header(-type=>'image/gif',-expires=>'+3d');
1683             print header('text/html');
1684              
1685             Yes that's it. Not a $q-> in sight. You just use the module and select
1686             how/which methods to load. You then just call the methods you want exactly
1687             as before but without the $q-> notation.
1688              
1689             When (if) you read the following docs and are using the functional interface
1690             just pretend the $q-> is not there.
1691              
1692             =head2 Selecting which methods to load
1693              
1694             When you use the functional interface Perl needs to be able to find the
1695             functions you call. The simplest way of doing this is to use autoloading as
1696             shown above. When you use CGI::Simple::Standard with the '-autoload' pragma
1697             it exports a single AUTOLOAD sub into you namespace. Every time you call a
1698             non existent function AUTOLOAD is called and will load the required
1699             function and install it in your namespace. Thus only the AUTOLOAD sub and
1700             those functions you specifically call will be imported.
1701              
1702             Alternatively CGI::Simple::Standard provides a range of function sets you can
1703             import or you can just select exactly what you want. You do this using the
1704             familiar
1705              
1706             use CGI::Simple::Standard qw( :func_set some_func);
1707              
1708             notation. This will import the ':func_set' function set and the specific
1709             function 'some_func'.
1710              
1711             =head2 To Autoload or not to Autoload, that is the question.
1712              
1713             If you do not have a AUTOLOAD sub in you script it is generally best to use
1714             the '-autoload' option. Under autoload you can use any method you want but
1715             only import and compile those functions you actually use.
1716              
1717             If you do not use autoload you must specify what functions to import. You can
1718             only use functions that you have imported. For comvenience functions are
1719             grouped into related sets. If you choose to import one or more ':func_set'
1720             you may have potential namespace collisions so check out the docs to see
1721             what gets imported. Using the ':all' tag is pretty slack but it is there
1722             if you want. Full details of the function sets are provided in the
1723             CGI::Simple::Standard docs
1724              
1725             If you just want say the param and header methods just load these two.
1726              
1727             use CGI::Simple::Standard qw(param header);
1728              
1729             =head2 Setting globals using the functional interface
1730              
1731             Where you see global variables being set using the syntax:
1732              
1733             $CGI::Simple::DEBUG = 1;
1734              
1735             You use exactly the same syntax when using CGI::Simple::Standard.
1736              
1737             =cut
1738              
1739             ################ The Core Methods ################
1740              
1741             =head1 THE CORE METHODS
1742              
1743             =head2 new() Creating a new query object
1744              
1745             The first step in using CGI::Simple is to create a new query object using
1746             the B constructor:
1747              
1748             $q = CGI::Simple->new;
1749              
1750             This will parse the input (from both POST and GET methods) and store
1751             it into an object called $q.
1752              
1753             If you provide a file handle to the B method, it will read
1754             parameters from the file (or STDIN, or whatever).
1755              
1756             Historically people were doing this way:
1757              
1758             open FH, "test.in" or die $!;
1759             $q = CGI::Simple->new(\*FH);
1760              
1761             but this is the recommended way:
1762              
1763             open $fh, '<', "test.in" or die $!;
1764             $q = CGI::Simple->new($fh);
1765              
1766             The file should be a series of newline delimited TAG=VALUE pairs.
1767             Conveniently, this type of file is created by the B method
1768             (see below). Multiple records can be saved and restored.
1769             IO::File objects work fine.
1770              
1771             If you are using the function-oriented interface provided by
1772             CGI::Simple::Standard and want to initialize from a file handle,
1773             the way to do this is with B. This will (re)initialize
1774             the default CGI::Simple object from the indicated file handle.
1775              
1776             restore_parameters($fh);
1777              
1778             In fact for all intents and purposes B is identical
1779             to B Note that B does not exist in
1780             CGI::Simple itself so you can't use it.
1781              
1782             You can also initialize the query object from an associative array
1783             reference:
1784              
1785             $q = CGI::Simple->new( { 'dinosaur' => 'barney',
1786             'song' => 'I love you',
1787             'friends' => [qw/Jessica George Nancy/] }
1788             );
1789              
1790             or from a properly formatted, URL-escaped query string:
1791              
1792             $q = CGI::Simple->new( 'dinosaur=barney&color=purple' );
1793              
1794             or from a previously existing CGI::Simple object (this generates an identical clone
1795             including all global variable settings, etc that are stored in the object):
1796              
1797             $old_query = CGI::Simple->new;
1798             $new_query = CGI::Simple->new($old_query);
1799              
1800             To create an empty query, initialize it from an empty string or hash:
1801              
1802             $empty_query = CGI::Simple->new("");
1803              
1804             -or-
1805              
1806             $empty_query = CGI::Simple->new({});
1807              
1808             =head2 keywords() Fetching a list of keywords from a query
1809              
1810             @keywords = $q->keywords;
1811              
1812             If the script was invoked as the result of an search, the
1813             parsed keywords can be obtained as an array using the B method.
1814              
1815             =head2 param() Fetching the names of all parameters passed to your script
1816              
1817             @names = $q->param;
1818              
1819             If the script was invoked with a parameter list
1820             (e.g. "name1=value1&name2=value2&name3=value3"), the B method
1821             will return the parameter names as a list. If the script was invoked
1822             as an script and contains a string without ampersands
1823             (e.g. "value1+value2+value3") , there will be a single parameter named
1824             "keywords" containing the "+"-delimited keywords.
1825              
1826             NOTE: The array of parameter names returned will
1827             be in the same order as they were submitted by the browser.
1828             Usually this order is the same as the order in which the
1829             parameters are defined in the form (however, this isn't part
1830             of the spec, and so isn't guaranteed).
1831              
1832             =head2 param() Fetching the value or values of a simple named parameter
1833              
1834             @values = $q->param('foo');
1835              
1836             -or-
1837              
1838             $value = $q->param('foo');
1839              
1840             Pass the B method a single argument to fetch the value of the
1841             named parameter. If the parameter is multi-valued (e.g. from multiple
1842             selections in a scrolling list), you can ask to receive an array. Otherwise
1843             the method will return a single value.
1844              
1845             If a value is not given in the query string, as in the queries
1846             "name1=&name2=" or "name1&name2", it will be returned by default
1847             as an empty string. If you set the global variable:
1848              
1849             $CGI::Simple::NO_UNDEF_PARAMS = 1;
1850              
1851             Then value-less parameters will be ignored, and will not exist in the
1852             query object. If you try to access them via param you will get an undef
1853             return value.
1854              
1855             =head2 param() Setting the values of a named parameter
1856              
1857             $q->param('foo','an','array','of','values');
1858              
1859             This sets the value for the named parameter 'foo' to an array of
1860             values. This is one way to change the value of a field.
1861              
1862             B also recognizes a named parameter style of calling described
1863             in more detail later:
1864              
1865             $q->param(-name=>'foo',-values=>['an','array','of','values']);
1866              
1867             -or-
1868              
1869             $q->param(-name=>'foo',-value=>'the value');
1870              
1871             =head2 param() Retrieving non-application/x-www-form-urlencoded data
1872              
1873             If POSTed or PUTed data is not of type application/x-www-form-urlencoded or multipart/form-data,
1874             then the data will not be processed, but instead be returned as-is in a parameter named POSTDATA
1875             or PUTDATA. To retrieve it, use code like this:
1876              
1877             my $data = $q->param( 'POSTDATA' );
1878              
1879             -or-
1880              
1881             my $data = $q->param( 'PUTDATA' );
1882              
1883             (If you don't know what the preceding means, don't worry about it. It only affects people trying
1884             to use CGI::Simple for REST webservices)
1885              
1886             =head2 add_param() Setting the values of a named parameter
1887              
1888             You nay also use the new method B to add parameters. This is an
1889             alias to the _add_param() internal method that actually does all the work.
1890             You can call it like this:
1891              
1892             $q->add_param('foo', 'new');
1893             $q->add_param('foo', [1,2,3,4,5]);
1894             $q->add_param( 'foo', 'bar', 'overwrite' );
1895              
1896             The first argument is the parameter, the second the value or an array ref
1897             of values and the optional third argument sets overwrite mode. If the third
1898             argument is absent of false the values will be appended. If true the values
1899             will overwrite any existing ones
1900              
1901             =head2 append() Appending values to a named parameter
1902              
1903             $q->append(-name=>'foo',-values=>['yet','more','values']);
1904              
1905             This adds a value or list of values to the named parameter. The
1906             values are appended to the end of the parameter if it already exists.
1907             Otherwise the parameter is created. Note that this method only
1908             recognizes the named argument calling syntax.
1909              
1910             =head2 import_names() Importing all parameters into a namespace.
1911              
1912             This method was silly, non OO and has been deleted. You can get all the params
1913             as a hash using B or via all the other accessors.
1914              
1915             =head2 delete() Deleting a parameter completely
1916              
1917             $q->delete('foo');
1918              
1919             This completely clears a parameter. If you are using the function call
1920             interface, use B instead to avoid conflicts with Perl's
1921             built-in delete operator.
1922              
1923             If you are using the function call interface, use B instead to
1924             avoid conflicts with Perl's built-in delete operator.
1925              
1926             =head2 delete_all() Deleting all parameters
1927              
1928             $q->delete_all();
1929              
1930             This clears the CGI::Simple object completely. For CGI.pm compatibility
1931             B is provided however there is no reason to use this in the
1932             function call interface other than symmetry.
1933              
1934             For CGI.pm compatibility B is provided as an alias for
1935             B however there is no reason to use this, even in the
1936             function call interface.
1937              
1938             =head2 param_fetch() Direct access to the parameter list
1939              
1940             This method is provided for CGI.pm compatibility only. It returns an
1941             array ref to the values associated with a named param. It is deprecated.
1942              
1943             =head2 Vars() Fetching the entire parameter list as a hash
1944              
1945             $params = $q->Vars; # as a tied hash ref
1946             print $params->{'address'};
1947             @foo = split "\0", $params->{'foo'};
1948              
1949             %params = $q->Vars; # as a plain hash
1950             print $params{'address'};
1951             @foo = split "\0", $params{'foo'};
1952              
1953             %params = $q->Vars(','); # specifying a different separator than "\0"
1954             @foo = split ',', $params{'foo'};
1955              
1956             Many people want to fetch the entire parameter list as a hash in which
1957             the keys are the names of the CGI parameters, and the values are the
1958             parameters' values. The B method does this.
1959              
1960             Called in a scalar context, it returns the parameter list as a tied
1961             hash reference. Because this hash ref is tied changing a key/value
1962             changes the underlying CGI::Simple object.
1963              
1964             Called in a list context, it returns the parameter list as an ordinary hash.
1965             Changing this hash will not change the underlying CGI::Simple object
1966              
1967             When using B, the thing you must watch out for are multi-valued CGI
1968             parameters. Because a hash cannot distinguish between scalar and
1969             list context, multi-valued parameters will be returned as a packed
1970             string, separated by the "\0" (null) character. You must split this
1971             packed string in order to get at the individual values. This is the
1972             convention introduced long ago by Steve Brenner in his cgi-lib.pl
1973             module for Perl version 4.
1974              
1975             You can change the character used to do the multiple value packing by passing
1976             it to B as an argument as shown.
1977              
1978             =head2 url_param() Access the QUERY_STRING regardless of 'GET' or 'POST'
1979              
1980             The B method makes the QUERY_STRING data available regardless
1981             of whether the REQUEST_METHOD was 'GET' or 'POST'. You can do anything
1982             with B that you can do with B, however the data set
1983             is completely independent.
1984              
1985             Technically what happens if you use this method is that the QUERY_STRING data
1986             is parsed into a new CGI::Simple object which is stored within the current
1987             object. B then just calls B on this new object.
1988              
1989             =head2 parse_query_string() Add QUERY_STRING data to 'POST' requests
1990              
1991             When the REQUEST_METHOD is 'POST' the default behavior is to ignore
1992             name/value pairs or keywords in the $ENV{'QUERY_STRING'}. You can override
1993             this by calling B which will add the QUERY_STRING data to
1994             the data already in our CGI::Simple object if the REQUEST_METHOD was 'POST'
1995              
1996             $q = CGI::Simple->new;
1997             $q->parse_query_string; # add $ENV{'QUERY_STRING'} data to our $q object
1998              
1999             If the REQUEST_METHOD was 'GET' then the QUERY_STRING will already be
2000             stored in our object so B will be ignored.
2001              
2002             This is a new method in CGI::Simple that is not available in CGI.pm
2003              
2004             =head2 save() Saving the state of an object to file
2005              
2006             $q->save(\*FILEHANDLE)
2007              
2008             This will write the current state of the form to the provided
2009             filehandle. You can read it back in by providing a filehandle
2010             to the B method.
2011              
2012             The format of the saved file is:
2013              
2014             NAME1=VALUE1
2015             NAME1=VALUE1'
2016             NAME2=VALUE2
2017             NAME3=VALUE3
2018             =
2019              
2020             Both name and value are URL escaped. Multi-valued CGI parameters are
2021             represented as repeated names. A session record is delimited by a
2022             single = symbol. You can write out multiple records and read them
2023             back in with several calls to B.
2024              
2025             open my $fh, '<', "test.in" or die $!;
2026             $q1 = CGI::Simple->new($fh); # get the first record
2027             $q2 = CGI::Simple->new($fh); # get the next record
2028              
2029             Note: If you wish to use this method from the function-oriented (non-OO)
2030             interface, the exported name for this method is B.
2031             Also if you want to initialize from a file handle, the way to do this is
2032             with B. This will (re)initialize
2033             the default CGI::Simple object from the indicated file handle.
2034              
2035             restore_parameters($fh);
2036              
2037             =cut
2038              
2039             ################ Uploading Files ###################
2040              
2041             =head1 FILE UPLOADS
2042              
2043             File uploads are easy with CGI::Simple. You use the B method.
2044             Assuming you have the following in your HTML:
2045              
2046            
2047             METHOD="POST"
2048             ACTION="http://somewhere.com/cgi-bin/script.cgi"
2049             ENCTYPE="multipart/form-data">
2050            
2051            
2052            
2053              
2054             Note that the ENCTYPE is "multipart/form-data". You must specify this or the
2055             browser will default to "application/x-www-form-urlencoded" which will result
2056             in no files being uploaded although on the surface things will appear OK.
2057              
2058             When the user submits this form any supplied files will be spooled onto disk
2059             and saved in temporary files. These files will be deleted when your script.cgi
2060             exits so if you want to keep them you will need to proceed as follows.
2061              
2062             =head2 upload() The key file upload method
2063              
2064             The B method is quite versatile. If you call B without
2065             any arguments it will return a list of uploaded files in list context and
2066             the number of uploaded files in scalar context.
2067              
2068             $number_of_files = $q->upload;
2069             @list_of_files = $q->upload;
2070              
2071             Having established that you have uploaded files available you can get the
2072             browser supplied filename using B like this:
2073              
2074             $filename1 = $q->param('upload_file1');
2075              
2076             You can then get a filehandle to read from by calling B and
2077             supplying this filename as an argument. Warning: do not modify the
2078             value you get from B in any way - you don't need to untaint it.
2079              
2080             $fh = $q->upload( $filename1 );
2081              
2082             Now to save the file you would just do something like:
2083              
2084             $save_path = '/path/to/write/file.name';
2085             open my $out, '>', $save_path or die "Oops $!\n";
2086             binmode $out;
2087             print $out $buffer while read( $fh, $buffer, 4096 );
2088             close $out;
2089              
2090             By utilizing a new feature of the upload method this process can be
2091             simplified to:
2092              
2093             $ok = $q->upload( $q->param('upload_file1'), '/path/to/write/file.name' );
2094             if ($ok) {
2095             print "Uploaded and wrote file OK!";
2096             } else {
2097             print $q->cgi_error();
2098             }
2099              
2100             As you can see upload will accept an optional second argument and will write
2101             the file to this file path. It will return 1 for success and undef if it
2102             fails. If it fails you can get the error from B
2103              
2104             You can also use just the fieldname as an argument to upload ie:
2105              
2106             $fh = $q->upload( 'upload_field_name' );
2107              
2108             or
2109              
2110             $ok = $q->upload( 'upload_field_name', '/path/to/write/file.name' );
2111              
2112             BUT there is a catch. If you have multiple upload fields, all called
2113             'upload_field_name' then you will only get the last uploaded file from
2114             these fields.
2115              
2116             =head2 upload_info() Get the details about uploaded files
2117              
2118             The B method is a new method. Called without arguments it
2119             returns the number of uploaded files in scalar context and the names of
2120             those files in list context.
2121              
2122             $number_of_upload_files = $q->upload_info();
2123             @filenames_of_all_uploads = $q->upload_info();
2124              
2125             You can get the MIME type of an uploaded file like this:
2126              
2127             $mime = $q->upload_info( $filename1, 'mime' );
2128              
2129             If you want to know how big a file is before you copy it you can get that
2130             information from B which will return the file size in bytes.
2131              
2132             $file_size = $q->upload_info( $filename1, 'size' );
2133              
2134             The size attribute is optional as this is the default value returned.
2135              
2136             Note: The old CGI.pm B method has been deleted.
2137              
2138             =head2 $POST_MAX and $DISABLE_UPLOADS
2139              
2140             CGI.pm has a default setting that allows infinite size file uploads by
2141             default. In contrast file uploads are disabled by default in CGI::Simple
2142             to discourage Denial of Service attacks. You must enable them before you
2143             expect file uploads to work.
2144              
2145             When file uploads are disabled the file name and file size details will
2146             still be available from B and B respectively but
2147             the upload filehandle returned by B will be undefined - not
2148             surprising as the underlying temp file will not exist either.
2149              
2150             You can enable uploads using the '-upload' pragma. You do this by specifying
2151             this in you use statement:
2152              
2153             use CGI::Simple qw(-upload);
2154              
2155             Alternatively you can enable uploads via the $DISABLE_UPLOADS global like this:
2156              
2157             use CGI::Simple;
2158             $CGI::Simple::DISABLE_UPLOADS = 0;
2159             $q = CGI::Simple->new;
2160              
2161             If you wish to set $DISABLE_UPLOADS you must do this *after* the
2162             use statement and *before* the new constructor call as shown above.
2163              
2164             The maximum acceptable data via post is capped at 102_400kB rather than
2165             infinity which is the CGI.pm default. This should be ample for most tasks
2166             but you can set this to whatever you want using the $POST_MAX global.
2167              
2168             use CGI::Simple;
2169             $CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
2170             $CGI::Simple::POST_MAX = 1_048_576; # allow 1MB uploads
2171             $q = CGI::Simple->new;
2172              
2173             If you set to -1 infinite size uploads will be permitted, which is the CGI.pm
2174             default.
2175              
2176             $CGI::Simple::POST_MAX = -1; # infinite size upload
2177              
2178             Alternatively you can specify all the CGI.pm default values which allow file
2179             uploads of infinite size in one easy step by specifying the '-default' pragma
2180             in your use statement.
2181              
2182             use CGI::Simple qw( -default ..... );
2183              
2184             =head2 binmode() and Win32
2185              
2186             If you are using CGI::Simple be sure to call B on any handle that
2187             you create to write the uploaded file to disk. Calling B will do
2188             no harm on other systems anyway.
2189              
2190             =cut
2191              
2192             ################ Miscellaneous Methods ################
2193              
2194             =head1 MISCELANEOUS METHODS
2195              
2196             =head2 escapeHTML() Escaping HTML special characters
2197              
2198             In HTML the < > " and & chars have special meaning and need to be
2199             escaped to < > " and & respectively.
2200              
2201             $escaped = $q->escapeHTML( $string );
2202              
2203             $escaped = $q->escapeHTML( $string, 'new_lines_too' );
2204              
2205             If the optional second argument is supplied then newlines will be escaped to.
2206              
2207             =head2 unescapeHTML() Unescape HTML special characters
2208              
2209             This performs the reverse of B.
2210              
2211             $unescaped = $q->unescapeHTML( $HTML_escaped_string );
2212              
2213             =head2 url_decode() Decode a URL encoded string
2214              
2215             This method will correctly decode a url encoded string.
2216              
2217             $decoded = $q->url_decode( $encoded );
2218              
2219             =head2 url_encode() URL encode a string
2220              
2221             This method will correctly URL encode a string.
2222              
2223             $encoded = $q->url_encode( $string );
2224              
2225             =head2 parse_keywordlist() Parse a supplied keyword list
2226              
2227             @keywords = $q->parse_keywordlist( $keyword_list );
2228              
2229             This method returns a list of keywords, correctly URL escaped and split out
2230             of the supplied string
2231              
2232             =head2 put() Send output to browser
2233              
2234             CGI.pm alias for print. $q->put('Hello World!') will print the usual
2235              
2236             =head2 print() Send output to browser
2237              
2238             CGI.pm alias for print. $q->print('Hello World!') will print the usual
2239              
2240             =cut
2241              
2242             ################# Cookie Methods ################
2243              
2244             =head1 HTTP COOKIES
2245              
2246             CGI.pm has several methods that support cookies.
2247              
2248             A cookie is a name=value pair much like the named parameters in a CGI
2249             query string. CGI scripts create one or more cookies and send
2250             them to the browser in the HTTP header. The browser maintains a list
2251             of cookies that belong to a particular Web server, and returns them
2252             to the CGI script during subsequent interactions.
2253              
2254             In addition to the required name=value pair, each cookie has several
2255             optional attributes:
2256              
2257             =over 4
2258              
2259             =item 1. an expiration time
2260              
2261             This is a time/date string (in a special GMT format) that indicates
2262             when a cookie expires. The cookie will be saved and returned to your
2263             script until this expiration date is reached if the user exits
2264             the browser and restarts it. If an expiration date isn't specified, the cookie
2265             will remain active until the user quits the browser.
2266              
2267             =item 2. a domain
2268              
2269             This is a partial or complete domain name for which the cookie is
2270             valid. The browser will return the cookie to any host that matches
2271             the partial domain name. For example, if you specify a domain name
2272             of ".capricorn.com", then the browser will return the cookie to
2273             Web servers running on any of the machines "www.capricorn.com",
2274             "www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
2275             must contain at least two periods to prevent attempts to match
2276             on top level domains like ".edu". If no domain is specified, then
2277             the browser will only return the cookie to servers on the host the
2278             cookie originated from.
2279              
2280             =item 3. a path
2281              
2282             If you provide a cookie path attribute, the browser will check it
2283             against your script's URL before returning the cookie. For example,
2284             if you specify the path "/cgi-bin", then the cookie will be returned
2285             to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
2286             and "/cgi-bin/customer_service/complain.pl", but not to the script
2287             "/cgi-private/site_admin.pl". By default, path is set to "/", which
2288             causes the cookie to be sent to any CGI script on your site.
2289              
2290             =item 4. a "secure" flag
2291              
2292             If the "secure" attribute is set, the cookie will only be sent to your
2293             script if the CGI request is occurring on a secure channel, such as SSL.
2294              
2295             =back
2296              
2297             =head2 cookie() A simple access method to cookies
2298              
2299             The interface to HTTP cookies is the B method:
2300              
2301             $cookie = $q->cookie( -name => 'sessionID',
2302             -value => 'xyzzy',
2303             -expires => '+1h',
2304             -path => '/cgi-bin/database',
2305             -domain => '.capricorn.org',
2306             -secure => 1
2307             );
2308             print $q->header(-cookie=>$cookie);
2309              
2310             B creates a new cookie. Its parameters include:
2311              
2312             =over 4
2313              
2314             =item B<-name>
2315              
2316             The name of the cookie (required). This can be any string at all.
2317             Although browsers limit their cookie names to non-whitespace
2318             alphanumeric characters, CGI.pm removes this restriction by escaping
2319             and unescaping cookies behind the scenes.
2320              
2321             =item B<-value>
2322              
2323             The value of the cookie. This can be any scalar value,
2324             array reference, or even associative array reference. For example,
2325             you can store an entire associative array into a cookie this way:
2326              
2327             $cookie=$q->cookie( -name => 'family information',
2328             -value => \%childrens_ages );
2329              
2330             =item B<-path>
2331              
2332             The optional partial path for which this cookie will be valid, as described
2333             above.
2334              
2335             =item B<-domain>
2336              
2337             The optional partial domain for which this cookie will be valid, as described
2338             above.
2339              
2340             =item B<-expires>
2341              
2342             The optional expiration date for this cookie. The format is as described
2343             in the section on the B method:
2344              
2345             "+1h" one hour from now
2346              
2347             =item B<-secure>
2348              
2349             If set to true, this cookie will only be used within a secure
2350             SSL session.
2351              
2352             =back
2353              
2354             The cookie created by B must be incorporated into the HTTP
2355             header within the string returned by the B method:
2356              
2357             print $q->header(-cookie=>$my_cookie);
2358              
2359             To create multiple cookies, give B an array reference:
2360              
2361             $cookie1 = $q->cookie( -name => 'riddle_name',
2362             -value => "The Sphynx's Question"
2363             );
2364             $cookie2 = $q->cookie( -name => 'answers',
2365             -value => \%answers
2366             );
2367             print $q->header( -cookie => [ $cookie1, $cookie2 ] );
2368              
2369             To retrieve a cookie, request it by name by calling B method
2370             without the B<-value> parameter:
2371              
2372             use CGI::Simple;
2373             $q = CGI::Simple->new;
2374             $riddle = $q->cookie('riddle_name');
2375             %answers = $q->cookie('answers');
2376              
2377             Cookies created with a single scalar value, such as the "riddle_name"
2378             cookie, will be returned in that form. Cookies with array and hash
2379             values can also be retrieved.
2380              
2381             The cookie and CGI::Simple namespaces are separate. If you have a parameter
2382             named 'answers' and a cookie named 'answers', the values retrieved by
2383             B and B are independent of each other. However, it's
2384             simple to turn a CGI parameter into a cookie, and vice-versa:
2385              
2386             # turn a CGI parameter into a cookie
2387             $c = $q->cookie( -name=>'answers', -value=>[$q->param('answers')] );
2388             # vice-versa
2389             $q->param( -name=>'answers', -value=>[$q->cookie('answers')] );
2390              
2391             =head2 raw_cookie()
2392              
2393             Returns the HTTP_COOKIE variable. Cookies have a special format, and
2394             this method call just returns the raw form (?cookie dough). See
2395             B for ways of setting and retrieving cooked cookies.
2396              
2397             Called with no parameters, B returns the packed cookie
2398             structure. You can separate it into individual cookies by splitting
2399             on the character sequence "; ". Called with the name of a cookie,
2400             retrieves the B form of the cookie. You can use the
2401             regular B method to get the names, or use the raw_fetch()
2402             method from the CGI::Simmple::Cookie module.
2403              
2404             =cut
2405              
2406             ################# Header Methods ################
2407              
2408             =head1 CREATING HTTP HEADERS
2409              
2410             Normally the first thing you will do in any CGI script is print out an
2411             HTTP header. This tells the browser what type of document to expect,
2412             and gives other optional information, such as the language, expiration
2413             date, and whether to cache the document. The header can also be
2414             manipulated for special purposes, such as server push and pay per view
2415             pages.
2416              
2417             =head2 header() Create simple or complex HTTP headers
2418              
2419             print $q->header;
2420              
2421             -or-
2422              
2423             print $q->header('image/gif');
2424              
2425             -or-
2426              
2427             print $q->header('text/html','204 No response');
2428              
2429             -or-
2430              
2431             print $q->header( -type => 'image/gif',
2432             -nph => 1,
2433             -status => '402 Payment required',
2434             -expires => '+3d',
2435             -cookie => $cookie,
2436             -charset => 'utf-7',
2437             -attachment => 'foo.gif',
2438             -Cost => '$2.00'
2439             );
2440              
2441             B returns the Content-type: header. You can provide your own
2442             MIME type if you choose, otherwise it defaults to text/html. An
2443             optional second parameter specifies the status code and a human-readable
2444             message. For example, you can specify 204, "No response" to create a
2445             script that tells the browser to do nothing at all.
2446              
2447             The last example shows the named argument style for passing arguments
2448             to the CGI methods using named parameters. Recognized parameters are
2449             B<-type>, B<-status>, B<-cookie>, B<-target>, B<-expires>, B<-nph>,
2450             B<-charset> and B<-attachment>. Any other named parameters will be
2451             stripped of their initial hyphens and turned into header fields, allowing
2452             you to specify any HTTP header you desire.
2453              
2454             For example, you can produce non-standard HTTP header fields by providing
2455             them as named arguments:
2456              
2457             print $q->header( -type => 'text/html',
2458             -nph => 1,
2459             -cost => 'Three smackers',
2460             -annoyance_level => 'high',
2461             -complaints_to => 'bit bucket'
2462             );
2463              
2464             This will produce the following non-standard HTTP header:
2465              
2466             HTTP/1.0 200 OK
2467             Cost: Three smackers
2468             Annoyance-level: high
2469             Complaints-to: bit bucket
2470             Content-type: text/html
2471              
2472             Note that underscores are translated automatically into hyphens. This feature
2473             allows you to keep up with the rapidly changing HTTP "standards".
2474              
2475             The B<-type> is a key element that tell the browser how to display your
2476             document. The default is 'text/html'. Common types are:
2477              
2478             text/html
2479             text/plain
2480             image/gif
2481             image/jpg
2482             image/png
2483             application/octet-stream
2484              
2485             The B<-status> code is the HTTP response code. The default is 200 OK. Common
2486             status codes are:
2487              
2488             200 OK
2489             204 No Response
2490             301 Moved Permanently
2491             302 Found
2492             303 See Other
2493             307 Temporary Redirect
2494             400 Bad Request
2495             401 Unauthorized
2496             403 Forbidden
2497             404 Not Found
2498             405 Not Allowed
2499             408 Request Timed Out
2500             500 Internal Server Error
2501             503 Service Unavailable
2502             504 Gateway Timed Out
2503              
2504             The B<-expires> parameter lets you indicate to a browser and proxy server
2505             how long to cache pages for. When you specify an absolute or relative
2506             expiration interval with this parameter, some browsers and proxy servers
2507             will cache the script's output until the indicated expiration date.
2508             The following forms are all valid for the -expires field:
2509              
2510             +30s 30 seconds from now
2511             +10m ten minutes from now
2512             +1h one hour from now
2513             -1d yesterday (i.e. "ASAP!")
2514             now immediately
2515             +3M in three months
2516             +10y in ten years time
2517             Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date
2518              
2519             The B<-cookie> parameter generates a header that tells the browser to provide
2520             a "magic cookie" during all subsequent transactions with your script.
2521             Netscape cookies have a special format that includes interesting attributes
2522             such as expiration time. Use the B method to create and retrieve
2523             session cookies.
2524              
2525             The B<-target> is for frames use
2526              
2527             The B<-nph> parameter, if set to a true value, will issue the correct
2528             headers to work with a NPH (no-parse-header) script. This is important
2529             to use with certain servers that expect all their scripts to be NPH.
2530              
2531             The B<-charset> parameter can be used to control the character set
2532             sent to the browser. If not provided, defaults to ISO-8859-1. As a
2533             side effect, this sets the charset() method as well.
2534              
2535             The B<-attachment> parameter can be used to turn the page into an
2536             attachment. Instead of displaying the page, some browsers will prompt
2537             the user to save it to disk. The value of the argument is the
2538             suggested name for the saved file. In order for this to work, you may
2539             have to set the B<-type> to 'application/octet-stream'.
2540              
2541             =head2 no_cache() Preventing browser caching of scripts
2542              
2543             Most browsers will not cache the output from CGI scripts. Every time
2544             the browser reloads the page, the script is invoked anew. However some
2545             browsers do cache pages. You can discourage this behavior using the
2546             B function.
2547              
2548             $q->no_cache(1); # turn caching off by sending appropriate headers
2549             $q->no_cache(1); # do not send cache related headers.
2550              
2551             $q->no_cache(1);
2552             print header (-type=>'image/gif', -nph=>1);
2553              
2554             This will produce a header like the following:
2555              
2556             HTTP/1.0 200 OK
2557             Server: Apache - accept no substitutes
2558             Expires: Thu, 15 Nov 2001 03:37:50 GMT
2559             Date: Thu, 15 Nov 2001 03:37:50 GMT
2560             Pragma: no-cache
2561             Content-Type: image/gif
2562              
2563             Both the Pragma: no-cache header field and an Expires header that corresponds
2564             to the current time (ie now) will be sent.
2565              
2566             =head2 cache() Preventing browser caching of scripts
2567              
2568             The somewhat ill named B method is a legacy from CGI.pm. It operates
2569             the same as the new B method. The difference is/was that when set
2570             it results only in the Pragma: no-cache line being printed.
2571             Expires time data is not sent.
2572              
2573             =head2 redirect() Generating a redirection header
2574              
2575             print $q->redirect('http://somewhere.else/in/movie/land');
2576              
2577             Sometimes you don't want to produce a document yourself, but simply
2578             redirect the browser elsewhere, perhaps choosing a URL based on the
2579             time of day or the identity of the user.
2580              
2581             The B function redirects the browser to a different URL. If
2582             you use redirection like this, you should B print out a header as
2583             well.
2584              
2585             One hint I can offer is that relative links may not work correctly
2586             when you generate a redirection to another document on your site.
2587             This is due to a well-intentioned optimization that some servers use.
2588             The solution to this is to use the full URL (including the http: part)
2589             of the document you are redirecting to.
2590              
2591             You can also use named arguments:
2592              
2593             print $q->redirect( -uri=>'http://somewhere.else/in/movie/land',
2594             -nph=>1
2595             );
2596              
2597             The B<-nph> parameter, if set to a true value, will issue the correct
2598             headers to work with a NPH (no-parse-header) script. This is important
2599             to use with certain servers, such as Microsoft ones, which
2600             expect all their scripts to be NPH.
2601              
2602             =cut
2603              
2604             =head1 PRAGMAS
2605              
2606             There are a number of pragmas that you can specify in your use CGI::Simple
2607             statement. Pragmas, which are always preceded by a hyphen, change the way
2608             that CGI::Simple functions in various ways. You can generally achieve
2609             exactly the same results by setting the underlying $GLOBAL_VARIABLES.
2610              
2611             For example the '-upload' pargma will enable file uploads:
2612              
2613             use CGI::Simple qw(-upload);
2614              
2615             In CGI::Simple::Standard Pragmas, function sets , and individual functions
2616             can all be imported in the same use() line. For example, the following
2617             use statement imports the standard set of functions and enables debugging
2618             mode (pragma -debug):
2619              
2620             use CGI::Simple::Standard qw(:standard -debug);
2621              
2622             The current list of pragmas is as follows:
2623              
2624             =over 4
2625              
2626             =item -no_undef_params
2627              
2628             If a value is not given in the query string, as in the queries
2629             "name1=&name2=" or "name1&name2", by default it will be returned
2630             as an empty string.
2631              
2632             If you specify the '-no_undef_params' pragma then CGI::Simple ignores
2633             parameters with no values and they will not appear in the query object.
2634              
2635             =item -nph
2636              
2637             This makes CGI.pm produce a header appropriate for an NPH (no
2638             parsed header) script. You may need to do other things as well
2639             to tell the server that the script is NPH. See the discussion
2640             of NPH scripts below.
2641              
2642             =item -newstyle_urls
2643              
2644             Separate the name=value pairs in CGI parameter query strings with
2645             semicolons rather than ampersands. For example:
2646              
2647             ?name=fred;age=24;favorite_color=3
2648              
2649             Semicolon-delimited query strings are always accepted, but will not be
2650             emitted by self_url() and query_string() unless the -newstyle_urls
2651             pragma is specified.
2652              
2653             =item -oldstyle_urls
2654              
2655             Separate the name=value pairs in CGI parameter query strings with
2656             ampersands rather than semicolons. This is the default.
2657              
2658             ?name=fred&age=24&favorite_color=3
2659              
2660             =item -autoload
2661              
2662             This is only available for CGI::Simple::Standard and uses AUTOLOAD to
2663             load functions on demand. See the CGI::Simple::Standard docs for details.
2664              
2665             =item -no_debug
2666              
2667             This turns off the command-line processing features. This is the default.
2668              
2669             =item -debug1 and debug2
2670              
2671             This turns on debugging. At debug level 1 CGI::Simple will read arguments
2672             from the command-line. At debug level 2 CGI.pm will produce the prompt
2673             "(offline mode: enter name=value pairs on standard input)" and wait for
2674             input on STDIN. If no number is specified then a debug level of 2 is used.
2675              
2676             See the section on debugging for more details.
2677              
2678             =item -default
2679              
2680             This sets the default global values for CGI.pm which will enable infinite
2681             size file uploads, and specify the '-newstyle_urls' and '-debug1' pragmas
2682              
2683             =item -no_upload
2684              
2685             Disable uploads - the default setting
2686              
2687             =item - upload
2688              
2689             Enable uploads - the CGI.pm default
2690              
2691             =item -unique_header
2692              
2693             Only allows headers to be generated once per script invocation
2694              
2695             =item -carp
2696              
2697             Carp when B called, default is to do nothing
2698              
2699             =item -croak
2700              
2701             Croak when B called, default is to do nothing
2702              
2703             =back
2704              
2705             =cut
2706              
2707             ############### NPH Scripts ################
2708              
2709             =head1 USING NPH SCRIPTS
2710              
2711             NPH, or "no-parsed-header", scripts bypass the server completely by
2712             sending the complete HTTP header directly to the browser. This has
2713             slight performance benefits, but is of most use for taking advantage
2714             of HTTP extensions that are not directly supported by your server,
2715             such as server push and PICS headers.
2716              
2717             Servers use a variety of conventions for designating CGI scripts as
2718             NPH. Many Unix servers look at the beginning of the script's name for
2719             the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
2720             Internet Information Server, in contrast, try to decide whether a
2721             program is an NPH script by examining the first line of script output.
2722              
2723             CGI.pm supports NPH scripts with a special NPH mode. When in this
2724             mode, CGI.pm will output the necessary extra header information when
2725             the B and B methods are called. You can set NPH mode
2726             in any of the following ways:
2727              
2728             =over 4
2729              
2730             =item In the B statement
2731              
2732             Simply add the "-nph" pragma to the use:
2733              
2734             use CGI::Simple qw(-nph)
2735              
2736             =item By calling the B method:
2737              
2738             Call B with a non-zero parameter at any point after using CGI.pm in your program.
2739              
2740             $q->nph(1)
2741              
2742             =item By using B<-nph> parameters
2743              
2744             in the B and B statements:
2745              
2746             print $q->header(-nph=>1);
2747              
2748             =back
2749              
2750             The Microsoft Internet Information Server requires NPH mode.
2751             CGI::Simple will automatically detect when the script is
2752             running under IIS and put itself into this mode. You do not need to
2753             do this manually, although it won't hurt anything if you do. However,
2754             note that if you have applied Service Pack 6, much of the
2755             functionality of NPH scripts, including the ability to redirect while
2756             setting a cookie, b on IIS without a special patch
2757             from Microsoft. See
2758             http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
2759             Non-Parsed Headers Stripped From CGI Applications That Have nph-
2760             Prefix in Name.
2761              
2762             =cut
2763              
2764             ################# Server Push Methods #################
2765              
2766             =head1 SERVER PUSH
2767              
2768             CGI.pm provides four simple functions for producing multipart
2769             documents of the type needed to implement server push. These
2770             functions were graciously provided by Ed Jordan with
2771             additions from Andrew Benham
2772              
2773             You are also advised to put the script into NPH mode and to set $| to
2774             1 to avoid buffering problems.
2775              
2776             Browser support for server push is variable.
2777              
2778             Here is a simple script that demonstrates server push:
2779              
2780             #!/usr/local/bin/perl
2781             use CGI::Simple::Standard qw/:push -nph/;
2782             $| = 1;
2783             print multipart_init(-boundary=>'----here we go!');
2784             foreach (0 .. 4) {
2785             print multipart_start(-type=>'text/plain'),
2786             "The current time is ",scalar(localtime),"\n";
2787             if ($_ < 4) {
2788             print multipart_end;
2789             }
2790             else {
2791             print multipart_final;
2792             }
2793             sleep 1;
2794             }
2795              
2796             This script initializes server push by calling B.
2797             It then enters a loop in which it begins a new multipart section by
2798             calling B, prints the current local time,
2799             and ends a multipart section with B. It then sleeps
2800             a second, and begins again. On the final iteration, it ends the
2801             multipart section with B rather than with
2802             B.
2803              
2804             =head2 multipart_init() Initialize the multipart system
2805              
2806             multipart_init(-boundary=>$boundary);
2807              
2808             Initialize the multipart system. The -boundary argument specifies
2809             what MIME boundary string to use to separate parts of the document.
2810             If not provided, CGI.pm chooses a reasonable boundary for you.
2811              
2812             =head2 multipart_start() Start a new part of the multipart document
2813              
2814             multipart_start(-type=>$type)
2815              
2816             Start a new part of the multipart document using the specified MIME
2817             type. If not specified, text/html is assumed.
2818              
2819             =head2 multipart_end() End a multipart part
2820              
2821             multipart_end()
2822              
2823             End a part. You must remember to call B once for each
2824             B, except at the end of the last part of the multipart
2825             document when B should be called instead of
2826             B.
2827              
2828             =head2 multipart_final()
2829              
2830             multipart_final()
2831              
2832             End all parts. You should call B rather than
2833             B at the end of the last part of the multipart document.
2834              
2835             =head2 CGI::Push
2836              
2837             Users interested in server push applications should also have a look
2838             at the B module.
2839              
2840             =cut
2841              
2842             ################# Debugging Methods ################
2843              
2844             =head1 DEBUGGING
2845              
2846             If you are running the script from the command line or in the perl
2847             debugger, you can pass the script a list of keywords or
2848             parameter=value pairs on the command line or from standard input (you
2849             don't have to worry about tricking your script into reading from
2850             environment variables). Before you do this you will need to change the
2851             debug level from the default level of 0 (no debug) to either 1 if you
2852             want to debug from @ARGV (the command line) of 2 if you want to debug from
2853             STDIN. You can do this using the debug pragma like this:
2854              
2855             use CGI::Simple qw(-debug2); # set debug to level 2 => from STDIN
2856              
2857             or this:
2858              
2859             $CGI::Simple::DEBUG = 1; # set debug to level 1 => from @ARGV
2860              
2861             At debug level 1 you can pass keywords and name=value pairs like this:
2862              
2863             your_script.pl keyword1 keyword2 keyword3
2864              
2865             or this:
2866              
2867             your_script.pl keyword1+keyword2+keyword3
2868              
2869             or this:
2870              
2871             your_script.pl name1=value1 name2=value2
2872              
2873             or this:
2874              
2875             your_script.pl name1=value1&name2=value2
2876              
2877             At debug level 2 you can feed newline-delimited name=value
2878             pairs to the script on standard input. You will be presented
2879             with the following prompt:
2880              
2881             (offline mode: enter name=value pairs on standard input)
2882              
2883             You end the input with your system dependent end of file character.
2884             You should try ^Z ^X ^D and ^C if all else fails. The ^ means hold down
2885             the [Ctrl] button while you press the other key.
2886              
2887             When debugging, you can use quotes and backslashes to escape
2888             characters in the familiar shell manner, letting you place
2889             spaces and other funny characters in your parameter=value
2890             pairs:
2891              
2892             your_script.pl "name1='I am a long value'" "name2=two\ words"
2893              
2894             =head2 Dump() Dumping the current object details
2895              
2896             The B method produces a string consisting of all the
2897             query's object attributes formatted nicely as a nested list. This dump
2898             includes the name/value pairs and a number of other details. This is useful
2899             for debugging purposes:
2900              
2901             print $q->Dump
2902              
2903             The actual result of this is HTML escaped formatted text wrapped in
 tags 
2904             so if you send it straight to the browser it produces something that looks
2905             like:
2906              
2907             $VAR1 = bless( {
2908             '.parameters' => [
2909             'name',
2910             'color'
2911             ],
2912             '.globals' => {
2913             'FATAL' => -1,
2914             'DEBUG' => 0,
2915             'NO_NULL' => 1,
2916             'POST_MAX' => 102400,
2917             'USE_CGI_PM_DEFAULTS' => 0,
2918             'HEADERS_ONCE' => 0,
2919             'NPH' => 0,
2920             'DISABLE_UPLOADS' => 1,
2921             'NO_UNDEF_PARAMS' => 0,
2922             'USE_PARAM_SEMICOLONS' => 0
2923             },
2924             '.fieldnames' => {
2925             'color' => '1',
2926             'name' => '1'
2927             },
2928             '.mod_perl' => '',
2929             'color' => [
2930             'red',
2931             'green',
2932             'blue'
2933             ],
2934             'name' => [
2935             'JaPh,'
2936             ]
2937             }, 'CGI::Simple' );
2938              
2939             You may recognize this as valid Perl syntax (which it is) and/or the output
2940             from Data::Dumper (also true). This is the actual guts of how the information
2941             is stored in the query object. All the internal params start with a . char
2942              
2943             Alternatively you can dump your object and the current environment using:
2944              
2945             print $q->Dump(\%ENV);
2946              
2947             =head2 PrintEnv() Dumping the environment
2948              
2949             You can get a similar browser friendly dump of the current %ENV hash using:
2950              
2951             print $q->PrintEnv;
2952              
2953             This will produce something like (in the browser):
2954              
2955             $VAR1 = {
2956             'QUERY_STRING' => 'name=JaPh%2C&color=red&color=green&color=blue',
2957             'CONTENT_TYPE' => 'application/x-www-form-urlencoded',
2958             'REGRESSION_TEST' => 'simple.t.pl',
2959             'VIM' => 'C:\\WINDOWS\\Desktop\\vim',
2960             'HTTP_REFERER' => 'xxx.sex.com',
2961             'HTTP_USER_AGENT' => 'LWP',
2962             'HTTP_ACCEPT' => 'text/html;q=1, image/gif;q=0.42, */*;q=0.001',
2963             'REMOTE_HOST' => 'localhost',
2964             'HTTP_HOST' => 'the.restaurant.at.the.end.of.the.universe',
2965             'GATEWAY_INTERFACE' => 'bleeding edge',
2966             'REMOTE_IDENT' => 'None of your damn business',
2967             'SCRIPT_NAME' => '/cgi-bin/foo.cgi',
2968             'SERVER_NAME' => 'nowhere.com',
2969             'HTTP_COOKIE' => '',
2970             'CONTENT_LENGTH' => '42',
2971             'HTTPS_A' => 'A',
2972             'HTTP_FROM' => 'spammer@nowhere.com',
2973             'HTTPS_B' => 'B',
2974             'SERVER_PROTOCOL' => 'HTTP/1.0',
2975             'PATH_TRANSLATED' => '/usr/local/somewhere/else',
2976             'SERVER_SOFTWARE' => 'Apache - accept no substitutes',
2977             'PATH_INFO' => '/somewhere/else',
2978             'REMOTE_USER' => 'Just another Perl hacker,',
2979             'REMOTE_ADDR' => '127.0.0.1',
2980             'HTTPS' => 'ON',
2981             'DOCUMENT_ROOT' => '/vs/www/foo',
2982             'REQUEST_METHOD' => 'GET',
2983             'REDIRECT_QUERY_STRING' => '',
2984             'AUTH_TYPE' => 'PGP MD5 DES rot13',
2985             'COOKIE' => 'foo=a%20phrase; bar=yes%2C%20a%20phrase&;I%20say;',
2986             'SERVER_PORT' => '8080'
2987             };
2988              
2989              
2990             =head2 cgi_error() Retrieving CGI::Simple error messages
2991              
2992             Errors can occur while processing user input, particularly when
2993             processing uploaded files. When these errors occur, CGI::Simple will stop
2994             processing and return an empty parameter list. You can test for
2995             the existence and nature of errors using the B function.
2996             The error messages are formatted as HTTP status codes. You can either
2997             incorporate the error text into an HTML page, or use it as the value
2998             of the HTTP status:
2999              
3000             my $error = $q->cgi_error;
3001             if ($error) {
3002             print $q->header(-status=>$error);
3003             print "

$error

;
3004             exit;
3005             }
3006              
3007             =cut
3008              
3009             ############### Accessor Methods ################
3010              
3011             =head1 ACCESSOR METHODS
3012              
3013             =head2 version() Get the CGI::Simple version info
3014              
3015             $version = $q->version();
3016              
3017             The B method returns the value of $VERSION
3018              
3019             =head2 nph() Enable/disable NPH (Non Parsed Header) mode
3020              
3021             $q->nph(1); # enable NPH mode
3022             $q->nph(0); # disable NPH mode
3023              
3024             The B method enables and disables NPH headers. See the NPH section.
3025              
3026             =head2 all_parameters() Get the names/values of all parameters
3027              
3028             @all_parameters = $q->all_parameters();
3029              
3030             The B method is an alias for B
3031              
3032             =head2 charset() Get/set the current character set.
3033              
3034             $charset = $q->charset(); # get current charset
3035             $q->charset('utf-42'); # set the charset
3036              
3037             The B method gets the current charset value if no argument is
3038             supplied or sets it if an argument is supplied.
3039              
3040             =head2 crlf() Get the system specific line ending sequence
3041              
3042             $crlf = $q->crlf();
3043              
3044             The B method returns the system specific line ending sequence.
3045              
3046             =head2 globals() Get/set the value of the remaining global variables
3047              
3048             $globals = $q->globals('FATAL'); # get the current value of $FATAL
3049             $globals = $q->globals('FATAL', 1 ); # set croak mode on cgi_error()
3050              
3051             The B method gets/sets the values of the global variables after the
3052             script has been invoked. For globals like $POST_MAX and $DISABLE_UPLOADS this
3053             makes no difference as they must be set prior to calling the new constructor
3054             but there might be reason the change the value of others.
3055              
3056             =head2 auth_type() Get the current authorization/verification method
3057              
3058             $auth_type = $q->auth_type();
3059              
3060             The B method returns the value of $ENV{'AUTH_TYPE'} which should
3061             contain the authorization/verification method in use for this script, if any.
3062              
3063             =head2 content_length() Get the content length submitted in a POST
3064              
3065             $content_length = $q->content_length();
3066              
3067             The B method returns the value of $ENV{'AUTH_TYPE'}
3068              
3069             =head2 content_type() Get the content_type of data submitted in a POST
3070              
3071             $content_type = $q->content_type();
3072              
3073             The B method returns the content_type of data submitted in
3074             a POST, generally 'multipart/form-data' or
3075             'application/x-www-form-urlencoded' as supplied in $ENV{'CONTENT_TYPE'}
3076              
3077             =head2 document_root() Get the document root
3078              
3079             $document_root = $q->document_root();
3080              
3081             The B method returns the value of $ENV{'DOCUMENT_ROOT'}
3082              
3083             =head2 gateway_interface() Get the gateway interface
3084              
3085             $gateway_interface = $q->gateway_interface();
3086              
3087             The B method returns the value of
3088             $ENV{'GATEWAY_INTERFACE'}
3089              
3090             =head2 path_translated() Get the value of path translated
3091              
3092             $path_translated = $q->path_translated();
3093              
3094             The B method returns the value of $ENV{'PATH_TRANSLATED'}
3095              
3096             =head2 referer() Spy on your users
3097              
3098             $referer = $q->referer();
3099              
3100             The B method returns the value of $ENV{'REFERER'} This will return
3101             the URL of the page the browser was viewing prior to fetching your script.
3102             Not available for all browsers.
3103              
3104             =head2 remote_addr() Get the remote address
3105              
3106             $remote_addr = $q->remote_addr();
3107              
3108             The B method returns the value of $ENV{'REMOTE_ADDR'} or
3109             127.0.0.1 (localhost) if this is not defined.
3110              
3111             =head2 remote_host() Get a value for remote host
3112              
3113             $remote_host = $q->remote_host();
3114              
3115             The B method returns the value of $ENV{'REMOTE_HOST'} if it is
3116             defined. If this is not defined it returns $ENV{'REMOTE_ADDR'} If this is not
3117             defined it returns 'localhost'
3118              
3119             =head2 remote_ident() Get the remote identity
3120              
3121             $remote_ident = $q->remote_ident();
3122              
3123             The B method returns the value of $ENV{'REMOTE_IDENT'}
3124              
3125             =head2 remote_user() Get the remote user
3126              
3127             $remote_user = $q->remote_user();
3128              
3129             The B method returns the authorization/verification name used
3130             for user verification, if this script is protected. The value comes from
3131             $ENV{'REMOTE_USER'}
3132              
3133             =head2 request_method() Get the request method
3134              
3135             $request_method = $q->request_method();
3136              
3137             The B method returns the method used to access your
3138             script, usually one of 'POST', 'GET' or 'HEAD' as supplied by
3139             $ENV{'REQUEST_METHOD'}
3140              
3141             =head2 script_name() Get the script name
3142              
3143             $script_name = $q->script_name();
3144              
3145             The B method returns the value of $ENV{'SCRIPT_NAME'} if it is
3146             defined. Otherwise it returns Perl's script name from $0. Failing this it
3147             returns a null string ''
3148              
3149             =head2 server_name() Get the server name
3150              
3151             $server_name = $q->server_name();
3152              
3153             The B method returns the value of $ENV{'SERVER_NAME'} if defined
3154             or 'localhost' otherwise
3155              
3156             =head2 server_port() Get the port the server is listening on
3157              
3158             $server_port = $q->server_port();
3159              
3160             The B method returns the value $ENV{'SERVER_PORT'} if defined or
3161             80 if not.
3162              
3163             =head2 server_protocol() Get the current server protocol
3164              
3165             $server_protocol = $q->server_protocol();
3166              
3167             The B method returns the value of $ENV{'SERVER_PROTOCOL'} if
3168             defined or 'HTTP/1.0' otherwise
3169              
3170             =head2 server_software() Get the server software
3171              
3172             $server_software = $q->server_software();
3173              
3174             The B method returns the value $ENV{'SERVER_SOFTWARE'} or
3175             'cmdline' If the server software is IIS it formats your hard drive, installs
3176             Linux, FTPs to www.apache.org, installs Apache, and then restores your system
3177             from tape. Well maybe not, but it's a nice thought.
3178              
3179             =head2 user_name() Get a value for the user name.
3180              
3181             $user_name = $q->user_name();
3182              
3183             Attempt to obtain the remote user's name, using a variety of different
3184             techniques. This only works with older browsers such as Mosaic.
3185             Newer browsers do not report the user name for privacy reasons!
3186              
3187             Technically the B method returns the value of $ENV{'HTTP_FROM'}
3188             or failing that $ENV{'REMOTE_IDENT'} or as a last choice $ENV{'REMOTE_USER'}
3189              
3190             =head2 user_agent() Get the users browser type
3191              
3192             $ua = $q->user_agent(); # return the user agent
3193             $ok = $q->user_agent('mozilla'); # return true if user agent 'mozilla'
3194              
3195             The B method returns the value of $ENV{'HTTP_USER_AGENT'} when
3196             called without an argument or true or false if the $ENV{'HTTP_USER_AGENT'}
3197             matches the passed argument. The matching is case insensitive and partial.
3198              
3199             =head2 virtual_host() Get the virtual host
3200              
3201             $virtual_host = $q->virtual_host();
3202              
3203             The B method returns the value of $ENV{'HTTP_HOST'} if defined
3204             or $ENV{'SERVER_NAME'} as a default. Port numbers are removed.
3205              
3206             =head2 path_info() Get any extra path info set to the script
3207              
3208             $path_info = $q->path_info();
3209              
3210             The B method returns additional path information from the script
3211             URL. E.G. fetching /cgi-bin/your_script/additional/stuff will result in
3212             $q->path_info() returning "/additional/stuff".
3213              
3214             NOTE: The Microsoft Internet Information Server
3215             is broken with respect to additional path information. If
3216             you use the Perl DLL library, the IIS server will attempt to
3217             execute the additional path information as a Perl script.
3218             If you use the ordinary file associations mapping, the
3219             path information will be present in the environment,
3220             but incorrect. The best thing to do is to avoid using additional
3221             path information in CGI scripts destined for use with IIS.
3222              
3223             =head2 Accept() Get the browser MIME types
3224              
3225             $Accept = $q->Accept();
3226              
3227             The B method returns a list of MIME types that the remote browser
3228             accepts. If you give this method a single argument corresponding to a
3229             MIME type, as in $q->Accept('text/html'), it will return a floating point
3230             value corresponding to the browser's preference for this type from 0.0
3231             (don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
3232             list are handled correctly.
3233              
3234             =head2 accept() Alias for Accept()
3235              
3236             $accept = $q->accept();
3237              
3238             The B Method is an alias for Accept()
3239              
3240             =head2 http() Get a range of HTTP related information
3241              
3242             $http = $q->http();
3243              
3244             Called with no arguments the B method returns the list of HTTP or HTTPS
3245             environment variables, including such things as HTTP_USER_AGENT,
3246             HTTP_ACCEPT_LANGUAGE, and HTTP_ACCEPT_CHARSET, corresponding to the
3247             like-named HTTP header fields in the request. Called with the name of
3248             an HTTP header field, returns its value. Capitalization and the use
3249             of hyphens versus underscores are not significant.
3250              
3251             For example, all three of these examples are equivalent:
3252              
3253             $requested_language = $q->http('Accept-language');
3254             $requested_language = $q->http('Accept_language');
3255             $requested_language = $q->http('HTTP_ACCEPT_LANGUAGE');
3256              
3257             =head2 https() Get a range of HTTPS related information
3258              
3259             $https = $q->https();
3260              
3261             The B method is similar to the http() method except that when called
3262             without an argument it returns the value of $ENV{'HTTPS'} which will be
3263             true if a HTTPS connection is in use and false otherwise.
3264              
3265             =head2 protocol() Get the current protocol
3266              
3267             $protocol = $q->protocol();
3268              
3269             The B method returns 'https' if a HTTPS connection is in use or the
3270             B minus version numbers ('http') otherwise.
3271              
3272             =head2 url() Return the script's URL in several formats
3273              
3274             $full_url = $q->url();
3275             $full_url = $q->url(-full=>1);
3276             $relative_url = $q->url(-relative=>1);
3277             $absolute_url = $q->url(-absolute=>1);
3278             $url_with_path = $q->url(-path_info=>1);
3279             $url_with_path_and_query = $q->url(-path_info=>1,-query=>1);
3280             $netloc = $q->url(-base => 1);
3281              
3282             B returns the script's URL in a variety of formats. Called
3283             without any arguments, it returns the full form of the URL, including
3284             host name and port number
3285              
3286             http://your.host.com/path/to/script.cgi
3287              
3288             You can modify this format with the following named arguments:
3289              
3290             =over 4
3291              
3292             =item B<-absolute>
3293              
3294             If true, produce an absolute URL, e.g.
3295              
3296             /path/to/script.cgi
3297              
3298             =item B<-relative>
3299              
3300             Produce a relative URL. This is useful if you want to reinvoke your
3301             script with different parameters. For example:
3302              
3303             script.cgi
3304              
3305             =item B<-full>
3306              
3307             Produce the full URL, exactly as if called without any arguments.
3308             This overrides the -relative and -absolute arguments.
3309              
3310             =item B<-path> (B<-path_info>)
3311              
3312             Append the additional path information to the URL. This can be
3313             combined with B<-full>, B<-absolute> or B<-relative>. B<-path_info>
3314             is provided as a synonym.
3315              
3316             =item B<-query> (B<-query_string>)
3317              
3318             Append the query string to the URL. This can be combined with
3319             B<-full>, B<-absolute> or B<-relative>. B<-query_string> is provided
3320             as a synonym.
3321              
3322             =item B<-base>
3323              
3324             Generate just the protocol and net location, as in http://www.foo.com:8000
3325              
3326             =back
3327              
3328             =head2 self_url() Get the scripts complete URL
3329              
3330             $self_url = $q->self_url();
3331              
3332             The B method returns the value of:
3333              
3334             $self->url( '-path_info'=>1, '-query'=>1, '-full'=>1 );
3335              
3336             =head2 state() Alias for self_url()
3337              
3338             $state = $q->state();
3339              
3340             The B method is an alias for self_url()
3341              
3342             =cut
3343              
3344             ################# cgi-lib.pl Compatibility Methods #################
3345              
3346             =head1 COMPATIBILITY WITH cgi-lib.pl 2.18
3347              
3348             To make it easier to port existing programs that use cgi-lib.pl all
3349             the subs within cgi-lib.pl are available in CGI::Simple. Using the
3350             functional interface of CGI::Simple::Standard porting is
3351             as easy as:
3352              
3353             OLD VERSION
3354             require "cgi-lib.pl";
3355             &ReadParse;
3356             print "The value of the antique is $in{'antique'}.\n";
3357              
3358             NEW VERSION
3359             use CGI::Simple::Standard qw(:cgi-lib);
3360             &ReadParse;
3361             print "The value of the antique is $in{'antique'}.\n";
3362              
3363             CGI:Simple's B routine creates a variable named %in,
3364             which can be accessed to obtain the query variables. Like
3365             ReadParse, you can also provide your own variable via a glob. Infrequently
3366             used features of B, such as the creation of @in and $in
3367             variables, are not supported.
3368              
3369             You can also use the OO interface of CGI::Simple and call B and
3370             other cgi-lib.pl functions like this:
3371              
3372             &CGI::Simple::ReadParse; # get hash values in %in
3373              
3374             my $q = CGI::Simple->new;
3375             $q->ReadParse(); # same thing
3376              
3377             CGI::Simple::ReadParse(*field); # get hash values in %field function style
3378              
3379             my $q = CGI::Simple->new;
3380             $q->ReadParse(*field); # same thing
3381              
3382             Once you use B under the functional interface , you can retrieve
3383             the query object itself this way if needed:
3384              
3385             $q = $in{'CGI'};
3386              
3387             Either way it allows you to start using the more interesting features
3388             of CGI.pm without rewriting your old scripts from scratch.
3389              
3390             Unlike CGI.pm all the cgi-lib.pl functions from Version 2.18 are supported:
3391              
3392             ReadParse()
3393             SplitParam()
3394             MethGet()
3395             MethPost()
3396             MyBaseUrl()
3397             MyURL()
3398             MyFullUrl()
3399             PrintHeader()
3400             HtmlTop()
3401             HtmlBot()
3402             PrintVariables()
3403             PrintEnv()
3404             CgiDie()
3405             CgiError()
3406              
3407             =head1 COMPATIBILITY WITH CGI.pm
3408              
3409             I has long been suggested that the CGI and HTML parts of CGI.pm should be
3410             split into separate modules (even the author suggests this!), CGI::Simple
3411             represents the realization of this and contains the complete CGI side of
3412             CGI.pm. Code-wise it weighs in at a little under 30% of the size of CGI.pm at
3413             a little under 1000 lines.
3414              
3415             A great deal of care has been taken to ensure that the interface remains
3416             unchanged although a few tweaks have been made. The test suite is extensive
3417             and includes all the CGI.pm test scripts as well as a series of new test
3418             scripts. You may like to have a look at /t/concur.t which makes 160 tests
3419             of CGI::Simple and CGI in parallel and compares the results to ensure they
3420             are identical. This is the case as of CGI.pm 2.78.
3421              
3422             You can't make an omelet without breaking eggs. A large number of methods
3423             and global variables have been deleted as detailed below. Some pragmas are
3424             also gone. In the tarball there is a script B that will check if
3425             a script seems to be using any of these now non existent methods, globals or
3426             pragmas. You call it like this:
3427              
3428             perl check.pl
3429              
3430             If it finds any likely candidates it will print a line with the line number,
3431             problem method/global and the complete line. For example here is some output
3432             from running the script on CGI.pm:
3433              
3434             ...
3435             3162: Problem:'$CGI::OS' local($CRLF) = "\015\012" if $CGI::OS eq 'VMS';
3436             3165: Problem:'fillBuffer' $self->fillBuffer($FILLUNIT);
3437             ....
3438              
3439             =head1 DIFFERENCES FROM CGI.pm
3440              
3441             CGI::Simple is strict and warnings compliant.
3442              
3443             There are 4 modules in this distribution:
3444              
3445             CGI/Simple.pm supplies all the core code.
3446             CGI/Simple/Cookie.pm supplies the cookie handling functions.
3447             CGI/Simple/Util.pm supplies a variety of utility functions
3448             CGI/Simple/Standard.pm supplies a functional interface for Simple.pm
3449              
3450             Simple.pm is the core module that provide all the essential functionality.
3451             Cookie.pm is a shortened rehash of the CGI.pm module of the same name
3452             which supplies the required cookie functionality. Util.pm has been recoded to
3453             use an internal object for data storage and supplies rarely needed non core
3454             functions and/or functions needed for the HTML side of things. Standard.pm is
3455             a wrapper module that supplies a complete functional interface to the OO
3456             back end supplied by CGI::Simple.
3457              
3458             Although a serious attempt has been made to keep the interface identical,
3459             some minor changes and tweaks have been made. They will likely be
3460             insignificant to most users but here are the gory details.
3461              
3462             =head2 Globals Variables
3463              
3464             The list of global variables has been pruned by 75%. Here is the complete
3465             list of the global variables used:
3466              
3467             $VERSION = "0.01";
3468             # set this to 1 to use CGI.pm default global settings
3469             $USE_CGI_PM_DEFAULTS = 0 unless defined $USE_CGI_PM_DEFAULTS;
3470             # see if user wants old CGI.pm defaults
3471             do{ _use_cgi_pm_global_settings(); return } if $USE_CGI_PM_DEFAULTS;
3472             # no file uploads by default, set to 0 to enable uploads
3473             $DISABLE_UPLOADS = 1 unless defined $DISABLE_UPLOADS;
3474             # use a post max of 100K, set to -1 for no limits
3475             $POST_MAX = 102_400 unless defined $POST_MAX;
3476             # do not include undefined params parsed from query string
3477             $NO_UNDEF_PARAMS = 0 unless defined $NO_UNDEF_PARAMS;
3478             # separate the name=value pairs with ; rather than &
3479             $USE_PARAM_SEMICOLONS = 0 unless defined $USE_PARAM_SEMICOLONS;
3480             # only print headers once
3481             $HEADERS_ONCE = 0 unless defined $HEADERS_ONCE;
3482             # Set this to 1 to enable NPH scripts
3483             $NPH = 0 unless defined $NPH;
3484             # 0 => no debug, 1 => from @ARGV, 2 => from STDIN
3485             $DEBUG = 0 unless defined $DEBUG;
3486             # filter out null bytes in param - value pairs
3487             $NO_NULL = 1 unless defined $NO_NULL;
3488             # set behavior when cgi_err() called -1 => silent, 0 => carp, 1 => croak
3489             $FATAL = -1 unless defined $FATAL;
3490              
3491             Four of the default values of the old CGI.pm variables have been changed.
3492             Unlike CGI.pm which by default allows unlimited POST data and file uploads
3493             by default CGI::Simple limits POST data size to 100kB and denies file uploads
3494             by default. $USE_PARAM_SEMICOLONS is set to 0 by default so we use (old style)
3495             & rather than ; as the pair separator for query strings. Debugging is
3496             disabled by default.
3497              
3498             There are three new global variables. If $NO_NULL is true (the default) then
3499             CGI::Simple will strip null bytes out of names, values and keywords. Null
3500             bytes can do interesting things to C based code like Perl. Uploaded files
3501             are not touched. $FATAL controls the behavior when B is called.
3502             The default value of -1 makes errors silent. $USE_CGI_PM_DEFAULTS reverts the
3503             defaults to the CGI.pm standard values ie unlimited file uploads via POST
3504             for DNS attacks. You can also get the defaults back by using the '-default'
3505             pragma in the use:
3506              
3507             use CGI::Simple qw(-default);
3508             use CGI::Simple::Standard qw(-default);
3509              
3510             The values of the global variables are stored in the CGI::Simple object and
3511             can be referenced and changed using the B method like this:
3512              
3513             my $value = $q->globals( 'VARNAME' ); # get
3514             $q->globals( 'VARNAME', 'some value' ); # set
3515              
3516             As with many CGI.pm methods if you pass the optional value that will
3517             be set.
3518              
3519             The $CGI::Simple::VARNAME = 'N' syntax is only useful prior to calling the
3520             B constructor. After that all reference is to the values stored in the
3521             CGI::Simple object so you must change these using the B method.
3522              
3523             $DISABLE_UPLOADS and $POST_MAX *must* be set prior to calling the constructor
3524             if you want the changes to have any effect as they control behavior during
3525             initialization. This is the same a CGI.pm although some people seem to miss
3526             this rather important point and set these after calling the constructor which
3527             does nothing.
3528              
3529             The following globals are no longer relevant and have all been deleted:
3530              
3531             $AUTOLOADED_ROUTINES
3532             $AUTOLOAD_DEBUG
3533             $BEEN_THERE
3534             $CRLF
3535             $DEFAULT_DTD
3536             $EBCDIC
3537             $FH
3538             $FILLUNIT
3539             $IIS
3540             $IN
3541             $INITIAL_FILLUNIT
3542             $JSCRIPT
3543             $MAC
3544             $MAXTRIES
3545             $MOD_PERL
3546             $NOSTICKY
3547             $OS
3548             $PERLEX
3549             $PRIVATE_TEMPFILES
3550             $Q
3551             $QUERY_CHARSET
3552             $QUERY_PARAM
3553             $SCRATCH
3554             $SL
3555             $SPIN_LOOP_MAX
3556             $TIMEOUT
3557             $TMPDIRECTORY
3558             $XHTML
3559             %EXPORT
3560             %EXPORT_OK
3561             %EXPORT_TAGS
3562             %OVERLOAD
3563             %QUERY_FIELDNAMES
3564             %SUBS
3565             @QUERY_PARAM
3566             @TEMP
3567              
3568             Notes: CGI::Simple uses IO::File->new_tmpfile to get tempfile filehandles.
3569             These are private by default so $PRIVATE_TEMPFILES is no longer required nor
3570             is $TMPDIRECTORY. The value that were stored in $OS, $CRLF, $QUERY_CHARSET
3571             and $EBCDIC are now stored in the CGI::Simple::Util object where they find
3572             most of their use. The $MOD_PERL and $PERLEX values are now stored in our
3573             CGI::Simple object. $IIS was only used once in path_info(). $SL the system
3574             specific / \ : path delimiter is not required as we let IO::File handle our
3575             tempfile requirements. The rest of the globals are HTML related, export
3576             related, hand rolled autoload related or serve obscure purposes in CGI.pm
3577              
3578             =head2 Changes to pragmas
3579              
3580             There are some new pragmas available. See the pragmas section for details.
3581             The following CGI.pm pragmas are not available:
3582              
3583             -any
3584             -compile
3585             -nosticky
3586             -no_xhtml
3587             -private_tempfiles
3588              
3589             =head2 Filehandles
3590              
3591             Unlike CGI.pm which tries to accept all filehandle like objects only \*FH
3592             and $fh are accepted by CGI::Simple as file accessors for B and B.
3593             IO::File objects work fine.
3594              
3595             =head2 Hash interface
3596              
3597             %hash = $q->Vars(); # pack values with "\0";
3598             %hash = $q->Vars(","); # comma separate values
3599              
3600             You may optionally pass B a string that will be used to separate multiple
3601             values when they are packed into the single hash value. If no value is
3602             supplied the default "\0" (null byte) will be used. Null bytes are dangerous
3603             things for C based code (ie Perl).
3604              
3605             =head2 cgi-lib.pl
3606              
3607             All the cgi-lib.pl 2.18 routines are supported. Unlike CGI.pm all the
3608             subroutines from cgi-lib.pl are included. They have been GOLFED down to
3609             25 lines but they all work pretty much the same as the originals.
3610              
3611             =head1 CGI::Simple COMPLETE METHOD LIST
3612              
3613             Here is a complete list of all the CGI::Simple methods.
3614              
3615             =head2 Guts (hands off, except of course for new)
3616              
3617             _initialize_globals
3618             _use_cgi_pm_global_settings
3619             _store_globals
3620             import
3621             _reset_globals
3622             new
3623             _initialize
3624             _read_parse
3625             _parse_params
3626             _add_param
3627             _parse_keywordlist
3628             _parse_multipart
3629             _save_tmpfile
3630             _read_data
3631              
3632             =head2 Core Methods
3633              
3634             param
3635             add_param
3636             param_fetch
3637             url_param
3638             keywords
3639             Vars
3640             append
3641             delete
3642             Delete
3643             delete_all
3644             Delete_all
3645             upload
3646             upload_info
3647             query_string
3648             parse_query_string
3649             parse_keywordlist
3650              
3651             =head2 Save and Restore from File Methods
3652              
3653             _init_from_file
3654             save
3655             save_parameters
3656              
3657             =head2 Miscellaneous Methods
3658              
3659             url_decode
3660             url_encode
3661             escapeHTML
3662             unescapeHTML
3663             put
3664             print
3665              
3666             =head2 Cookie Methods
3667              
3668             cookie
3669             raw_cookie
3670              
3671             =head2 Header Methods
3672              
3673             header
3674             cache
3675             no_cache
3676             redirect
3677              
3678             =head2 Server Push Methods
3679              
3680             multipart_init
3681             multipart_start
3682             multipart_end
3683             multipart_final
3684              
3685             =head2 Debugging Methods
3686              
3687             read_from_cmdline
3688             Dump
3689             as_string
3690             cgi_error
3691              
3692             =head2 cgi-lib.pl Compatibility Routines - all 2.18 functions available
3693              
3694             _shift_if_ref
3695             ReadParse
3696             SplitParam
3697             MethGet
3698             MethPost
3699             MyBaseUrl
3700             MyURL
3701             MyFullUrl
3702             PrintHeader
3703             HtmlTop
3704             HtmlBot
3705             PrintVariables
3706             PrintEnv
3707             CgiDie
3708             CgiError
3709              
3710             =head2 Accessor Methods
3711              
3712             version
3713             nph
3714             all_parameters
3715             charset
3716             crlf # new, returns OS specific CRLF sequence
3717             globals # get/set global variables
3718             auth_type
3719             content_length
3720             content_type
3721             document_root
3722             gateway_interface
3723             path_translated
3724             referer
3725             remote_addr
3726             remote_host
3727             remote_ident
3728             remote_user
3729             request_method
3730             script_name
3731             server_name
3732             server_port
3733             server_protocol
3734             server_software
3735             user_name
3736             user_agent
3737             virtual_host
3738             path_info
3739             Accept
3740             accept
3741             http
3742             https
3743             protocol
3744             url
3745             self_url
3746             state
3747              
3748             =head1 NEW METHODS IN CGI::Simple
3749              
3750             There are a few new methods in CGI::Simple as listed below. The highlights are
3751             the B method to add the QUERY_STRING data to your object if
3752             the method was POST. The B method adds an expires now directive and
3753             the Pragma: no-cache directive to the header to encourage some browsers to
3754             do the right thing. B from the cgi-lib.pl routines will dump an
3755             HTML friendly list of the %ENV and makes a handy addition to B for use
3756             in debugging. The upload method now accepts a filepath as an optional second
3757             argument as shown in the synopsis. If this is supplied the uploaded file will
3758             be written to there automagically.
3759              
3760             =head2 Internal Routines
3761              
3762             _initialize_globals()
3763             _use_cgi_pm_global_settings()
3764             _store_globals()
3765             _initialize()
3766             _init_from_file()
3767             _read_parse()
3768             _parse_params()
3769             _add_param()
3770             _parse_keywordlist()
3771             _parse_multipart()
3772             _save_tmpfile()
3773             _read_data()
3774              
3775             =head2 New Public Methods
3776              
3777             add_param() # adds a param/value(s) pair +/- overwrite
3778             upload_info() # uploaded files MIME type and size
3779             url_decode() # decode s url encoded string
3780             url_encode() # url encode a string
3781             parse_query_string() # add QUERY_STRING data to $q object if 'POST'
3782             no_cache() # add both the Pragma: no-cache
3783             # and Expires/Date => 'now' to header
3784              
3785             =head2 cgi-lib.pl methods added for completeness
3786              
3787             _shift_if_ref() # internal hack reminiscent of self_or_default :-)
3788             MyBaseUrl()
3789             MyURL()
3790             MyFullUrl()
3791             PrintVariables()
3792             PrintEnv()
3793             CgiDie()
3794             CgiError()
3795              
3796             =head2 New Accessors
3797              
3798             crlf() # returns CRLF sequence
3799             globals() # global vars now stored in $q object - get/set
3800             content_length() # returns $ENV{'CONTENT_LENGTH'}
3801             document_root() # returns $ENV{'DOCUMENT_ROOT'}
3802             gateway_interface() # returns $ENV{'GATEWAY_INTERFACE'}
3803              
3804             =head1 METHODS IN CGI.pm NOT IN CGI::Simple
3805              
3806             Here is a complete list of what is not included in CGI::Simple. Basically all
3807             the HTML related stuff plus large redundant chunks of the guts. The check.pl
3808             script in the /misc dir will check to see if a script is using any of these.
3809              
3810             =head2 Guts - rearranged, recoded, renamed and hacked out of existence
3811              
3812             initialize_globals()
3813             compile()
3814             expand_tags()
3815             self_or_default()
3816             self_or_CGI()
3817             init()
3818             to_filehandle()
3819             save_request()
3820             parse_params()
3821             add_parameter()
3822             binmode()
3823             _make_tag_func()
3824             AUTOLOAD()
3825             _compile()
3826             _setup_symbols()
3827             new_MultipartBuffer()
3828             read_from_client()
3829             import_names() # I dislike this and left it out, so shoot me.
3830              
3831             =head2 HTML Related
3832              
3833             autoEscape()
3834             URL_ENCODED()
3835             MULTIPART()
3836             SERVER_PUSH()
3837             start_html()
3838             _style()
3839             _script()
3840             end_html()
3841             isindex()
3842             startform()
3843             start_form()
3844             end_multipart_form()
3845             start_multipart_form()
3846             endform()
3847             end_form()
3848             _textfield()
3849             textfield()
3850             filefield()
3851             password_field()
3852             textarea()
3853             button()
3854             submit()
3855             reset()
3856             defaults()
3857             comment()
3858             checkbox()
3859             checkbox_group()
3860             _tableize()
3861             radio_group()
3862             popup_menu()
3863             scrolling_list()
3864             hidden()
3865             image_button()
3866             nosticky()
3867             default_dtd()
3868              
3869             =head2 Upload Related
3870              
3871             CGI::Simple uses anonymous tempfiles supplied by IO::File to spool uploaded
3872             files to.
3873              
3874             private_tempfiles() # automatic in CGI::Simple
3875             tmpFileName() # all upload files are anonymous
3876             uploadInfo() # relied on FH access, replaced with upload_info()
3877              
3878              
3879             =head2 Really Private Subs (marked as so)
3880              
3881             previous_or_default()
3882             register_parameter()
3883             get_fields()
3884             _set_values_and_labels()
3885             _compile_all()
3886             asString()
3887             compare()
3888              
3889             =head2 Internal Multipart Parsing Routines
3890              
3891             read_multipart()
3892             readHeader()
3893             readBody()
3894             read()
3895             fillBuffer()
3896             eof()
3897              
3898             =head1 EXPORT
3899              
3900             Nothing.
3901              
3902             =head1 AUTHOR INFORMATION
3903              
3904             Originally copyright 2001 Dr James Freeman Ejfreeman@tassie.net.auE
3905             This release by Andy Armstrong
3906              
3907             This package is free software and is provided "as is" without express or
3908             implied warranty. It may be used, redistributed and/or modified under the terms
3909             of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html)
3910              
3911             Address bug reports and comments to: andy@hexten.net. When sending
3912             bug reports, please provide the version of CGI::Simple, the version of
3913             Perl, the name and version of your Web server, and the name and
3914             version of the operating system you are using. If the problem is even
3915             remotely browser dependent, please provide information about the
3916             affected browsers as well.
3917              
3918             Address bug reports and comments to: andy@hexten.net
3919              
3920             =head1 CREDITS
3921              
3922             Lincoln D. Stein (lstein@cshl.org) and everyone else who worked on the
3923             original CGI.pm upon which this module is heavily based
3924              
3925             Brandon Black for some heavy duty testing and bug fixes
3926              
3927             John D Robinson and Jeroen Latour for helping solve some interesting test
3928             failures as well as Perlmonks:
3929             tommyw, grinder, Jaap, vek, erasei, jlongino and strider_corinth
3930              
3931             Thanks for patches to:
3932              
3933             Ewan Edwards, Joshua N Pritikin, Mike Barry, Michael Nachbaur, Chris
3934             Williams, Mark Stosberg, Krasimir Berov, Yamada Masahiro
3935              
3936             =head1 LICENCE AND COPYRIGHT
3937              
3938             Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved.
3939              
3940             This module is free software; you can redistribute it and/or
3941             modify it under the same terms as Perl itself. See L.
3942              
3943             =head1 SEE ALSO
3944              
3945             B, L, L,
3946             L, L
3947              
3948             =cut