4 # See the bottom of this file for the POD documentation. Search for the
7 # You can run this file through either pod2man or pod2html to produce pretty
8 # documentation in manual or html file format (these utilities are part of the
9 # Perl 5 distribution).
11 # Copyright 1995-1998 Lincoln D. Stein. All rights reserved.
12 # It may be used and modified freely, but I do request that this copyright
13 # notice remain attached to the file. You may modify this module as you
14 # wish, but if you redistribute a modified version, please attach a note
15 # listing the modifications you have made.
17 # The most recent version and complete docs are available at:
18 # http://stein.cshl.org/WWW/software/CGI/
20 $CGI::revision = '$Id: CGI.pm,v 1.5 1998/12/06 10:19:48 lstein Exp $';
23 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
24 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
25 # $TempFile::TMPDIRECTORY = '/usr/tmp';
27 # >>>>> Here are some globals that you might want to adjust <<<<<<
28 sub initialize_globals {
29 # Set this to 1 to enable copious autoloader debugging messages
32 # Change this to the preferred DTD to print in start_html()
33 # or use default_dtd('text of DTD to use');
34 $DEFAULT_DTD = '-//IETF//DTD HTML//EN';
36 # Set this to 1 to enable NPH scripts
40 # 3) print header(-nph=>1)
43 # Set this to 1 to disable debugging from the
47 # Set this to 1 to make the temporary files created
48 # during file uploads safe from prying eyes
50 # 1) use CGI qw(:private_tempfiles)
51 # 2) $CGI::private_tempfiles(1);
52 $PRIVATE_TEMPFILES = 0;
54 # Set this to a positive value to limit the size of a POSTing
55 # to a certain number of bytes:
58 # Change this to 1 to disable uploads entirely:
61 # Change this to 1 to suppress redundant HTTP headers
64 # separate the name=value pairs by semicolons rather than ampersands
65 $USE_PARAM_SEMICOLONS = 0;
67 # Other globals that you shouldn't worry about.
73 # prevent complaints by mod_perl
77 # ------------------ START OF THE LIBRARY ------------
82 # FIGURE OUT THE OS WE'RE RUNNING UNDER
83 # Some systems support the $^O variable. If not
84 # available then require() the Config library
88 $OS = $Config::Config{'osname'};
93 } elsif ($OS=~/vms/i) {
95 } elsif ($OS=~/^MacOS$/i) {
97 } elsif ($OS=~/os2/i) {
103 # Some OS logic. Binary mode enabled on DOS, NT and VMS
104 $needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;
106 # This is the default class for the CGI object to use when all else fails.
107 $DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
109 # This is where to look for autoloaded routines.
110 $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
112 # The path separator is a slash, backslash or semicolon, depending
115 UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', MACINTOSH=>':', VMS=>'/'
118 # This no longer seems to be necessary
119 # Turn on NPH scripts by default when running under IIS server!
120 # $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
121 $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
123 # Turn on special checking for Doug MacEachern's modperl
124 if (exists $ENV{'GATEWAY_INTERFACE'}
126 ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/))
131 # Turn on special checking for ActiveState's PerlEx
132 $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
134 # Define the CRLF sequence. I can't use a simple "\r\n" because the meaning
135 # of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF
136 # and sometimes CR). The most popular VMS web server
137 # doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't
138 # use ASCII, so \015\012 means something different. I find this all
140 $EBCDIC = "\t" ne "\011";
149 if ($needs_binmode) {
150 $CGI::DefaultClass->binmode(main::STDOUT);
151 $CGI::DefaultClass->binmode(main::STDIN);
152 $CGI::DefaultClass->binmode(main::STDERR);
156 ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em
157 tt u i b blockquote pre img a address cite samp dfn html head
158 base body Link nextid title meta kbd start_html end_html
159 input Select option comment/],
160 ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
161 embed basefont style span layer ilayer font frameset frame script small big/],
162 ':netscape'=>[qw/blink fontsize center/],
163 ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
164 submit reset defaults radio_group popup_menu button autoEscape
165 scrolling_list image_button start_form end_form startform endform
166 start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
167 ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie Dump
168 raw_cookie request_method query_string Accept user_agent remote_host
169 remote_addr referer server_name server_software server_port server_protocol
170 virtual_host remote_ident auth_type http use_named_parameters
171 save_parameters restore_parameters param_fetch
172 remote_user user_name header redirect import_names put Delete Delete_all url_param/],
173 ':ssl' => [qw/https/],
174 ':imagemap' => [qw/Area Map/],
175 ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
176 ':html' => [qw/:html2 :html3 :netscape/],
177 ':standard' => [qw/:html2 :html3 :form :cgi/],
178 ':push' => [qw/multipart_init multipart_start multipart_end/],
179 ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
182 # to import symbols into caller
186 # This causes modules to clash.
190 $self->_setup_symbols(@_);
191 my ($callpack, $callfile, $callline) = caller;
193 # To allow overriding, search through the packages
194 # Till we find one in which the correct subroutine is defined.
195 my @packages = ($self,@{"$self\:\:ISA"});
196 foreach $sym (keys %EXPORT) {
198 my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
199 foreach $pck (@packages) {
200 if (defined(&{"$pck\:\:$sym"})) {
205 *{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
211 $pack->_setup_symbols('-compile',@_);
216 return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
218 return ($tag) unless $EXPORT_TAGS{$tag};
219 foreach (@{$EXPORT_TAGS{$tag}}) {
220 push(@r,&expand_tags($_));
226 # The new routine. This will check the current environment
227 # for an existing query string, and initialize itself, if so.
230 my($class,$initializer) = @_;
232 bless $self,ref $class || $class || $DefaultClass;
234 Apache->request->register_cleanup(\&CGI::_reset_globals);
237 $self->_reset_globals if $PERLEX;
238 $self->init($initializer);
242 # We provide a DESTROY method so that the autoloader
243 # doesn't bother trying to find it.
247 # Returns the value(s)of a named parameter.
248 # If invoked in a list context, returns the
249 # entire list. Otherwise returns the first
250 # member of the list.
251 # If name is not provided, return a list of all
252 # the known parameters names available.
253 # If more than one argument is provided, the
254 # second and subsequent arguments are used to
255 # set the value of the parameter.
258 my($self,@p) = self_or_default(@_);
259 return $self->all_parameters unless @p;
260 my($name,$value,@other);
262 # For compatibility between old calling style and use_named_parameters() style,
263 # we have to special case for a single parameter present.
265 ($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
268 if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
269 @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
271 foreach ($value,@other) {
272 push(@values,$_) if defined($_);
275 # If values is provided, then we set it.
277 $self->add_parameter($name);
278 $self->{$name}=[@values];
284 return unless defined($name) && $self->{$name};
285 return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
288 sub self_or_default {
289 return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI');
290 unless (defined($_[0]) &&
291 (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case
293 $Q = $CGI::DefaultClass->new unless defined($Q);
300 local $^W=0; # prevent a warning
301 if (defined($_[0]) &&
302 (substr(ref($_[0]),0,3) eq 'CGI'
303 || UNIVERSAL::isa($_[0],'CGI'))) {
306 return ($DefaultClass,@_);
310 ########################################
311 # THESE METHODS ARE MORE OR LESS PRIVATE
312 # GO TO THE __DATA__ SECTION TO SEE MORE
314 ########################################
316 # Initialize the query object from the environment.
317 # If a parameter list is found, this object will be set
318 # to an associative array in which parameter names are keys
319 # and the values are stored as lists
320 # If a keyword list is found, this method creates a bogus
321 # parameter list with the single parameter 'keywords'.
324 my($self,$initializer) = @_;
325 my($query_string,$meth,$content_length,$fh,@lines) = ('','','','');
328 # if we get called more than once, we want to initialize
329 # ourselves from the original query (which may be gone
330 # if it was read from STDIN originally.)
331 if (defined(@QUERY_PARAM) && !defined($initializer)) {
332 foreach (@QUERY_PARAM) {
333 $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
338 $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
339 $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0;
340 die "Client attempted to POST $content_length bytes, but POSTs are limited to $POST_MAX"
341 if ($POST_MAX > 0) && ($content_length > $POST_MAX);
342 $fh = to_filehandle($initializer) if $initializer;
346 # Process multipart postings, but only if the initializer is
349 && defined($ENV{'CONTENT_TYPE'})
350 && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
351 && !defined($initializer)
353 my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
354 $self->read_multipart($boundary,$content_length);
358 # If initializer is defined, then read parameters
360 if (defined($initializer)) {
361 if (UNIVERSAL::isa($initializer,'CGI')) {
362 $query_string = $initializer->query_string;
365 if (ref($initializer) && ref($initializer) eq 'HASH') {
366 foreach (keys %$initializer) {
367 $self->param('-name'=>$_,'-value'=>$initializer->{$_});
372 if (defined($fh) && ($fh ne '')) {
378 # massage back into standard format
379 if ("@lines" =~ /=/) {
380 $query_string=join("&",@lines);
382 $query_string=join("+",@lines);
387 # last chance -- treat it as a string
388 $initializer = $$initializer if ref($initializer) eq 'SCALAR';
389 $query_string = $initializer;
394 # If method is GET or HEAD, fetch the query from
396 if ($meth=~/^(GET|HEAD)$/) {
397 $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
401 if ($meth eq 'POST') {
402 $self->read_from_client(\*STDIN,\$query_string,$content_length,0)
403 if $content_length > 0;
404 # Some people want to have their cake and eat it too!
405 # Uncomment this line to have the contents of the query string
406 # APPENDED to the POST data.
407 # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
411 # If $meth is not of GET, POST or HEAD, assume we're being debugged offline.
412 # Check the command line and then the standard input for data.
413 # We use the shellwords package in order to behave the way that
414 # UN*X programmers expect.
415 $query_string = read_from_cmdline() unless $NO_DEBUG;
418 # We now have the query string in hand. We do slightly
419 # different things for keyword lists and parameter lists.
420 if ($query_string ne '') {
421 if ($query_string =~ /=/) {
422 $self->parse_params($query_string);
424 $self->add_parameter('keywords');
425 $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
429 # Special case. Erase everything if there is a field named
431 if ($self->param('.defaults')) {
435 # Associative array containing our defined fieldnames
436 $self->{'.fieldnames'} = {};
437 foreach ($self->param('.cgifields')) {
438 $self->{'.fieldnames'}->{$_}++;
441 # Clear out our default submission button flag if present
442 $self->delete('.submit');
443 $self->delete('.cgifields');
444 $self->save_request unless $initializer;
447 # FUNCTIONS TO OVERRIDE:
448 # Turn a string into a filehandle
451 return undef unless $thingy;
452 return $thingy if UNIVERSAL::isa($thingy,'GLOB');
453 return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
456 while (my $package = caller($caller++)) {
457 my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
458 return $tmp if defined(fileno($tmp));
464 # send output to the browser
466 my($self,@p) = self_or_default(@_);
470 # print to standard output (for overriding in mod_perl)
476 # unescape URL-encoded data
478 shift() if ref($_[0]);
479 my $todecode = shift;
480 return undef unless defined($todecode);
481 $todecode =~ tr/+/ /; # pluses become spaces
482 $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
488 shift() if ref($_[0]) || $_[0] eq $DefaultClass;
489 my $toencode = shift;
490 return undef unless defined($toencode);
491 $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
497 # We're going to play with the package globals now so that if we get called
498 # again, we initialize ourselves in exactly the same way. This allows
499 # us to have several of these objects.
500 @QUERY_PARAM = $self->param; # save list of parameters
501 foreach (@QUERY_PARAM) {
502 $QUERY_PARAM{$_}=$self->{$_};
507 my($self,$tosplit) = @_;
508 my(@pairs) = split(/[&;]/,$tosplit);
511 ($param,$value) = split('=',$_,2);
512 $param = unescape($param);
513 $value = unescape($value);
514 $self->add_parameter($param);
515 push (@{$self->{$param}},$value);
521 push (@{$self->{'.parameters'}},$param)
522 unless defined($self->{$param});
527 return () unless defined($self) && $self->{'.parameters'};
528 return () unless @{$self->{'.parameters'}};
529 return @{$self->{'.parameters'}};
532 # put a filehandle into binary mode (DOS)
534 CORE::binmode($_[1]);
538 my ($self,$tagname) = @_;
542 (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
544 (substr(ref(\$_[0]),0,3) eq 'CGI' ||
545 UNIVERSAL::isa(\$_[0],'CGI')));
548 if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
549 my(\@attr) = make_attributes( '',shift() );
550 \$attr = " \@attr" if \@attr;
553 if ($tagname=~/start_(\w+)/i) {
554 $func .= qq! return "<\U$1\E\$attr>";} !;
555 } elsif ($tagname=~/end_(\w+)/i) {
556 $func .= qq! return "<\U/$1\E>"; } !;
559 my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
560 return \$tag unless \@_;
561 my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
569 print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
570 my $func = &_compile;
575 # Smart rearrangement of parameters to allow named parameter
576 # calling. We do the rearangement if:
577 # 1. The first parameter begins with a -
578 # 2. The use_named_parameters() method returns true
580 my($self,$order,@param) = @_;
581 return () unless @param;
583 if (ref($param[0]) eq 'HASH') {
584 @param = %{$param[0]};
587 unless (defined($param[0]) && substr($param[0],0,1) eq '-')
588 || $self->use_named_parameters;
591 # map parameters into positional indices
595 foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
599 my (@result,%leftover);
600 $#result = $#$order; # preextend
602 my $key = uc(shift(@param));
604 if (exists $pos{$key}) {
605 $result[$pos{$key}] = shift(@param);
607 $leftover{$key} = shift(@param);
611 push (@result,$self->make_attributes(\%leftover)) if %leftover;
616 my($func) = $AUTOLOAD;
617 my($pack,$func_name);
619 local($1,$2); # this fixes an obscure variable suicide problem.
620 $func=~/(.+)::([^:]+)$/;
621 ($pack,$func_name) = ($1,$2);
622 $pack=~s/::SUPER$//; # fix another obscure problem
623 $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
624 unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
626 my($sub) = \%{"$pack\:\:SUBS"};
628 my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
629 eval "package $pack; $$auto";
631 $$auto = ''; # Free the unneeded storage (but don't undef it!!!)
633 my($code) = $sub->{$func_name};
635 $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
637 (my $base = $func_name) =~ s/^(start_|end_)//i;
638 if ($EXPORT{':any'} ||
641 (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
642 && $EXPORT_OK{$base}) {
643 $code = $CGI::DefaultClass->_make_tag_func($func_name);
646 die "Undefined subroutine $AUTOLOAD\n" unless $code;
647 eval "package $pack; $code";
653 delete($sub->{$func_name}); #free storage
654 return "$pack\:\:$func_name";
657 sub _reset_globals { initialize_globals(); }
663 $HEADERS_ONCE++, next if /^[:-]unique_headers$/;
664 $NPH++, next if /^[:-]nph$/;
665 $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/;
666 $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
667 $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
668 $EXPORT{$_}++, next if /^[:-]any$/;
669 $compile++, next if /^[:-]compile$/;
671 # This is probably extremely evil code -- to be deleted some day.
672 if (/^[-]autoload$/) {
673 my($pkg) = caller(1);
674 *{"${pkg}::AUTOLOAD"} = sub {
675 my($routine) = $AUTOLOAD;
676 $routine =~ s/^.*::/CGI::/;
682 foreach (&expand_tags($_)) {
683 tr/a-zA-Z0-9_//cd; # don't allow weird function names
687 _compile_all(keys %EXPORT) if $compile;
690 ###############################################################################
691 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
692 ###############################################################################
693 $AUTOLOADED_ROUTINES = ''; # get rid of -w warning
694 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
698 'URL_ENCODED'=> <<'END_OF_FUNC',
699 sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
702 'MULTIPART' => <<'END_OF_FUNC',
703 sub MULTIPART { 'multipart/form-data'; }
706 'SERVER_PUSH' => <<'END_OF_FUNC',
707 sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
710 'use_named_parameters' => <<'END_OF_FUNC',
711 #### Method: use_named_parameters
712 # Force CGI.pm to use named parameter-style method calls
713 # rather than positional parameters. The same effect
714 # will happen automatically if the first parameter
716 sub use_named_parameters {
717 my($self,$use_named) = self_or_default(@_);
718 return $self->{'.named'} unless defined ($use_named);
720 # stupidity to avoid annoying warnings
721 return $self->{'.named'}=$use_named;
725 'new_MultipartBuffer' => <<'END_OF_FUNC',
726 # Create a new multipart buffer
727 sub new_MultipartBuffer {
728 my($self,$boundary,$length,$filehandle) = @_;
729 return MultipartBuffer->new($self,$boundary,$length,$filehandle);
733 'read_from_client' => <<'END_OF_FUNC',
734 # Read data from a file handle
735 sub read_from_client {
736 my($self, $fh, $buff, $len, $offset) = @_;
737 local $^W=0; # prevent a warning
738 return undef unless defined($fh);
739 return read($fh, $$buff, $len, $offset);
743 'delete' => <<'END_OF_FUNC',
745 # Deletes the named parameter entirely.
748 my($self,$name) = self_or_default(@_);
749 delete $self->{$name};
750 delete $self->{'.fieldnames'}->{$name};
751 @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
752 return wantarray ? () : undef;
756 #### Method: import_names
757 # Import all parameters into the given namespace.
758 # Assumes namespace 'Q' if not specified
760 'import_names' => <<'END_OF_FUNC',
762 my($self,$namespace,$delete) = self_or_default(@_);
763 $namespace = 'Q' unless defined($namespace);
764 die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
765 if ($delete || $MOD_PERL) {
766 # can anyone find an easier way to do this?
767 foreach (keys %{"${namespace}::"}) {
768 local *symbol = "${namespace}::${_}";
774 my($param,@value,$var);
775 foreach $param ($self->param) {
776 # protect against silly names
777 ($var = $param)=~tr/a-zA-Z0-9_/_/c;
778 $var =~ s/^(?=\d)/_/;
779 local *symbol = "${namespace}::$var";
780 @value = $self->param($param);
787 #### Method: keywords
788 # Keywords acts a bit differently. Calling it in a list context
789 # returns the list of keywords.
790 # Calling it in a scalar context gives you the size of the list.
792 'keywords' => <<'END_OF_FUNC',
794 my($self,@values) = self_or_default(@_);
795 # If values is provided, then we set it.
796 $self->{'keywords'}=[@values] if defined(@values);
797 my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
802 # These are some tie() interfaces for compatibility
803 # with Steve Brenner's cgi-lib.pl routines
804 'ReadParse' => <<'END_OF_FUNC',
814 return scalar(keys %in);
818 'PrintHeader' => <<'END_OF_FUNC',
820 my($self) = self_or_default(@_);
821 return $self->header();
825 'HtmlTop' => <<'END_OF_FUNC',
827 my($self,@p) = self_or_default(@_);
828 return $self->start_html(@p);
832 'HtmlBot' => <<'END_OF_FUNC',
834 my($self,@p) = self_or_default(@_);
835 return $self->end_html(@p);
839 'SplitParam' => <<'END_OF_FUNC',
842 my (@params) = split ("\0", $param);
843 return (wantarray ? @params : $params[0]);
847 'MethGet' => <<'END_OF_FUNC',
849 return request_method() eq 'GET';
853 'MethPost' => <<'END_OF_FUNC',
855 return request_method() eq 'POST';
859 'TIEHASH' => <<'END_OF_FUNC',
861 return $Q || new CGI;
865 'STORE' => <<'END_OF_FUNC',
867 $_[0]->param($_[1],split("\0",$_[2]));
871 'FETCH' => <<'END_OF_FUNC',
873 return $_[0] if $_[1] eq 'CGI';
874 return undef unless defined $_[0]->param($_[1]);
875 return join("\0",$_[0]->param($_[1]));
879 'FIRSTKEY' => <<'END_OF_FUNC',
881 $_[0]->{'.iterator'}=0;
882 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
886 'NEXTKEY' => <<'END_OF_FUNC',
888 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
892 'EXISTS' => <<'END_OF_FUNC',
894 exists $_[0]->{$_[1]};
898 'DELETE' => <<'END_OF_FUNC',
900 $_[0]->delete($_[1]);
904 'CLEAR' => <<'END_OF_FUNC',
912 # Append a new value to an existing query
917 my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
918 my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
920 $self->add_parameter($name);
921 push(@{$self->{$name}},@values);
923 return $self->param($name);
927 #### Method: delete_all
928 # Delete all parameters
930 'delete_all' => <<'EOF',
932 my($self) = self_or_default(@_);
939 my($self,@p) = self_or_default(@_);
944 'Delete_all' => <<'EOF',
946 my($self,@p) = self_or_default(@_);
947 $self->delete_all(@p);
951 #### Method: autoescape
952 # If you want to turn off the autoescaping features,
953 # call this method with undef as the argument
954 'autoEscape' => <<'END_OF_FUNC',
956 my($self,$escape) = self_or_default(@_);
957 $self->{'dontescape'}=!$escape;
963 # Return the current version
965 'version' => <<'END_OF_FUNC',
971 'make_attributes' => <<'END_OF_FUNC',
972 sub make_attributes {
973 my($self,$attr) = @_;
974 return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
976 foreach (keys %{$attr}) {
978 $key=~s/^\-//; # get rid of initial - if present
979 $key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
980 push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/);
986 #### Method: url_param
987 # Return a parameter in the QUERY_STRING, regardless of
988 # whether this was a POST or a GET
990 'url_param' => <<'END_OF_FUNC',
992 my ($self,@p) = self_or_default(@_);
993 my $name = shift(@p);
994 return undef unless exists($ENV{QUERY_STRING});
995 unless (exists($self->{'.url_param'})) {
996 $self->{'.url_param'}={}; # empty hash
997 if ($ENV{QUERY_STRING} =~ /=/) {
998 my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING});
1001 ($param,$value) = split('=',$_,2);
1002 $param = unescape($param);
1003 $value = unescape($value);
1004 push(@{$self->{'.url_param'}->{$param}},$value);
1007 $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})];
1010 return keys %{$self->{'.url_param'}} unless defined($name);
1011 return () unless $self->{'.url_param'}->{$name};
1012 return wantarray ? @{$self->{'.url_param'}->{$name}}
1013 : $self->{'.url_param'}->{$name}->[0];
1018 # Returns a string in which all the known parameter/value
1019 # pairs are represented as nested lists, mainly for the purposes
1022 'dump' => <<'END_OF_FUNC',
1024 my($self) = self_or_default(@_);
1025 my($param,$value,@result);
1026 return '<UL></UL>' unless $self->param;
1027 push(@result,"<UL>");
1028 foreach $param ($self->param) {
1029 my($name)=$self->escapeHTML($param);
1030 push(@result,"<LI><STRONG>$param</STRONG>");
1031 push(@result,"<UL>");
1032 foreach $value ($self->param($param)) {
1033 $value = $self->escapeHTML($value);
1034 push(@result,"<LI>$value");
1036 push(@result,"</UL>");
1038 push(@result,"</UL>\n");
1039 return join("\n",@result);
1043 #### Method as_string
1045 # synonym for "dump"
1047 'as_string' => <<'END_OF_FUNC',
1054 # Write values out to a filehandle in such a way that they can
1055 # be reinitialized by the filehandle form of the new() method
1057 'save' => <<'END_OF_FUNC',
1059 my($self,$filehandle) = self_or_default(@_);
1060 $filehandle = to_filehandle($filehandle);
1062 local($,) = ''; # set print field separator back to a sane value
1063 local($\) = ''; # set output line separator to a sane value
1064 foreach $param ($self->param) {
1065 my($escaped_param) = escape($param);
1067 foreach $value ($self->param($param)) {
1068 print $filehandle "$escaped_param=",escape($value),"\n";
1071 print $filehandle "=\n"; # end of record
1076 #### Method: save_parameters
1077 # An alias for save() that is a better name for exportation.
1078 # Only intended to be used with the function (non-OO) interface.
1080 'save_parameters' => <<'END_OF_FUNC',
1081 sub save_parameters {
1083 return save(to_filehandle($fh));
1087 #### Method: restore_parameters
1088 # A way to restore CGI parameters from an initializer.
1089 # Only intended to be used with the function (non-OO) interface.
1091 'restore_parameters' => <<'END_OF_FUNC',
1092 sub restore_parameters {
1093 $Q = $CGI::DefaultClass->new(@_);
1097 #### Method: multipart_init
1098 # Return a Content-Type: style header for server-push
1099 # This has to be NPH, and it is advisable to set $| = 1
1101 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1104 'multipart_init' => <<'END_OF_FUNC',
1105 sub multipart_init {
1106 my($self,@p) = self_or_default(@_);
1107 my($boundary,@other) = $self->rearrange([BOUNDARY],@p);
1108 $boundary = $boundary || '------- =_aaaaaaaaaa0';
1109 $self->{'separator'} = "\n--$boundary\n";
1110 $type = SERVER_PUSH($boundary);
1111 return $self->header(
1114 (map { split "=", $_, 2 } @other),
1115 ) . $self->multipart_end;
1120 #### Method: multipart_start
1121 # Return a Content-Type: style header for server-push, start of section
1123 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1126 'multipart_start' => <<'END_OF_FUNC',
1127 sub multipart_start {
1128 my($self,@p) = self_or_default(@_);
1129 my($type,@other) = $self->rearrange([TYPE],@p);
1130 $type = $type || 'text/html';
1131 return $self->header(
1133 (map { split "=", $_, 2 } @other),
1139 #### Method: multipart_end
1140 # Return a Content-Type: style header for server-push, end of section
1142 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1145 'multipart_end' => <<'END_OF_FUNC',
1147 my($self,@p) = self_or_default(@_);
1148 return $self->{'separator'};
1154 # Return a Content-Type: style header
1157 'header' => <<'END_OF_FUNC',
1159 my($self,@p) = self_or_default(@_);
1162 return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
1164 my($type,$status,$cookie,$target,$expires,$nph,@other) =
1165 $self->rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
1166 STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
1169 # rearrange() was designed for the HTML portion, so we
1170 # need to fix it up a little.
1172 next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
1173 ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
1176 $type ||= 'text/html' unless defined($type);
1178 # Maybe future compatibility. Maybe not.
1179 my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
1180 push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
1182 push(@header,"Status: $status") if $status;
1183 push(@header,"Window-Target: $target") if $target;
1184 # push all the cookies -- there may be several
1186 my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
1188 my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
1189 push(@header,"Set-Cookie: $cs") if $cs ne '';
1192 # if the user indicates an expiration time, then we need
1193 # both an Expires and a Date header (so that the browser is
1195 push(@header,"Expires: " . expires($expires,'http'))
1197 push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
1198 push(@header,"Pragma: no-cache") if $self->cache();
1199 push(@header,@other);
1200 push(@header,"Content-Type: $type") if $type ne '';
1202 my $header = join($CRLF,@header)."${CRLF}${CRLF}";
1203 if ($MOD_PERL and not $nph) {
1204 my $r = Apache->request;
1205 $r->send_cgi_header($header);
1214 # Control whether header() will produce the no-cache
1217 'cache' => <<'END_OF_FUNC',
1219 my($self,$new_value) = self_or_default(@_);
1220 $new_value = '' unless $new_value;
1221 if ($new_value ne '') {
1222 $self->{'cache'} = $new_value;
1224 return $self->{'cache'};
1229 #### Method: redirect
1230 # Return a Location: style header
1233 'redirect' => <<'END_OF_FUNC',
1235 my($self,@p) = self_or_default(@_);
1236 my($url,$target,$cookie,$nph,@other) = $self->rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
1237 $url = $url || $self->self_url;
1239 foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
1241 '-Status'=>'302 Moved',
1244 unshift(@o,'-Target'=>$target) if $target;
1245 unshift(@o,'-Cookie'=>$cookie) if $cookie;
1246 unshift(@o,'-Type'=>'');
1247 return $self->header(@o);
1252 #### Method: start_html
1253 # Canned HTML header
1256 # $title -> (optional) The title for this HTML document (-title)
1257 # $author -> (optional) e-mail address of the author (-author)
1258 # $base -> (optional) if set to true, will enter the BASE address of this document
1259 # for resolving relative references (-base)
1260 # $xbase -> (optional) alternative base at some remote location (-xbase)
1261 # $target -> (optional) target window to load all links into (-target)
1262 # $script -> (option) Javascript code (-script)
1263 # $no_script -> (option) Javascript <noscript> tag (-noscript)
1264 # $meta -> (optional) Meta information tags
1265 # $head -> (optional) any other elements you'd like to incorporate into the <HEAD> tag
1266 # (a scalar or array ref)
1267 # $style -> (optional) reference to an external style sheet
1268 # @other -> (optional) any other named parameters you'd like to incorporate into
1271 'start_html' => <<'END_OF_FUNC',
1273 my($self,@p) = &self_or_default(@_);
1274 my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,@other) =
1275 $self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
1277 # strangely enough, the title needs to be escaped as HTML
1278 # while the author needs to be escaped as a URL
1279 $title = $self->escapeHTML($title || 'Untitled Document');
1280 $author = $self->escape($author);
1282 $dtd = $DEFAULT_DTD unless $dtd && $dtd =~ m|^-//|;
1283 push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">)) if $dtd;
1284 push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
1285 push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if defined $author;
1287 if ($base || $xbase || $target) {
1288 my $href = $xbase || $self->url('-path'=>1);
1289 my $t = $target ? qq/ TARGET="$target"/ : '';
1290 push(@result,qq/<BASE HREF="$href"$t>/);
1293 if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
1294 foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
1297 push(@result,ref($head) ? @$head : $head) if $head;
1299 # handle the infrequently-used -style and -script parameters
1300 push(@result,$self->_style($style)) if defined $style;
1301 push(@result,$self->_script($script)) if defined $script;
1303 # handle -noscript parameter
1304 push(@result,<<END) if $noscript;
1310 my($other) = @other ? " @other" : '';
1311 push(@result,"</HEAD><BODY$other>");
1312 return join("\n",@result);
1317 # internal method for generating a CSS style section
1319 '_style' => <<'END_OF_FUNC',
1321 my ($self,$style) = @_;
1323 my $type = 'text/css';
1325 my($src,$code,$stype,@other) =
1326 $self->rearrange([SRC,CODE,TYPE],
1327 '-foo'=>'bar', # a trick to allow the '-' to be omitted
1328 ref($style) eq 'ARRAY' ? @$style : %$style);
1329 $type = $stype if $stype;
1330 push(@result,qq/<LINK REL="stylesheet" HREF="$src">/) if $src;
1331 push(@result,style({'type'=>$type},"<!--\n$code\n-->")) if $code;
1333 push(@result,style({'type'=>$type},"<!--\n$style\n-->"));
1340 '_script' => <<'END_OF_FUNC',
1342 my ($self,$script) = @_;
1344 my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
1345 foreach $script (@scripts) {
1346 my($src,$code,$language);
1347 if (ref($script)) { # script is a hash
1348 ($src,$code,$language) =
1349 $self->rearrange([SRC,CODE,LANGUAGE],
1350 '-foo'=>'bar', # a trick to allow the '-' to be omitted
1351 ref($style) eq 'ARRAY' ? @$script : %$script);
1354 ($src,$code,$language) = ('',$script,'JavaScript');
1357 push(@satts,'src'=>$src) if $src;
1358 push(@satts,'language'=>$language || 'JavaScript');
1359 $code = "<!-- Hide script\n$code\n// End script hiding -->"
1360 if $code && $language=~/javascript/i;
1361 $code = "<!-- Hide script\n$code\n\# End script hiding -->"
1362 if $code && $language=~/perl/i;
1363 push(@result,script({@satts},$code));
1369 #### Method: end_html
1370 # End an HTML document.
1371 # Trivial method for completeness. Just returns "</BODY>"
1373 'end_html' => <<'END_OF_FUNC',
1375 return "</BODY></HTML>";
1380 ################################
1381 # METHODS USED IN BUILDING FORMS
1382 ################################
1384 #### Method: isindex
1385 # Just prints out the isindex tag.
1387 # $action -> optional URL of script to run
1389 # A string containing a <ISINDEX> tag
1390 'isindex' => <<'END_OF_FUNC',
1392 my($self,@p) = self_or_default(@_);
1393 my($action,@other) = $self->rearrange([ACTION],@p);
1394 $action = qq/ACTION="$action"/ if $action;
1395 my($other) = @other ? " @other" : '';
1396 return "<ISINDEX $action$other>";
1401 #### Method: startform
1404 # $method -> optional submission method to use (GET or POST)
1405 # $action -> optional URL of script to run
1406 # $enctype ->encoding to use (URL_ENCODED or MULTIPART)
1407 'startform' => <<'END_OF_FUNC',
1409 my($self,@p) = self_or_default(@_);
1411 my($method,$action,$enctype,@other) =
1412 $self->rearrange([METHOD,ACTION,ENCTYPE],@p);
1414 $method = $method || 'POST';
1415 $enctype = $enctype || &URL_ENCODED;
1416 $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
1417 'ACTION="'.$self->script_name.'"' : '';
1418 my($other) = @other ? " @other" : '';
1419 $self->{'.parametersToAdd'}={};
1420 return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
1425 #### Method: start_form
1426 # synonym for startform
1427 'start_form' => <<'END_OF_FUNC',
1433 'end_multipart_form' => <<'END_OF_FUNC',
1434 sub end_multipart_form {
1439 #### Method: start_multipart_form
1440 # synonym for startform
1441 'start_multipart_form' => <<'END_OF_FUNC',
1442 sub start_multipart_form {
1443 my($self,@p) = self_or_default(@_);
1444 if ($self->use_named_parameters ||
1445 (defined($param[0]) && substr($param[0],0,1) eq '-')) {
1447 $p{'-enctype'}=&MULTIPART;
1448 return $self->startform(%p);
1450 my($method,$action,@other) =
1451 $self->rearrange([METHOD,ACTION],@p);
1452 return $self->startform($method,$action,&MULTIPART,@other);
1458 #### Method: endform
1460 'endform' => <<'END_OF_FUNC',
1462 my($self,@p) = self_or_default(@_);
1463 return ($self->get_fields,"</FORM>");
1468 #### Method: end_form
1469 # synonym for endform
1470 'end_form' => <<'END_OF_FUNC',
1477 '_textfield' => <<'END_OF_FUNC',
1479 my($self,$tag,@p) = self_or_default(@_);
1480 my($name,$default,$size,$maxlength,$override,@other) =
1481 $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
1483 my $current = $override ? $default :
1484 (defined($self->param($name)) ? $self->param($name) : $default);
1486 $current = defined($current) ? $self->escapeHTML($current) : '';
1487 $name = defined($name) ? $self->escapeHTML($name) : '';
1488 my($s) = defined($size) ? qq/ SIZE=$size/ : '';
1489 my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
1490 my($other) = @other ? " @other" : '';
1491 # this entered at cristy's request to fix problems with file upload fields
1492 # and WebTV -- not sure it won't break stuff
1493 my($value) = $current ne '' ? qq(VALUE="$current") : '';
1494 return qq/<INPUT TYPE="$tag" NAME="$name" $value$s$m$other>/;
1498 #### Method: textfield
1500 # $name -> Name of the text field
1501 # $default -> Optional default value of the field if not
1503 # $size -> Optional width of field in characaters.
1504 # $maxlength -> Optional maximum number of characters.
1506 # A string containing a <INPUT TYPE="text"> field
1508 'textfield' => <<'END_OF_FUNC',
1510 my($self,@p) = self_or_default(@_);
1511 $self->_textfield('text',@p);
1516 #### Method: filefield
1518 # $name -> Name of the file upload field
1519 # $size -> Optional width of field in characaters.
1520 # $maxlength -> Optional maximum number of characters.
1522 # A string containing a <INPUT TYPE="text"> field
1524 'filefield' => <<'END_OF_FUNC',
1526 my($self,@p) = self_or_default(@_);
1527 $self->_textfield('file',@p);
1532 #### Method: password
1533 # Create a "secret password" entry field
1535 # $name -> Name of the field
1536 # $default -> Optional default value of the field if not
1538 # $size -> Optional width of field in characters.
1539 # $maxlength -> Optional maximum characters that can be entered.
1541 # A string containing a <INPUT TYPE="password"> field
1543 'password_field' => <<'END_OF_FUNC',
1544 sub password_field {
1545 my ($self,@p) = self_or_default(@_);
1546 $self->_textfield('password',@p);
1550 #### Method: textarea
1552 # $name -> Name of the text field
1553 # $default -> Optional default value of the field if not
1555 # $rows -> Optional number of rows in text area
1556 # $columns -> Optional number of columns in text area
1558 # A string containing a <TEXTAREA></TEXTAREA> tag
1560 'textarea' => <<'END_OF_FUNC',
1562 my($self,@p) = self_or_default(@_);
1564 my($name,$default,$rows,$cols,$override,@other) =
1565 $self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
1567 my($current)= $override ? $default :
1568 (defined($self->param($name)) ? $self->param($name) : $default);
1570 $name = defined($name) ? $self->escapeHTML($name) : '';
1571 $current = defined($current) ? $self->escapeHTML($current) : '';
1572 my($r) = $rows ? " ROWS=$rows" : '';
1573 my($c) = $cols ? " COLS=$cols" : '';
1574 my($other) = @other ? " @other" : '';
1575 return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
1581 # Create a javascript button.
1583 # $name -> (optional) Name for the button. (-name)
1584 # $value -> (optional) Value of the button when selected (and visible name) (-value)
1585 # $onclick -> (optional) Text of the JavaScript to run when the button is
1588 # A string containing a <INPUT TYPE="button"> tag
1590 'button' => <<'END_OF_FUNC',
1592 my($self,@p) = self_or_default(@_);
1594 my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
1595 [ONCLICK,SCRIPT]],@p);
1597 $label=$self->escapeHTML($label);
1598 $value=$self->escapeHTML($value);
1599 $script=$self->escapeHTML($script);
1602 $name = qq/ NAME="$label"/ if $label;
1603 $value = $value || $label;
1605 $val = qq/ VALUE="$value"/ if $value;
1606 $script = qq/ ONCLICK="$script"/ if $script;
1607 my($other) = @other ? " @other" : '';
1608 return qq/<INPUT TYPE="button"$name$val$script$other>/;
1614 # Create a "submit query" button.
1616 # $name -> (optional) Name for the button.
1617 # $value -> (optional) Value of the button when selected (also doubles as label).
1618 # $label -> (optional) Label printed on the button(also doubles as the value).
1620 # A string containing a <INPUT TYPE="submit"> tag
1622 'submit' => <<'END_OF_FUNC',
1624 my($self,@p) = self_or_default(@_);
1626 my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
1628 $label=$self->escapeHTML($label);
1629 $value=$self->escapeHTML($value);
1631 my($name) = ' NAME=".submit"';
1632 $name = qq/ NAME="$label"/ if defined($label);
1633 $value = defined($value) ? $value : $label;
1635 $val = qq/ VALUE="$value"/ if defined($value);
1636 my($other) = @other ? " @other" : '';
1637 return qq/<INPUT TYPE="submit"$name$val$other>/;
1643 # Create a "reset" button.
1645 # $name -> (optional) Name for the button.
1647 # A string containing a <INPUT TYPE="reset"> tag
1649 'reset' => <<'END_OF_FUNC',
1651 my($self,@p) = self_or_default(@_);
1652 my($label,@other) = $self->rearrange([NAME],@p);
1653 $label=$self->escapeHTML($label);
1654 my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
1655 my($other) = @other ? " @other" : '';
1656 return qq/<INPUT TYPE="reset"$value$other>/;
1661 #### Method: defaults
1662 # Create a "defaults" button.
1664 # $name -> (optional) Name for the button.
1666 # A string containing a <INPUT TYPE="submit" NAME=".defaults"> tag
1668 # Note: this button has a special meaning to the initialization script,
1669 # and tells it to ERASE the current query string so that your defaults
1672 'defaults' => <<'END_OF_FUNC',
1674 my($self,@p) = self_or_default(@_);
1676 my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
1678 $label=$self->escapeHTML($label);
1679 $label = $label || "Defaults";
1680 my($value) = qq/ VALUE="$label"/;
1681 my($other) = @other ? " @other" : '';
1682 return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
1687 #### Method: comment
1688 # Create an HTML <!-- comment -->
1689 # Parameters: a string
1690 'comment' => <<'END_OF_FUNC',
1692 my($self,@p) = self_or_CGI(@_);
1693 return "<!-- @p -->";
1697 #### Method: checkbox
1698 # Create a checkbox that is not logically linked to any others.
1699 # The field value is "on" when the button is checked.
1701 # $name -> Name of the checkbox
1702 # $checked -> (optional) turned on by default if true
1703 # $value -> (optional) value of the checkbox, 'on' by default
1704 # $label -> (optional) a user-readable label printed next to the box.
1705 # Otherwise the checkbox name is used.
1707 # A string containing a <INPUT TYPE="checkbox"> field
1709 'checkbox' => <<'END_OF_FUNC',
1711 my($self,@p) = self_or_default(@_);
1713 my($name,$checked,$value,$label,$override,@other) =
1714 $self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
1716 $value = defined $value ? $value : 'on';
1718 if (!$override && ($self->{'.fieldnames'}->{$name} ||
1719 defined $self->param($name))) {
1720 $checked = grep($_ eq $value,$self->param($name)) ? ' CHECKED' : '';
1722 $checked = $checked ? ' CHECKED' : '';
1724 my($the_label) = defined $label ? $label : $name;
1725 $name = $self->escapeHTML($name);
1726 $value = $self->escapeHTML($value);
1727 $the_label = $self->escapeHTML($the_label);
1728 my($other) = @other ? " @other" : '';
1729 $self->register_parameter($name);
1731 <INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label
1737 #### Method: checkbox_group
1738 # Create a list of logically-linked checkboxes.
1740 # $name -> Common name for all the check boxes
1741 # $values -> A pointer to a regular array containing the
1742 # values for each checkbox in the group.
1743 # $defaults -> (optional)
1744 # 1. If a pointer to a regular array of checkbox values,
1745 # then this will be used to decide which
1746 # checkboxes to turn on by default.
1747 # 2. If a scalar, will be assumed to hold the
1748 # value of a single checkbox in the group to turn on.
1749 # $linebreak -> (optional) Set to true to place linebreaks
1750 # between the buttons.
1751 # $labels -> (optional)
1752 # A pointer to an associative array of labels to print next to each checkbox
1753 # in the form $label{'value'}="Long explanatory label".
1754 # Otherwise the provided values are used as the labels.
1756 # An ARRAY containing a series of <INPUT TYPE="checkbox"> fields
1758 'checkbox_group' => <<'END_OF_FUNC',
1759 sub checkbox_group {
1760 my($self,@p) = self_or_default(@_);
1762 my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
1763 $rowheaders,$colheaders,$override,$nolabels,@other) =
1764 $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
1765 LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
1766 ROWHEADERS,COLHEADERS,
1767 [OVERRIDE,FORCE],NOLABELS],@p);
1769 my($checked,$break,$result,$label);
1771 my(%checked) = $self->previous_or_default($name,$defaults,$override);
1773 $break = $linebreak ? "<BR>" : '';
1774 $name=$self->escapeHTML($name);
1776 # Create the elements
1777 my(@elements,@values);
1779 @values = $self->_set_values_and_labels($values,\$labels,$name);
1781 my($other) = @other ? " @other" : '';
1783 $checked = $checked{$_} ? ' CHECKED' : '';
1785 unless (defined($nolabels) && $nolabels) {
1787 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1788 $label = $self->escapeHTML($label);
1790 $_ = $self->escapeHTML($_);
1791 push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label}${break}/);
1793 $self->register_parameter($name);
1794 return wantarray ? @elements : join(' ',@elements)
1795 unless defined($columns) || defined($rows);
1796 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1800 # Escape HTML -- used internally
1801 'escapeHTML' => <<'END_OF_FUNC',
1803 my($self,$toencode) = @_;
1804 $toencode = $self unless ref($self);
1805 return undef unless defined($toencode);
1806 return $toencode if ref($self) && $self->{'dontescape'};
1808 $toencode=~s/&/&/g;
1809 $toencode=~s/\"/"/g;
1810 $toencode=~s/>/>/g;
1811 $toencode=~s/</</g;
1816 # unescape HTML -- used internally
1817 'unescapeHTML' => <<'END_OF_FUNC',
1819 my $string = ref($_[0]) ? $_[1] : $_[0];
1820 return undef unless defined($string);
1821 # thanks to Randal Schwartz for the correct solution to this one
1822 $string=~ s[&(.*?);]{
1828 /^#(\d+)$/ ? chr($1) :
1829 /^#x([0-9a-f]+)$/i ? chr(hex($1)) :
1836 # Internal procedure - don't use
1837 '_tableize' => <<'END_OF_FUNC',
1839 my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
1842 if (defined($columns)) {
1843 $rows = int(0.99 + @elements/$columns) unless defined($rows);
1845 if (defined($rows)) {
1846 $columns = int(0.99 + @elements/$rows) unless defined($columns);
1849 # rearrange into a pretty table
1850 $result = "<TABLE>";
1852 unshift(@$colheaders,'') if defined(@$colheaders) && defined(@$rowheaders);
1853 $result .= "<TR>" if defined(@{$colheaders});
1854 foreach (@{$colheaders}) {
1855 $result .= "<TH>$_</TH>";
1857 for ($row=0;$row<$rows;$row++) {
1859 $result .= "<TH>$rowheaders->[$row]</TH>" if defined(@$rowheaders);
1860 for ($column=0;$column<$columns;$column++) {
1861 $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"
1862 if defined($elements[$column*$rows + $row]);
1866 $result .= "</TABLE>";
1872 #### Method: radio_group
1873 # Create a list of logically-linked radio buttons.
1875 # $name -> Common name for all the buttons.
1876 # $values -> A pointer to a regular array containing the
1877 # values for each button in the group.
1878 # $default -> (optional) Value of the button to turn on by default. Pass '-'
1879 # to turn _nothing_ on.
1880 # $linebreak -> (optional) Set to true to place linebreaks
1881 # between the buttons.
1882 # $labels -> (optional)
1883 # A pointer to an associative array of labels to print next to each checkbox
1884 # in the form $label{'value'}="Long explanatory label".
1885 # Otherwise the provided values are used as the labels.
1887 # An ARRAY containing a series of <INPUT TYPE="radio"> fields
1889 'radio_group' => <<'END_OF_FUNC',
1891 my($self,@p) = self_or_default(@_);
1893 my($name,$values,$default,$linebreak,$labels,
1894 $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
1895 $self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
1896 ROWS,[COLUMNS,COLS],
1897 ROWHEADERS,COLHEADERS,
1898 [OVERRIDE,FORCE],NOLABELS],@p);
1899 my($result,$checked);
1901 if (!$override && defined($self->param($name))) {
1902 $checked = $self->param($name);
1904 $checked = $default;
1906 my(@elements,@values);
1907 @values = $self->_set_values_and_labels($values,\$labels,$name);
1909 # If no check array is specified, check the first by default
1910 $checked = $values[0] unless defined($checked) && $checked ne '';
1911 $name=$self->escapeHTML($name);
1913 my($other) = @other ? " @other" : '';
1915 my($checkit) = $checked eq $_ ? ' CHECKED' : '';
1916 my($break) = $linebreak ? '<BR>' : '';
1918 unless (defined($nolabels) && $nolabels) {
1920 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1921 $label = $self->escapeHTML($label);
1923 $_=$self->escapeHTML($_);
1924 push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label}${break}/);
1926 $self->register_parameter($name);
1927 return wantarray ? @elements : join(' ',@elements)
1928 unless defined($columns) || defined($rows);
1929 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1934 #### Method: popup_menu
1935 # Create a popup menu.
1937 # $name -> Name for all the menu
1938 # $values -> A pointer to a regular array containing the
1939 # text of each menu item.
1940 # $default -> (optional) Default item to display
1941 # $labels -> (optional)
1942 # A pointer to an associative array of labels to print next to each checkbox
1943 # in the form $label{'value'}="Long explanatory label".
1944 # Otherwise the provided values are used as the labels.
1946 # A string containing the definition of a popup menu.
1948 'popup_menu' => <<'END_OF_FUNC',
1950 my($self,@p) = self_or_default(@_);
1952 my($name,$values,$default,$labels,$override,@other) =
1953 $self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
1954 my($result,$selected);
1956 if (!$override && defined($self->param($name))) {
1957 $selected = $self->param($name);
1959 $selected = $default;
1961 $name=$self->escapeHTML($name);
1962 my($other) = @other ? " @other" : '';
1965 @values = $self->_set_values_and_labels($values,\$labels,$name);
1967 $result = qq/<SELECT NAME="$name"$other>\n/;
1969 my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
1971 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1972 my($value) = $self->escapeHTML($_);
1973 $label=$self->escapeHTML($label);
1974 $result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
1977 $result .= "</SELECT>\n";
1983 #### Method: scrolling_list
1984 # Create a scrolling list.
1986 # $name -> name for the list
1987 # $values -> A pointer to a regular array containing the
1988 # values for each option line in the list.
1989 # $defaults -> (optional)
1990 # 1. If a pointer to a regular array of options,
1991 # then this will be used to decide which
1992 # lines to turn on by default.
1993 # 2. Otherwise holds the value of the single line to turn on.
1994 # $size -> (optional) Size of the list.
1995 # $multiple -> (optional) If set, allow multiple selections.
1996 # $labels -> (optional)
1997 # A pointer to an associative array of labels to print next to each checkbox
1998 # in the form $label{'value'}="Long explanatory label".
1999 # Otherwise the provided values are used as the labels.
2001 # A string containing the definition of a scrolling list.
2003 'scrolling_list' => <<'END_OF_FUNC',
2004 sub scrolling_list {
2005 my($self,@p) = self_or_default(@_);
2006 my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
2007 = $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
2008 SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
2010 my($result,@values);
2011 @values = $self->_set_values_and_labels($values,\$labels,$name);
2013 $size = $size || scalar(@values);
2015 my(%selected) = $self->previous_or_default($name,$defaults,$override);
2016 my($is_multiple) = $multiple ? ' MULTIPLE' : '';
2017 my($has_size) = $size ? " SIZE=$size" : '';
2018 my($other) = @other ? " @other" : '';
2020 $name=$self->escapeHTML($name);
2021 $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
2023 my($selectit) = $selected{$_} ? 'SELECTED' : '';
2025 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
2026 $label=$self->escapeHTML($label);
2027 my($value)=$self->escapeHTML($_);
2028 $result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
2030 $result .= "</SELECT>\n";
2031 $self->register_parameter($name);
2039 # $name -> Name of the hidden field
2040 # @default -> (optional) Initial values of field (may be an array)
2042 # $default->[initial values of field]
2044 # A string containing a <INPUT TYPE="hidden" NAME="name" VALUE="value">
2046 'hidden' => <<'END_OF_FUNC',
2048 my($self,@p) = self_or_default(@_);
2050 # this is the one place where we departed from our standard
2051 # calling scheme, so we have to special-case (darn)
2053 my($name,$default,$override,@other) =
2054 $self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
2056 my $do_override = 0;
2057 if ( ref($p[0]) || substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
2058 @value = ref($default) ? @{$default} : $default;
2059 $do_override = $override;
2061 foreach ($default,$override,@other) {
2062 push(@value,$_) if defined($_);
2066 # use previous values if override is not set
2067 my @prev = $self->param($name);
2068 @value = @prev if !$do_override && @prev;
2070 $name=$self->escapeHTML($name);
2072 $_=$self->escapeHTML($_);
2073 push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
2075 return wantarray ? @result : join('',@result);
2080 #### Method: image_button
2082 # $name -> Name of the button
2083 # $src -> URL of the image source
2084 # $align -> Alignment style (TOP, BOTTOM or MIDDLE)
2086 # A string containing a <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment">
2088 'image_button' => <<'END_OF_FUNC',
2090 my($self,@p) = self_or_default(@_);
2092 my($name,$src,$alignment,@other) =
2093 $self->rearrange([NAME,SRC,ALIGN],@p);
2095 my($align) = $alignment ? " ALIGN=\U$alignment" : '';
2096 my($other) = @other ? " @other" : '';
2097 $name=$self->escapeHTML($name);
2098 return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
2103 #### Method: self_url
2104 # Returns a URL containing the current script and all its
2105 # param/value pairs arranged as a query. You can use this
2106 # to create a link that, when selected, will reinvoke the
2107 # script with all its state information preserved.
2109 'self_url' => <<'END_OF_FUNC',
2111 my($self,@p) = self_or_default(@_);
2112 return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p);
2117 # This is provided as a synonym to self_url() for people unfortunate
2118 # enough to have incorporated it into their programs already!
2119 'state' => <<'END_OF_FUNC',
2127 # Like self_url, but doesn't return the query string part of
2130 'url' => <<'END_OF_FUNC',
2132 my($self,@p) = self_or_default(@_);
2133 my ($relative,$absolute,$full,$path_info,$query) =
2134 $self->rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
2136 $full++ if !($relative || $absolute);
2139 my $protocol = $self->protocol();
2140 $url = "$protocol://";
2141 my $vh = http('host');
2145 $url .= server_name();
2146 my $port = $self->server_port;
2148 unless (lc($protocol) eq 'http' && $port == 80)
2149 || (lc($protocol) eq 'https' && $port == 443);
2151 $url .= $self->script_name;
2152 } elsif ($relative) {
2153 ($url) = $self->script_name =~ m!([^/]+)$!;
2154 } elsif ($absolute) {
2155 $url = $self->script_name;
2157 $url .= $self->path_info if $path_info and $self->path_info;
2158 $url .= "?" . $self->query_string if $query and $self->query_string;
2165 # Set or read a cookie from the specified name.
2166 # Cookie can then be passed to header().
2167 # Usual rules apply to the stickiness of -value.
2169 # -name -> name for this cookie (optional)
2170 # -value -> value of this cookie (scalar, array or hash)
2171 # -path -> paths for which this cookie is valid (optional)
2172 # -domain -> internet domain in which this cookie is valid (optional)
2173 # -secure -> if true, cookie only passed through secure channel (optional)
2174 # -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional)
2176 'cookie' => <<'END_OF_FUNC',
2178 my($self,@p) = self_or_default(@_);
2179 my($name,$value,$path,$domain,$secure,$expires) =
2180 $self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
2182 require CGI::Cookie;
2184 # if no value is supplied, then we retrieve the
2185 # value of the cookie, if any. For efficiency, we cache the parsed
2186 # cookies in our state variables.
2187 unless ( defined($value) ) {
2188 $self->{'.cookies'} = CGI::Cookie->fetch
2189 unless $self->{'.cookies'};
2191 # If no name is supplied, then retrieve the names of all our cookies.
2192 return () unless $self->{'.cookies'};
2193 return keys %{$self->{'.cookies'}} unless $name;
2194 return () unless $self->{'.cookies'}->{$name};
2195 return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne '';
2198 # If we get here, we're creating a new cookie
2199 return undef unless $name; # this is an error
2202 push(@param,'-name'=>$name);
2203 push(@param,'-value'=>$value);
2204 push(@param,'-domain'=>$domain) if $domain;
2205 push(@param,'-path'=>$path) if $path;
2206 push(@param,'-expires'=>$expires) if $expires;
2207 push(@param,'-secure'=>$secure) if $secure;
2209 return new CGI::Cookie(@param);
2213 # This internal routine creates an expires time exactly some number of
2214 # hours from the current time. It incorporates modifications from
2216 'expire_calc' => <<'END_OF_FUNC',
2219 my(%mult) = ('s'=>1,
2225 # format for time can be in any of the forms...
2226 # "now" -- expire immediately
2227 # "+180s" -- in 180 seconds
2228 # "+2m" -- in 2 minutes
2229 # "+12h" -- in 12 hours
2231 # "+3M" -- in 3 months
2232 # "+2y" -- in 2 years
2233 # "-3m" -- 3 minutes ago(!)
2234 # If you don't supply one of these forms, we assume you are
2235 # specifying the date yourself
2237 if (!$time || (lc($time) eq 'now')) {
2239 } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
2240 $offset = ($mult{$2} || 1)*$1;
2244 return (time+$offset);
2248 # This internal routine creates date strings suitable for use in
2249 # cookies and HTTP headers. (They differ, unfortunately.)
2250 # Thanks to Fisher Mark for this.
2251 'expires' => <<'END_OF_FUNC',
2253 my($time,$format) = @_;
2256 my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
2257 my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
2259 # pass through preformatted dates for the sake of expire_calc()
2260 $time = expire_calc($time);
2261 return $time unless $time =~ /^\d+$/;
2263 # make HTTP/cookie date string from GMT'ed time
2264 # (cookies use '-' as date separator, HTTP uses ' ')
2266 $sc = '-' if $format eq "cookie";
2267 my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
2269 return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
2270 $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
2274 'parse_keywordlist' => <<'END_OF_FUNC',
2275 sub parse_keywordlist {
2276 my($self,$tosplit) = @_;
2277 $tosplit = unescape($tosplit); # unescape the keywords
2278 $tosplit=~tr/+/ /; # pluses to spaces
2279 my(@keywords) = split(/\s+/,$tosplit);
2284 'param_fetch' => <<'END_OF_FUNC',
2286 my($self,@p) = self_or_default(@_);
2287 my($name) = $self->rearrange([NAME],@p);
2288 unless (exists($self->{$name})) {
2289 $self->add_parameter($name);
2290 $self->{$name} = [];
2293 return $self->{$name};
2297 ###############################################
2298 # OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
2299 ###############################################
2301 #### Method: path_info
2302 # Return the extra virtual path information provided
2303 # after the URL (if any)
2305 'path_info' => <<'END_OF_FUNC',
2307 my ($self,$info) = self_or_default(@_);
2308 if (defined($info)) {
2309 $info = "/$info" if $info ne '' && substr($info,0,1) ne '/';
2310 $self->{'.path_info'} = $info;
2311 } elsif (! defined($self->{'.path_info'}) ) {
2312 $self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ?
2313 $ENV{'PATH_INFO'} : '';
2315 # hack to fix broken path info in IIS
2316 $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
2319 return $self->{'.path_info'};
2324 #### Method: request_method
2325 # Returns 'POST', 'GET', 'PUT' or 'HEAD'
2327 'request_method' => <<'END_OF_FUNC',
2328 sub request_method {
2329 return $ENV{'REQUEST_METHOD'};
2333 #### Method: path_translated
2334 # Return the physical path information provided
2335 # by the URL (if any)
2337 'path_translated' => <<'END_OF_FUNC',
2338 sub path_translated {
2339 return $ENV{'PATH_TRANSLATED'};
2344 #### Method: query_string
2345 # Synthesize a query string from our current
2348 'query_string' => <<'END_OF_FUNC',
2350 my($self) = self_or_default(@_);
2351 my($param,$value,@pairs);
2352 foreach $param ($self->param) {
2353 my($eparam) = escape($param);
2354 foreach $value ($self->param($param)) {
2355 $value = escape($value);
2356 push(@pairs,"$eparam=$value");
2359 return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs);
2365 # Without parameters, returns an array of the
2366 # MIME types the browser accepts.
2367 # With a single parameter equal to a MIME
2368 # type, will return undef if the browser won't
2369 # accept it, 1 if the browser accepts it but
2370 # doesn't give a preference, or a floating point
2371 # value between 0.0 and 1.0 if the browser
2372 # declares a quantitative score for it.
2373 # This handles MIME type globs correctly.
2375 'Accept' => <<'END_OF_FUNC',
2377 my($self,$search) = self_or_CGI(@_);
2378 my(%prefs,$type,$pref,$pat);
2380 my(@accept) = split(',',$self->http('accept'));
2383 ($pref) = /q=(\d\.\d+|\d+)/;
2384 ($type) = m#(\S+/[^;]+)#;
2386 $prefs{$type}=$pref || 1;
2389 return keys %prefs unless $search;
2391 # if a search type is provided, we may need to
2392 # perform a pattern matching operation.
2393 # The MIME types use a glob mechanism, which
2394 # is easily translated into a perl pattern match
2396 # First return the preference for directly supported
2398 return $prefs{$search} if $prefs{$search};
2400 # Didn't get it, so try pattern matching.
2401 foreach (keys %prefs) {
2402 next unless /\*/; # not a pattern match
2403 ($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
2404 $pat =~ s/\*/.*/g; # turn it into a pattern
2405 return $prefs{$_} if $search=~/$pat/;
2411 #### Method: user_agent
2412 # If called with no parameters, returns the user agent.
2413 # If called with one parameter, does a pattern match (case
2414 # insensitive) on the user agent.
2416 'user_agent' => <<'END_OF_FUNC',
2418 my($self,$match)=self_or_CGI(@_);
2419 return $self->http('user_agent') unless $match;
2420 return $self->http('user_agent') =~ /$match/i;
2425 #### Method: raw_cookie
2426 # Returns the magic cookies for the session.
2427 # The cookies are not parsed or altered in any way, i.e.
2428 # cookies are returned exactly as given in the HTTP
2429 # headers. If a cookie name is given, only that cookie's
2430 # value is returned, otherwise the entire raw cookie
2433 'raw_cookie' => <<'END_OF_FUNC',
2435 my($self,$key) = self_or_CGI(@_);
2437 require CGI::Cookie;
2439 if (defined($key)) {
2440 $self->{'.raw_cookies'} = CGI::Cookie->raw_fetch
2441 unless $self->{'.raw_cookies'};
2443 return () unless $self->{'.raw_cookies'};
2444 return () unless $self->{'.raw_cookies'}->{$key};
2445 return $self->{'.raw_cookies'}->{$key};
2447 return $self->http('cookie') || $ENV{'COOKIE'} || '';
2451 #### Method: virtual_host
2452 # Return the name of the virtual_host, which
2453 # is not always the same as the server
2455 'virtual_host' => <<'END_OF_FUNC',
2457 my $vh = http('host') || server_name();
2458 $vh =~ s/:\d+$//; # get rid of port number
2463 #### Method: remote_host
2464 # Return the name of the remote host, or its IP
2465 # address if unavailable. If this variable isn't
2466 # defined, it returns "localhost" for debugging
2469 'remote_host' => <<'END_OF_FUNC',
2471 return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}
2477 #### Method: remote_addr
2478 # Return the IP addr of the remote host.
2480 'remote_addr' => <<'END_OF_FUNC',
2482 return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
2487 #### Method: script_name
2488 # Return the partial URL to this script for
2489 # self-referencing scripts. Also see
2490 # self_url(), which returns a URL with all state information
2493 'script_name' => <<'END_OF_FUNC',
2495 return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
2496 # These are for debugging
2497 return "/$0" unless $0=~/^\//;
2503 #### Method: referer
2504 # Return the HTTP_REFERER: useful for generating
2507 'referer' => <<'END_OF_FUNC',
2509 my($self) = self_or_CGI(@_);
2510 return $self->http('referer');
2515 #### Method: server_name
2516 # Return the name of the server
2518 'server_name' => <<'END_OF_FUNC',
2520 return $ENV{'SERVER_NAME'} || 'localhost';
2524 #### Method: server_software
2525 # Return the name of the server software
2527 'server_software' => <<'END_OF_FUNC',
2528 sub server_software {
2529 return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
2533 #### Method: server_port
2534 # Return the tcp/ip port the server is running on
2536 'server_port' => <<'END_OF_FUNC',
2538 return $ENV{'SERVER_PORT'} || 80; # for debugging
2542 #### Method: server_protocol
2543 # Return the protocol (usually HTTP/1.0)
2545 'server_protocol' => <<'END_OF_FUNC',
2546 sub server_protocol {
2547 return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging
2552 # Return the value of an HTTP variable, or
2553 # the list of variables if none provided
2555 'http' => <<'END_OF_FUNC',
2557 my ($self,$parameter) = self_or_CGI(@_);
2558 return $ENV{$parameter} if $parameter=~/^HTTP/;
2559 return $ENV{"HTTP_\U$parameter\E"} if $parameter;
2561 foreach (keys %ENV) {
2562 push(@p,$_) if /^HTTP/;
2569 # Return the value of HTTPS
2571 'https' => <<'END_OF_FUNC',
2574 my ($self,$parameter) = self_or_CGI(@_);
2575 return $ENV{HTTPS} unless $parameter;
2576 return $ENV{$parameter} if $parameter=~/^HTTPS/;
2577 return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
2579 foreach (keys %ENV) {
2580 push(@p,$_) if /^HTTPS/;
2586 #### Method: protocol
2587 # Return the protocol (http or https currently)
2589 'protocol' => <<'END_OF_FUNC',
2593 return 'https' if uc($self->https()) eq 'ON';
2594 return 'https' if $self->server_port == 443;
2595 my $prot = $self->server_protocol;
2596 my($protocol,$version) = split('/',$prot);
2597 return "\L$protocol\E";
2601 #### Method: remote_ident
2602 # Return the identity of the remote user
2603 # (but only if his host is running identd)
2605 'remote_ident' => <<'END_OF_FUNC',
2607 return $ENV{'REMOTE_IDENT'};
2612 #### Method: auth_type
2613 # Return the type of use verification/authorization in use, if any.
2615 'auth_type' => <<'END_OF_FUNC',
2617 return $ENV{'AUTH_TYPE'};
2622 #### Method: remote_user
2623 # Return the authorization name used for user
2626 'remote_user' => <<'END_OF_FUNC',
2628 return $ENV{'REMOTE_USER'};
2633 #### Method: user_name
2634 # Try to return the remote user's name by hook or by
2637 'user_name' => <<'END_OF_FUNC',
2639 my ($self) = self_or_CGI(@_);
2640 return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
2645 # Set or return the NPH global flag
2647 'nph' => <<'END_OF_FUNC',
2649 my ($self,$param) = self_or_CGI(@_);
2650 $CGI::NPH = $param if defined($param);
2655 #### Method: private_tempfiles
2656 # Set or return the private_tempfiles global flag
2658 'private_tempfiles' => <<'END_OF_FUNC',
2659 sub private_tempfiles {
2660 my ($self,$param) = self_or_CGI(@_);
2661 $CGI::PRIVATE_TEMPFILES = $param if defined($param);
2662 return $CGI::PRIVATE_TEMPFILES;
2666 #### Method: default_dtd
2667 # Set or return the default_dtd global
2669 'default_dtd' => <<'END_OF_FUNC',
2671 my ($self,$param) = self_or_CGI(@_);
2672 $CGI::DEFAULT_DTD = $param if defined($param);
2673 return $CGI::DEFAULT_DTD;
2677 # -------------- really private subroutines -----------------
2678 'previous_or_default' => <<'END_OF_FUNC',
2679 sub previous_or_default {
2680 my($self,$name,$defaults,$override) = @_;
2683 if (!$override && ($self->{'.fieldnames'}->{$name} ||
2684 defined($self->param($name)) ) ) {
2685 grep($selected{$_}++,$self->param($name));
2686 } elsif (defined($defaults) && ref($defaults) &&
2687 (ref($defaults) eq 'ARRAY')) {
2688 grep($selected{$_}++,@{$defaults});
2690 $selected{$defaults}++ if defined($defaults);
2697 'register_parameter' => <<'END_OF_FUNC',
2698 sub register_parameter {
2699 my($self,$param) = @_;
2700 $self->{'.parametersToAdd'}->{$param}++;
2704 'get_fields' => <<'END_OF_FUNC',
2707 return $self->CGI::hidden('-name'=>'.cgifields',
2708 '-values'=>[keys %{$self->{'.parametersToAdd'}}],
2713 'read_from_cmdline' => <<'END_OF_FUNC',
2714 sub read_from_cmdline {
2720 require "shellwords.pl";
2721 print STDERR "(offline mode: enter name=value pairs on standard input)\n";
2722 chomp(@lines = <STDIN>); # remove newlines
2723 $input = join(" ",@lines);
2724 @words = &shellwords($input);
2731 if ("@words"=~/=/) {
2732 $query_string = join('&',@words);
2734 $query_string = join('+',@words);
2736 return $query_string;
2741 # subroutine: read_multipart
2743 # Read multipart data and store it into our parameters.
2744 # An interesting feature is that if any of the parts is a file, we
2745 # create a temporary file and open up a filehandle on it so that the
2746 # caller can read from it if necessary.
2748 'read_multipart' => <<'END_OF_FUNC',
2749 sub read_multipart {
2750 my($self,$boundary,$length,$filehandle) = @_;
2751 my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle);
2752 return unless $buffer;
2755 while (!$buffer->eof) {
2756 %header = $buffer->readHeader;
2757 die "Malformed multipart POST\n" unless %header;
2759 my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
2761 # Bug: Netscape doesn't escape quotation marks in file names!!!
2762 my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
2764 # add this parameter to our list
2765 $self->add_parameter($param);
2767 # If no filename specified, then just read the data and assign it
2768 # to our parameter list.
2769 unless ($filename) {
2770 my($value) = $buffer->readBody;
2771 push(@{$self->{$param}},$value);
2775 my ($tmpfile,$tmp,$filehandle);
2777 # If we get here, then we are dealing with a potentially large
2778 # uploaded form. Save the data to a temporary file, then open
2779 # the file for reading.
2781 # skip the file if uploads disabled
2782 if ($DISABLE_UPLOADS) {
2783 while (defined($data = $buffer->read)) { }
2787 $tmpfile = new TempFile;
2788 $tmp = $tmpfile->as_string;
2790 $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES);
2792 $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
2793 chmod 0600,$tmp; # only the owner can tamper with it
2797 while (defined($data = $buffer->read)) {
2798 print $filehandle $data;
2801 # back up to beginning of file
2802 seek($filehandle,0,0);
2803 $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
2805 # Save some information about the uploaded file where we can get
2807 $self->{'.tmpfiles'}->{$filename}= {
2811 push(@{$self->{$param}},$filehandle);
2817 'tmpFileName' => <<'END_OF_FUNC',
2819 my($self,$filename) = self_or_default(@_);
2820 return $self->{'.tmpfiles'}->{$filename}->{name} ?
2821 $self->{'.tmpfiles'}->{$filename}->{name}->as_string
2826 'uploadInfo' => <<'END_OF_FUNC',
2828 my($self,$filename) = self_or_default(@_);
2829 return $self->{'.tmpfiles'}->{$filename}->{info};
2833 # internal routine, don't use
2834 '_set_values_and_labels' => <<'END_OF_FUNC',
2835 sub _set_values_and_labels {
2838 $$l = $v if ref($v) eq 'HASH' && !ref($$l);
2839 return $self->param($n) if !defined($v);
2840 return $v if !ref($v);
2841 return ref($v) eq 'HASH' ? keys %$v : @$v;
2845 '_compile_all' => <<'END_OF_FUNC',
2848 next if defined(&$_);
2849 $AUTOLOAD = "CGI::$_";
2859 #########################################################
2860 # Globals and stubs for other packages that we use.
2861 #########################################################
2863 ################### Fh -- lightweight filehandle ###############
2872 *Fh::AUTOLOAD = \&CGI::AUTOLOAD;
2874 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2875 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2877 'asString' => <<'END_OF_FUNC',
2880 # get rid of package name
2881 (my $i = $$self) =~ s/^\*(\w+::)+//;
2885 # This was an extremely clever patch that allowed "use strict refs".
2886 # Unfortunately it relied on another bug that caused leaky file descriptors.
2887 # The underlying bug has been fixed, so this no longer works. However
2888 # "strict refs" still works for some reason.
2890 # return ${*{$self}{SCALAR}};
2895 'compare' => <<'END_OF_FUNC',
2899 return "$self" cmp $value;
2903 'new' => <<'END_OF_FUNC',
2905 my($pack,$name,$file,$delete) = @_;
2906 require Fcntl unless defined &Fcntl::O_RDWR;
2908 my $ref = \*{'Fh::' . quotemeta($name)};
2909 sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL())
2910 || die "CGI open of $file: $!\n";
2911 unlink($file) if $delete;
2913 return bless $ref,$pack;
2917 'DESTROY' => <<'END_OF_FUNC',
2927 ######################## MultipartBuffer ####################
2928 package MultipartBuffer;
2930 # how many bytes to read at a time. We use
2931 # a 4K buffer by default.
2932 $INITIAL_FILLUNIT = 1024 * 4;
2933 $TIMEOUT = 240*60; # 4 hour timeout for big files
2934 $SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers
2937 #reuse the autoload function
2938 *MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
2940 # avoid autoloader warnings
2943 ###############################################################################
2944 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
2945 ###############################################################################
2946 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2947 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2950 'new' => <<'END_OF_FUNC',
2952 my($package,$interface,$boundary,$length,$filehandle) = @_;
2953 $FILLUNIT = $INITIAL_FILLUNIT;
2956 my($package) = caller;
2957 # force into caller's package if necessary
2958 $IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
2960 $IN = "main::STDIN" unless $IN;
2962 $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
2964 # If the user types garbage into the file upload field,
2965 # then Netscape passes NOTHING to the server (not good).
2966 # We may hang on this read in that case. So we implement
2967 # a read timeout. If nothing is ready to read
2968 # by then, we return.
2970 # Netscape seems to be a little bit unreliable
2971 # about providing boundary strings.
2974 # Under the MIME spec, the boundary consists of the
2975 # characters "--" PLUS the Boundary string
2977 # BUG: IE 3.01 on the Macintosh uses just the boundary -- not
2978 # the two extra hyphens. We do a special case here on the user-agent!!!!
2979 $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; ?Mac');
2981 } else { # otherwise we find it ourselves
2983 ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
2984 $boundary = <$IN>; # BUG: This won't work correctly under mod_perl
2985 $length -= length($boundary);
2986 chomp($boundary); # remove the CRLF
2987 $/ = $old; # restore old line separator
2990 my $self = {LENGTH=>$length,
2991 BOUNDARY=>$boundary,
2993 INTERFACE=>$interface,
2997 $FILLUNIT = length($boundary)
2998 if length($boundary) > $FILLUNIT;
3000 my $retval = bless $self,ref $package || $package;
3002 # Read the preamble and the topmost (boundary) line plus the CRLF.
3003 while ($self->read(0)) { }
3004 die "Malformed multipart POST\n" if $self->eof;
3010 'readHeader' => <<'END_OF_FUNC',
3017 if ($CGI::OS eq 'VMS') { # tssk, tssk: inconsistency alert!
3018 local($CRLF) = "\015\012";
3022 $self->fillBuffer($FILLUNIT);
3023 $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
3024 $ok++ if $self->{BUFFER} eq '';
3025 $bad++ if !$ok && $self->{LENGTH} <= 0;
3026 # this was a bad idea
3027 # $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT;
3028 } until $ok || $bad;
3031 my($header) = substr($self->{BUFFER},0,$end+2);
3032 substr($self->{BUFFER},0,$end+4) = '';
3036 # See RFC 2045 Appendix A and RFC 822 sections 3.4.8
3037 # (Folding Long Header Fields), 3.4.3 (Comments)
3038 # and 3.4.5 (Quoted-Strings).
3040 my $token = '[-\w!\#$%&\'*+.^_\`|{}~]';
3041 $header=~s/$CRLF\s+/ /og; # merge continuation lines
3042 while ($header=~/($token+):\s+([^$CRLF]*)/mgox) {
3043 my ($field_name,$field_value) = ($1,$2); # avoid taintedness
3044 $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize
3045 $return{$field_name}=$field_value;
3051 # This reads and returns the body as a single scalar value.
3052 'readBody' => <<'END_OF_FUNC',
3057 while (defined($data = $self->read)) {
3058 $returnval .= $data;
3064 # This will read $bytes or until the boundary is hit, whichever happens
3065 # first. After the boundary is hit, we return undef. The next read will
3066 # skip over the boundary and begin reading again;
3067 'read' => <<'END_OF_FUNC',
3069 my($self,$bytes) = @_;
3071 # default number of bytes to read
3072 $bytes = $bytes || $FILLUNIT;
3074 # Fill up our internal buffer in such a way that the boundary
3075 # is never split between reads.
3076 $self->fillBuffer($bytes);
3078 # Find the boundary in the buffer (it may not be there).
3079 my $start = index($self->{BUFFER},$self->{BOUNDARY});
3080 # protect against malformed multipart POST operations
3081 die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
3083 # If the boundary begins the data, then skip past it
3084 # and return undef. The +2 here is a fiendish plot to
3085 # remove the CR/LF pair at the end of the boundary.
3088 # clear us out completely if we've hit the last boundary.
3089 if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
3095 # just remove the boundary.
3096 substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
3101 if ($start > 0) { # read up to the boundary
3102 $bytesToReturn = $start > $bytes ? $bytes : $start;
3103 } else { # read the requested number of bytes
3104 # leave enough bytes in the buffer to allow us to read
3105 # the boundary. Thanks to Kevin Hendrick for finding
3107 $bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
3110 my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
3111 substr($self->{BUFFER},0,$bytesToReturn)='';
3113 # If we hit the boundary, remove the CRLF from the end.
3114 return ($start > 0) ? substr($returnval,0,-2) : $returnval;
3119 # This fills up our internal buffer in such a way that the
3120 # boundary is never split between reads
3121 'fillBuffer' => <<'END_OF_FUNC',
3123 my($self,$bytes) = @_;
3124 return unless $self->{LENGTH};
3126 my($boundaryLength) = length($self->{BOUNDARY});
3127 my($bufferLength) = length($self->{BUFFER});
3128 my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
3129 $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
3131 # Try to read some data. We may hang here if the browser is screwed up.
3132 my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
3136 $self->{BUFFER} = '' unless defined $self->{BUFFER};
3138 # An apparent bug in the Apache server causes the read()
3139 # to return zero bytes repeatedly without blocking if the
3140 # remote user aborts during a file transfer. I don't know how
3141 # they manage this, but the workaround is to abort if we get
3142 # more than SPIN_LOOP_MAX consecutive zero reads.
3143 if ($bytesRead == 0) {
3144 die "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
3145 if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
3147 $self->{ZERO_LOOP_COUNTER}=0;
3150 $self->{LENGTH} -= $bytesRead;
3155 # Return true when we've finished reading
3156 'eof' => <<'END_OF_FUNC'
3159 return 1 if (length($self->{BUFFER}) == 0)
3160 && ($self->{LENGTH} <= 0);
3168 ####################################################################################
3169 ################################## TEMPORARY FILES #################################
3170 ####################################################################################
3174 $MAC = $CGI::OS eq 'MACINTOSH';
3175 my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
3176 unless ($TMPDIRECTORY) {
3177 @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
3178 "C:${SL}temp","${SL}tmp","${SL}temp","${vol}${SL}Temporary Items",
3181 do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
3185 $TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY;
3189 # cute feature, but overload implementation broke it
3190 # %OVERLOAD = ('""'=>'as_string');
3191 *TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
3193 ###############################################################################
3194 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
3195 ###############################################################################
3196 $AUTOLOADED_ROUTINES = ''; # prevent -w error
3197 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
3200 'new' => <<'END_OF_FUNC',
3205 for ($i = 0; $i < $MAXTRIES; $i++) {
3206 $directory = sprintf("${TMPDIRECTORY}${SL}CGItemp%d%04d",${$},++$SEQUENCE);
3207 last if ! -f $directory;
3209 return bless \$directory;
3213 'DESTROY' => <<'END_OF_FUNC',
3216 unlink $$self; # get rid of the file
3220 'as_string' => <<'END_OF_FUNC'
3232 # We get a whole bunch of warnings about "possibly uninitialized variables"
3233 # when running with the -w switch. Touch them all once to get rid of the
3234 # warnings. This is ugly and I hate it.
3239 $MultipartBuffer::SPIN_LOOP_MAX;
3240 $MultipartBuffer::CRLF;
3241 $MultipartBuffer::TIMEOUT;
3242 $MultipartBuffer::INITIAL_FILLUNIT;
3243 $TempFile::SEQUENCE;
3254 CGI - Simple Common Gateway Interface Class
3258 # CGI script that creates a fill-out form
3259 # and echoes back its values.
3261 use CGI qw/:standard/;
3263 start_html('A Simple Example'),
3264 h1('A Simple Example'),
3266 "What's your name? ",textfield('name'),p,
3267 "What's the combination?", p,
3268 checkbox_group(-name=>'words',
3269 -values=>['eenie','meenie','minie','moe'],
3270 -defaults=>['eenie','minie']), p,
3271 "What's your favorite color? ",
3272 popup_menu(-name=>'color',
3273 -values=>['red','green','blue','chartreuse']),p,
3279 print "Your name is",em(param('name')),p,
3280 "The keywords are: ",em(join(", ",param('words'))),p,
3281 "Your favorite color is ",em(param('color')),
3287 This perl library uses perl5 objects to make it easy to create Web
3288 fill-out forms and parse their contents. This package defines CGI
3289 objects, entities that contain the values of the current query string
3290 and other state variables. Using a CGI object's methods, you can
3291 examine keywords and parameters passed to your script, and create
3292 forms whose initial values are taken from the current query (thereby
3293 preserving state information). The module provides shortcut functions
3294 that produce boilerplate HTML, reducing typing and coding errors. It
3295 also provides functionality for some of the more advanced features of
3296 CGI scripting, including support for file uploads, cookies, cascading
3297 style sheets, server push, and frames.
3299 CGI.pm also provides a simple function-oriented programming style for
3300 those who don't need its object-oriented features.
3302 The current version of CGI.pm is available at
3304 http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
3305 ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
3309 =head2 PROGRAMMING STYLE
3311 There are two styles of programming with CGI.pm, an object-oriented
3312 style and a function-oriented style. In the object-oriented style you
3313 create one or more CGI objects and then use object methods to create
3314 the various elements of the page. Each CGI object starts out with the
3315 list of named parameters that were passed to your CGI script by the
3316 server. You can modify the objects, save them to a file or database
3317 and recreate them. Because each object corresponds to the "state" of
3318 the CGI script, and because each object's parameter list is
3319 independent of the others, this allows you to save the state of the
3320 script and restore it later.
3322 For example, using the object oriented style, here is how you create
3323 a simple "Hello World" HTML page:
3325 #!/usr/local/bin/perl
3326 use CGI; # load CGI routines
3327 $q = new CGI; # create new CGI object
3328 print $q->header, # create the HTTP header
3329 $q->start_html('hello world'), # start the HTML
3330 $q->h1('hello world'), # level 1 header
3331 $q->end_html; # end the HTML
3333 In the function-oriented style, there is one default CGI object that
3334 you rarely deal with directly. Instead you just call functions to
3335 retrieve CGI parameters, create HTML tags, manage cookies, and so
3336 on. This provides you with a cleaner programming interface, but
3337 limits you to using one CGI object at a time. The following example
3338 prints the same page, but uses the function-oriented interface.
3339 The main differences are that we now need to import a set of functions
3340 into our name space (usually the "standard" functions), and we don't
3341 need to create the CGI object.
3343 #!/usr/local/bin/perl
3344 use CGI qw/:standard/; # load standard CGI routines
3345 print header, # create the HTTP header
3346 start_html('hello world'), # start the HTML
3347 h1('hello world'), # level 1 header
3348 end_html; # end the HTML
3350 The examples in this document mainly use the object-oriented style.
3351 See HOW TO IMPORT FUNCTIONS for important information on
3352 function-oriented programming in CGI.pm
3354 =head2 CALLING CGI.PM ROUTINES
3356 Most CGI.pm routines accept several arguments, sometimes as many as 20
3357 optional ones! To simplify this interface, all routines use a named
3358 argument calling style that looks like this:
3360 print $q->header(-type=>'image/gif',-expires=>'+3d');
3362 Each argument name is preceded by a dash. Neither case nor order
3363 matters in the argument list. -type, -Type, and -TYPE are all
3364 acceptable. In fact, only the first argument needs to begin with a
3365 dash. If a dash is present in the first argument, CGI.pm assumes
3366 dashes for the subsequent ones.
3368 You don't have to use the hyphen at all if you don't want to. After
3369 creating a CGI object, call the B<use_named_parameters()> method with
3370 a nonzero value. This will tell CGI.pm that you intend to use named
3371 parameters exclusively:
3374 $query->use_named_parameters(1);
3375 $field = $query->radio_group('name'=>'OS',
3376 'values'=>['Unix','Windows','Macintosh'],
3379 Several routines are commonly called with just one argument. In the
3380 case of these routines you can provide the single argument without an
3381 argument name. header() happens to be one of these routines. In this
3382 case, the single argument is the document type.
3384 print $q->header('text/html');
3386 Other such routines are documented below.
3388 Sometimes named arguments expect a scalar, sometimes a reference to an
3389 array, and sometimes a reference to a hash. Often, you can pass any
3390 type of argument and the routine will do whatever is most appropriate.
3391 For example, the param() routine is used to set a CGI parameter to a
3392 single or a multi-valued value. The two cases are shown below:
3394 $q->param(-name=>'veggie',-value=>'tomato');
3395 $q->param(-name=>'veggie',-value=>'[tomato','tomahto','potato','potahto']);
3397 A large number of routines in CGI.pm actually aren't specifically
3398 defined in the module, but are generated automatically as needed.
3399 These are the "HTML shortcuts," routines that generate HTML tags for
3400 use in dynamically-generated pages. HTML tags have both attributes
3401 (the attribute="value" pairs within the tag itself) and contents (the
3402 part between the opening and closing pairs.) To distinguish between
3403 attributes and contents, CGI.pm uses the convention of passing HTML
3404 attributes as a hash reference as the first argument, and the
3405 contents, if any, as any subsequent arguments. It works out like
3411 h1('some','contents'); <H1>some contents</H1>
3412 h1({-align=>left}); <H1 ALIGN="LEFT">
3413 h1({-align=>left},'contents'); <H1 ALIGN="LEFT">contents</H1>
3415 HTML tags are described in more detail later.
3417 Many newcomers to CGI.pm are puzzled by the difference between the
3418 calling conventions for the HTML shortcuts, which require curly braces
3419 around the HTML tag attributes, and the calling conventions for other
3420 routines, which manage to generate attributes without the curly
3421 brackets. Don't be confused. As a convenience the curly braces are
3422 optional in all but the HTML shortcuts. If you like, you can use
3423 curly braces when calling any routine that takes named arguments. For
3426 print $q->header( {-type=>'image/gif',-expires=>'+3d'} );
3428 If you use the B<-w> switch, you will be warned that some CGI.pm argument
3429 names conflict with built-in Perl functions. The most frequent of
3430 these is the -values argument, used to create multi-valued menus,
3431 radio button clusters and the like. To get around this warning, you
3432 have several choices:
3436 =item 1. Use another name for the argument, if one is available. For
3437 example, -value is an alias for -values.
3439 =item 2. Change the capitalization, e.g. -Values
3441 =item 3. Put quotes around the argument name, e.g. '-values'
3445 Many routines will do something useful with a named argument that it
3446 doesn't recognize. For example, you can produce non-standard HTTP
3447 header fields by providing them as named arguments:
3449 print $q->header(-type => 'text/html',
3450 -cost => 'Three smackers',
3451 -annoyance_level => 'high',
3452 -complaints_to => 'bit bucket');
3454 This will produce the following nonstandard HTTP header:
3457 Cost: Three smackers
3458 Annoyance-level: high
3459 Complaints-to: bit bucket
3460 Content-type: text/html
3462 Notice the way that underscores are translated automatically into
3463 hyphens. HTML-generating routines perform a different type of
3466 This feature allows you to keep up with the rapidly changing HTTP and
3469 =head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
3473 This will parse the input (from both POST and GET methods) and store
3474 it into a perl5 object called $query.
3476 =head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
3478 $query = new CGI(INPUTFILE);
3480 If you provide a file handle to the new() method, it will read
3481 parameters from the file (or STDIN, or whatever). The file can be in
3482 any of the forms describing below under debugging (i.e. a series of
3483 newline delimited TAG=VALUE pairs will work). Conveniently, this type
3484 of file is created by the save() method (see below). Multiple records
3485 can be saved and restored.
3487 Perl purists will be pleased to know that this syntax accepts
3488 references to file handles, or even references to filehandle globs,
3489 which is the "official" way to pass a filehandle:
3491 $query = new CGI(\*STDIN);
3493 You can also initialize the CGI object with a FileHandle or IO::File
3496 If you are using the function-oriented interface and want to
3497 initialize CGI state from a file handle, the way to do this is with
3498 B<restore_parameters()>. This will (re)initialize the
3499 default CGI object from the indicated file handle.
3501 open (IN,"test.in") || die;
3502 restore_parameters(IN);
3505 You can also initialize the query object from an associative array
3508 $query = new CGI( {'dinosaur'=>'barney',
3509 'song'=>'I love you',
3510 'friends'=>[qw/Jessica George Nancy/]}
3513 or from a properly formatted, URL-escaped query string:
3515 $query = new CGI('dinosaur=barney&color=purple');
3517 or from a previously existing CGI object (currently this clones the
3518 parameter list, but none of the other object-specific fields, such as
3521 $old_query = new CGI;
3522 $new_query = new CGI($old_query);
3524 To create an empty query, initialize it from an empty string or hash:
3526 $empty_query = new CGI("");
3530 $empty_query = new CGI({});
3532 =head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
3534 @keywords = $query->keywords
3536 If the script was invoked as the result of an <ISINDEX> search, the
3537 parsed keywords can be obtained as an array using the keywords() method.
3539 =head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT:
3541 @names = $query->param
3543 If the script was invoked with a parameter list
3544 (e.g. "name1=value1&name2=value2&name3=value3"), the param()
3545 method will return the parameter names as a list. If the
3546 script was invoked as an <ISINDEX> script, there will be a
3547 single parameter named 'keywords'.
3549 NOTE: As of version 1.5, the array of parameter names returned will
3550 be in the same order as they were submitted by the browser.
3551 Usually this order is the same as the order in which the
3552 parameters are defined in the form (however, this isn't part
3553 of the spec, and so isn't guaranteed).
3555 =head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER:
3557 @values = $query->param('foo');
3561 $value = $query->param('foo');
3563 Pass the param() method a single argument to fetch the value of the
3564 named parameter. If the parameter is multivalued (e.g. from multiple
3565 selections in a scrolling list), you can ask to receive an array. Otherwise
3566 the method will return a single value.
3568 =head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
3570 $query->param('foo','an','array','of','values');
3572 This sets the value for the named parameter 'foo' to an array of
3573 values. This is one way to change the value of a field AFTER
3574 the script has been invoked once before. (Another way is with
3575 the -override parameter accepted by all methods that generate
3578 param() also recognizes a named parameter style of calling described
3579 in more detail later:
3581 $query->param(-name=>'foo',-values=>['an','array','of','values']);
3585 $query->param(-name=>'foo',-value=>'the value');
3587 =head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
3589 $query->append(-name=>'foo',-values=>['yet','more','values']);
3591 This adds a value or list of values to the named parameter. The
3592 values are appended to the end of the parameter if it already exists.
3593 Otherwise the parameter is created. Note that this method only
3594 recognizes the named argument calling syntax.
3596 =head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE:
3598 $query->import_names('R');
3600 This creates a series of variables in the 'R' namespace. For example,
3601 $R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear.
3602 If no namespace is given, this method will assume 'Q'.
3603 WARNING: don't import anything into 'main'; this is a major security
3606 In older versions, this method was called B<import()>. As of version 2.20,
3607 this name has been removed completely to avoid conflict with the built-in
3608 Perl module B<import> operator.
3610 =head2 DELETING A PARAMETER COMPLETELY:
3612 $query->delete('foo');
3614 This completely clears a parameter. It sometimes useful for
3615 resetting parameters that you don't want passed down between
3618 If you are using the function call interface, use "Delete()" instead
3619 to avoid conflicts with Perl's built-in delete operator.
3621 =head2 DELETING ALL PARAMETERS:
3623 $query->delete_all();
3625 This clears the CGI object completely. It might be useful to ensure
3626 that all the defaults are taken when you create a fill-out form.
3628 Use Delete_all() instead if you are using the function call interface.
3630 =head2 DIRECT ACCESS TO THE PARAMETER LIST:
3632 $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
3633 unshift @{$q->param_fetch(-name=>'address')},'George Munster';
3635 If you need access to the parameter list in a way that isn't covered
3636 by the methods above, you can obtain a direct reference to it by
3637 calling the B<param_fetch()> method with the name of the . This
3638 will return an array reference to the named parameters, which you then
3639 can manipulate in any way you like.
3641 You can also use a named argument style using the B<-name> argument.
3643 =head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
3645 $query->save(FILEHANDLE)
3647 This will write the current state of the form to the provided
3648 filehandle. You can read it back in by providing a filehandle
3649 to the new() method. Note that the filehandle can be a file, a pipe,
3652 The format of the saved file is:
3660 Both name and value are URL escaped. Multi-valued CGI parameters are
3661 represented as repeated names. A session record is delimited by a
3662 single = symbol. You can write out multiple records and read them
3663 back in with several calls to B<new>. You can do this across several
3664 sessions by opening the file in append mode, allowing you to create
3665 primitive guest books, or to keep a history of users' queries. Here's
3666 a short example of creating multiple session records:
3670 open (OUT,">>test.out") || die;
3672 foreach (0..$records) {
3674 $q->param(-name=>'counter',-value=>$_);
3679 # reopen for reading
3680 open (IN,"test.out") || die;
3682 my $q = new CGI(IN);
3683 print $q->param('counter'),"\n";
3686 The file format used for save/restore is identical to that used by the
3687 Whitehead Genome Center's data exchange format "Boulderio", and can be
3688 manipulated and even databased using Boulderio utilities. See
3690 http://www.genome.wi.mit.edu/genome_software/other/boulder.html
3692 for further details.
3694 If you wish to use this method from the function-oriented (non-OO)
3695 interface, the exported name for this method is B<save_parameters()>.
3697 =head2 USING THE FUNCTION-ORIENTED INTERFACE
3699 To use the function-oriented interface, you must specify which CGI.pm
3700 routines or sets of routines to import into your script's namespace.
3701 There is a small overhead associated with this importation, but it
3704 use CGI <list of methods>;
3706 The listed methods will be imported into the current package; you can
3707 call them directly without creating a CGI object first. This example
3708 shows how to import the B<param()> and B<header()>
3709 methods, and then use them directly:
3711 use CGI 'param','header';
3712 print header('text/plain');
3713 $zipcode = param('zipcode');
3715 More frequently, you'll import common sets of functions by referring
3716 to the groups by name. All function sets are preceded with a ":"
3717 character as in ":html3" (for tags defined in the HTML 3 standard).
3719 Here is a list of the function sets you can import:
3725 Import all CGI-handling methods, such as B<param()>, B<path_info()>
3730 Import all fill-out form generating methods, such as B<textfield()>.
3734 Import all methods that generate HTML 2.0 standard elements.
3738 Import all methods that generate HTML 3.0 proposed elements (such as
3739 <table>, <super> and <sub>).
3743 Import all methods that generate Netscape-specific HTML extensions.
3747 Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
3752 Import "standard" features, 'html2', 'html3', 'form' and 'cgi'.
3756 Import all the available methods. For the full list, see the CGI.pm
3757 code, where the variable %TAGS is defined.
3761 If you import a function name that is not part of CGI.pm, the module
3762 will treat it as a new HTML tag and generate the appropriate
3763 subroutine. You can then use it like any other HTML tag. This is to
3764 provide for the rapidly-evolving HTML "standard." For example, say
3765 Microsoft comes out with a new tag called <GRADIENT> (which causes the
3766 user's desktop to be flooded with a rotating gradient fill until his
3767 machine reboots). You don't need to wait for a new version of CGI.pm
3768 to start using it immeidately:
3770 use CGI qw/:standard :html3 gradient/;
3771 print gradient({-start=>'red',-end=>'blue'});
3773 Note that in the interests of execution speed CGI.pm does B<not> use
3774 the standard L<Exporter> syntax for specifying load symbols. This may
3775 change in the future.
3777 If you import any of the state-maintaining CGI or form-generating
3778 methods, a default CGI object will be created and initialized
3779 automatically the first time you use any of the methods that require
3780 one to be present. This includes B<param()>, B<textfield()>,
3781 B<submit()> and the like. (If you need direct access to the CGI
3782 object, you can find it in the global variable B<$CGI::Q>). By
3783 importing CGI.pm methods, you can create visually elegant scripts:
3785 use CGI qw/:standard/;
3788 start_html('Simple Script'),
3789 h1('Simple Script'),
3791 "What's your name? ",textfield('name'),p,
3792 "What's the combination?",
3793 checkbox_group(-name=>'words',
3794 -values=>['eenie','meenie','minie','moe'],
3795 -defaults=>['eenie','moe']),p,
3796 "What's your favorite color?",
3797 popup_menu(-name=>'color',
3798 -values=>['red','green','blue','chartreuse']),p,
3805 "Your name is ",em(param('name')),p,
3806 "The keywords are: ",em(join(", ",param('words'))),p,
3807 "Your favorite color is ",em(param('color')),".\n";
3813 In addition to the function sets, there are a number of pragmas that
3814 you can import. Pragmas, which are always preceded by a hyphen,
3815 change the way that CGI.pm functions in various ways. Pragmas,
3816 function sets, and individual functions can all be imported in the
3817 same use() line. For example, the following use statement imports the
3818 standard set of functions and disables debugging mode (pragma
3821 use CGI qw/:standard -no_debug/;
3823 The current list of pragmas is as follows:
3829 When you I<use CGI -any>, then any method that the query object
3830 doesn't recognize will be interpreted as a new HTML tag. This allows
3831 you to support the next I<ad hoc> Netscape or Microsoft HTML
3832 extension. This lets you go wild with new and unsupported tags:
3836 print $q->gradient({speed=>'fast',start=>'red',end=>'blue'});
3838 Since using <cite>any</cite> causes any mistyped method name
3839 to be interpreted as an HTML tag, use it with care or not at
3844 This causes the indicated autoloaded methods to be compiled up front,
3845 rather than deferred to later. This is useful for scripts that run
3846 for an extended period of time under FastCGI or mod_perl, and for
3847 those destined to be crunched by Malcom Beattie's Perl compiler. Use
3848 it in conjunction with the methods or method families you plan to use.
3850 use CGI qw(-compile :standard :html3);
3854 use CGI qw(-compile :all);
3856 Note that using the -compile pragma in this way will always have
3857 the effect of importing the compiled functions into the current
3858 namespace. If you want to compile without importing use the
3859 compile() method instead (see below).
3863 This makes CGI.pm produce a header appropriate for an NPH (no
3864 parsed header) script. You may need to do other things as well
3865 to tell the server that the script is NPH. See the discussion
3866 of NPH scripts below.
3868 =item -newstyle_urls
3870 Separate the name=value pairs in CGI parameter query strings with
3871 semicolons rather than ampersands. For example:
3873 ?name=fred;age=24;favorite_color=3
3875 Semicolon-delimited query strings are always accepted, but will not be
3876 emitted by self_url() and query_string() unless the -newstyle_urls
3877 pragma is specified.
3881 This overrides the autoloader so that any function in your program
3882 that is not recognized is referred to CGI.pm for possible evaluation.
3883 This allows you to use all the CGI.pm functions without adding them to
3884 your symbol table, which is of concern for mod_perl users who are
3885 worried about memory consumption. I<Warning:> when
3886 I<-autoload> is in effect, you cannot use "poetry mode"
3887 (functions without the parenthesis). Use I<hr()> rather
3888 than I<hr>, or add something like I<use subs qw/hr p header/>
3889 to the top of your script.
3893 This turns off the command-line processing features. If you want to
3894 run a CGI.pm script from the command line to produce HTML, and you
3895 don't want it pausing to request CGI parameters from standard input or
3896 the command line, then use this pragma:
3898 use CGI qw(-no_debug :standard);
3900 If you'd like to process the command-line parameters but not standard
3901 input, this should work:
3903 use CGI qw(-no_debug :standard);
3904 restore_parameters(join('&',@ARGV));
3906 See the section on debugging for more details.
3908 =item -private_tempfiles
3910 CGI.pm can process uploaded file. Ordinarily it spools the
3911 uploaded file to a temporary directory, then deletes the file
3912 when done. However, this opens the risk of eavesdropping as
3913 described in the file upload section.
3914 Another CGI script author could peek at this data during the
3915 upload, even if it is confidential information. On Unix systems,
3916 the -private_tempfiles pragma will cause the temporary file to be unlinked as soon
3917 as it is opened and before any data is written into it,
3918 eliminating the risk of eavesdropping.
3922 =head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS
3924 Many of the methods generate HTML tags. As described below, tag
3925 functions automatically generate both the opening and closing tags.
3928 print h1('Level 1 Header');
3932 <H1>Level 1 Header</H1>
3934 There will be some times when you want to produce the start and end
3935 tags yourself. In this case, you can use the form start_I<tag_name>
3936 and end_I<tag_name>, as in:
3938 print start_h1,'Level 1 Header',end_h1;
3940 With a few exceptions (described below), start_I<tag_name> and
3941 end_I<tag_name> functions are not generated automatically when you
3942 I<use CGI>. However, you can specify the tags you want to generate
3943 I<start/end> functions for by putting an asterisk in front of their
3944 name, or, alternatively, requesting either "start_I<tag_name>" or
3945 "end_I<tag_name>" in the import list.
3949 use CGI qw/:standard *table start_ul/;
3951 In this example, the following functions are generated in addition to
3956 =item 1. start_table() (generates a <TABLE> tag)
3958 =item 2. end_table() (generates a </TABLE> tag)
3960 =item 3. start_ul() (generates a <UL> tag)
3962 =item 4. end_ul() (generates a </UL> tag)
3966 =head1 GENERATING DYNAMIC DOCUMENTS
3968 Most of CGI.pm's functions deal with creating documents on the fly.
3969 Generally you will produce the HTTP header first, followed by the
3970 document itself. CGI.pm provides functions for generating HTTP
3971 headers of various types as well as for generating HTML. For creating
3972 GIF images, see the GD.pm module.
3974 Each of these functions produces a fragment of HTML or HTTP which you
3975 can print out directly so that it displays in the browser window,
3976 append to a string, or save to a file for later use.
3978 =head2 CREATING A STANDARD HTTP HEADER:
3980 Normally the first thing you will do in any CGI script is print out an
3981 HTTP header. This tells the browser what type of document to expect,
3982 and gives other optional information, such as the language, expiration
3983 date, and whether to cache the document. The header can also be
3984 manipulated for special purposes, such as server push and pay per view
3987 print $query->header;
3991 print $query->header('image/gif');
3995 print $query->header('text/html','204 No response');
3999 print $query->header(-type=>'image/gif',
4001 -status=>'402 Payment required',
4006 header() returns the Content-type: header. You can provide your own
4007 MIME type if you choose, otherwise it defaults to text/html. An
4008 optional second parameter specifies the status code and a human-readable
4009 message. For example, you can specify 204, "No response" to create a
4010 script that tells the browser to do nothing at all.
4012 The last example shows the named argument style for passing arguments
4013 to the CGI methods using named parameters. Recognized parameters are
4014 B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other named
4015 parameters will be stripped of their initial hyphens and turned into
4016 header fields, allowing you to specify any HTTP header you desire.
4017 Internal underscores will be turned into hyphens:
4019 print $query->header(-Content_length=>3002);
4021 Most browsers will not cache the output from CGI scripts. Every time
4022 the browser reloads the page, the script is invoked anew. You can
4023 change this behavior with the B<-expires> parameter. When you specify
4024 an absolute or relative expiration interval with this parameter, some
4025 browsers and proxy servers will cache the script's output until the
4026 indicated expiration date. The following forms are all valid for the
4029 +30s 30 seconds from now
4030 +10m ten minutes from now
4031 +1h one hour from now
4032 -1d yesterday (i.e. "ASAP!")
4035 +10y in ten years time
4036 Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date
4038 The B<-cookie> parameter generates a header that tells the browser to provide
4039 a "magic cookie" during all subsequent transactions with your script.
4040 Netscape cookies have a special format that includes interesting attributes
4041 such as expiration time. Use the cookie() method to create and retrieve
4044 The B<-nph> parameter, if set to a true value, will issue the correct
4045 headers to work with a NPH (no-parse-header) script. This is important
4046 to use with certain servers, such as Microsoft Internet Explorer, which
4047 expect all their scripts to be NPH.
4049 =head2 GENERATING A REDIRECTION HEADER
4051 print $query->redirect('http://somewhere.else/in/movie/land');
4053 Sometimes you don't want to produce a document yourself, but simply
4054 redirect the browser elsewhere, perhaps choosing a URL based on the
4055 time of day or the identity of the user.
4057 The redirect() function redirects the browser to a different URL. If
4058 you use redirection like this, you should B<not> print out a header as
4059 well. As of version 2.0, we produce both the unofficial Location:
4060 header and the official URI: header. This should satisfy most servers
4063 One hint I can offer is that relative links may not work correctly
4064 when you generate a redirection to another document on your site.
4065 This is due to a well-intentioned optimization that some servers use.
4066 The solution to this is to use the full URL (including the http: part)
4067 of the document you are redirecting to.
4069 You can also use named arguments:
4071 print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
4074 The B<-nph> parameter, if set to a true value, will issue the correct
4075 headers to work with a NPH (no-parse-header) script. This is important
4076 to use with certain servers, such as Microsoft Internet Explorer, which
4077 expect all their scripts to be NPH.
4079 =head2 CREATING THE HTML DOCUMENT HEADER
4081 print $query->start_html(-title=>'Secrets of the Pyramids',
4082 -author=>'fred@capricorn.org',
4085 -meta=>{'keywords'=>'pharaoh secret mummy',
4086 'copyright'=>'copyright 1996 King Tut'},
4087 -style=>{'src'=>'/styles/style1.css'},
4090 After creating the HTTP header, most CGI scripts will start writing
4091 out an HTML document. The start_html() routine creates the top of the
4092 page, along with a lot of optional information that controls the
4093 page's appearance and behavior.
4095 This method returns a canned HTML header and the opening <BODY> tag.
4096 All parameters are optional. In the named parameter form, recognized
4097 parameters are -title, -author, -base, -xbase and -target (see below
4098 for the explanation). Any additional parameters you provide, such as
4099 the Netscape unofficial BGCOLOR attribute, are added to the <BODY>
4100 tag. Additional parameters must be proceeded by a hyphen.
4102 The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
4103 different from the current location, as in
4105 -xbase=>"http://home.mcom.com/"
4107 All relative links will be interpreted relative to this tag.
4109 The argument B<-target> allows you to provide a default target frame
4110 for all the links and fill-out forms on the page. See the Netscape
4111 documentation on frames for details of how to manipulate this.
4113 -target=>"answer_window"
4115 All relative links will be interpreted relative to this tag.
4116 You add arbitrary meta information to the header with the B<-meta>
4117 argument. This argument expects a reference to an associative array
4118 containing name/value pairs of meta information. These will be turned
4119 into a series of header <META> tags that look something like this:
4121 <META NAME="keywords" CONTENT="pharaoh secret mummy">
4122 <META NAME="description" CONTENT="copyright 1996 King Tut">
4124 There is no support for the HTTP-EQUIV type of <META> tag. This is
4125 because you can modify the HTTP header directly with the B<header()>
4126 method. For example, if you want to send the Refresh: header, do it
4127 in the header() method:
4129 print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
4131 The B<-style> tag is used to incorporate cascading stylesheets into
4132 your code. See the section on CASCADING STYLESHEETS for more information.
4134 You can place other arbitrary HTML elements to the <HEAD> section with the
4135 B<-head> tag. For example, to place the rarely-used <LINK> element in the
4136 head section, use this:
4138 print $q->start_html(-head=>Link({-rel=>'next',
4139 -href=>'http://www.capricorn.com/s2.html'}));
4141 To incorporate multiple HTML elements into the <HEAD> section, just pass an
4144 print $q->start_html(-head=>[
4146 -href=>'http://www.capricorn.com/s2.html'}),
4147 Link({-rel=>'previous',
4148 -href=>'http://www.capricorn.com/s1.html'})
4152 JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
4153 B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
4154 to add Netscape JavaScript calls to your pages. B<-script> should
4155 point to a block of text containing JavaScript function definitions.
4156 This block will be placed within a <SCRIPT> block inside the HTML (not
4157 HTTP) header. The block is placed in the header in order to give your
4158 page a fighting chance of having all its JavaScript functions in place
4159 even if the user presses the stop button before the page has loaded
4160 completely. CGI.pm attempts to format the script in such a way that
4161 JavaScript-naive browsers will not choke on the code: unfortunately
4162 there are some browsers, such as Chimera for Unix, that get confused
4165 The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
4166 code to execute when the page is respectively opened and closed by the
4167 browser. Usually these parameters are calls to functions defined in the
4171 print $query->header;
4173 // Ask a silly question
4174 function riddle_me_this() {
4175 var r = prompt("What walks on four legs in the morning, " +
4176 "two legs in the afternoon, " +
4177 "and three legs in the evening?");
4180 // Get a silly answer
4181 function response(answer) {
4182 if (answer == "man")
4183 alert("Right you are!");
4185 alert("Wrong! Guess again.");
4188 print $query->start_html(-title=>'The Riddle of the Sphinx',
4191 Use the B<-noScript> parameter to pass some HTML text that will be displayed on
4192 browsers that do not have JavaScript (or browsers where JavaScript is turned
4195 Netscape 3.0 recognizes several attributes of the <SCRIPT> tag,
4196 including LANGUAGE and SRC. The latter is particularly interesting,
4197 as it allows you to keep the JavaScript code in a file or CGI script
4198 rather than cluttering up each page with the source. To use these
4199 attributes pass a HASH reference in the B<-script> parameter containing
4200 one or more of -language, -src, or -code:
4202 print $q->start_html(-title=>'The Riddle of the Sphinx',
4203 -script=>{-language=>'JAVASCRIPT',
4204 -src=>'/javascript/sphinx.js'}
4207 print $q->(-title=>'The Riddle of the Sphinx',
4208 -script=>{-language=>'PERLSCRIPT'},
4209 -code=>'print "hello world!\n;"'
4213 A final feature allows you to incorporate multiple <SCRIPT> sections into the
4214 header. Just pass the list of script sections as an array reference.
4215 this allows you to specify different source files for different dialects
4216 of JavaScript. Example:
4218 print $q->start_html(-title=>'The Riddle of the Sphinx',
4220 { -language => 'JavaScript1.0',
4221 -src => '/javascript/utilities10.js'
4223 { -language => 'JavaScript1.1',
4224 -src => '/javascript/utilities11.js'
4226 { -language => 'JavaScript1.2',
4227 -src => '/javascript/utilities12.js'
4229 { -language => 'JavaScript28.2',
4230 -src => '/javascript/utilities219.js'
4236 If this looks a bit extreme, take my advice and stick with straight CGI scripting.
4240 http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
4242 for more information about JavaScript.
4244 The old-style positional parameters are as follows:
4248 =item B<Parameters:>
4256 The author's e-mail address (will create a <LINK REV="MADE"> tag if present
4260 A 'true' flag if you want to include a <BASE> tag in the header. This
4261 helps resolve relative addresses to absolute ones when the document is moved,
4262 but makes the document hierarchy non-portable. Use with care!
4266 Any other parameters you want to include in the <BODY> tag. This is a good
4267 place to put Netscape extensions, such as colors and wallpaper patterns.
4271 =head2 ENDING THE HTML DOCUMENT:
4273 print $query->end_html
4275 This ends an HTML document by printing the </BODY></HTML> tags.
4277 =head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
4279 $myself = $query->self_url;
4280 print "<A HREF=$myself>I'm talking to myself.</A>";
4282 self_url() will return a URL, that, when selected, will reinvoke
4283 this script with all its state information intact. This is most
4284 useful when you want to jump around within the document using
4285 internal anchors but you don't want to disrupt the current contents
4286 of the form(s). Something like this will do the trick.
4288 $myself = $query->self_url;
4289 print "<A HREF=$myself#table1>See table 1</A>";
4290 print "<A HREF=$myself#table2>See table 2</A>";
4291 print "<A HREF=$myself#yourself>See for yourself</A>";
4293 If you want more control over what's returned, using the B<url()>
4296 You can also retrieve the unprocessed query string with query_string():
4298 $the_string = $query->query_string;
4300 =head2 OBTAINING THE SCRIPT'S URL
4302 $full_url = $query->url();
4303 $full_url = $query->url(-full=>1); #alternative syntax
4304 $relative_url = $query->url(-relative=>1);
4305 $absolute_url = $query->url(-absolute=>1);
4306 $url_with_path = $query->url(-path_info=>1);
4307 $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
4309 B<url()> returns the script's URL in a variety of formats. Called
4310 without any arguments, it returns the full form of the URL, including
4311 host name and port number
4313 http://your.host.com/path/to/script.cgi
4315 You can modify this format with the following named arguments:
4321 If true, produce an absolute URL, e.g.
4327 Produce a relative URL. This is useful if you want to reinvoke your
4328 script with different parameters. For example:
4334 Produce the full URL, exactly as if called without any arguments.
4335 This overrides the -relative and -absolute arguments.
4337 =item B<-path> (B<-path_info>)
4339 Append the additional path information to the URL. This can be
4340 combined with B<-full>, B<-absolute> or B<-relative>. B<-path_info>
4341 is provided as a synonym.
4343 =item B<-query> (B<-query_string>)
4345 Append the query string to the URL. This can be combined with
4346 B<-full>, B<-absolute> or B<-relative>. B<-query_string> is provided
4351 =head2 MIXING POST AND URL PARAMETERS
4353 $color = $query->url_param('color');
4355 It is possible for a script to receive CGI parameters in the URL as
4356 well as in the fill-out form by creating a form that POSTs to a URL
4357 containing a query string (a "?" mark followed by arguments). The
4358 B<param()> method will always return the contents of the POSTed
4359 fill-out form, ignoring the URL's query string. To retrieve URL
4360 parameters, call the B<url_param()> method. Use it in the same way as
4361 B<param()>. The main difference is that it allows you to read the
4362 parameters, but not set them.
4365 Under no circumstances will the contents of the URL query string
4366 interfere with similarly-named CGI parameters in POSTed forms. If you
4367 try to mix a URL query string with a form submitted with the GET
4368 method, the results will not be what you expect.
4370 =head1 CREATING STANDARD HTML ELEMENTS:
4372 CGI.pm defines general HTML shortcut methods for most, if not all of
4373 the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
4374 HTML element and return a fragment of HTML text that you can then
4375 print or manipulate as you like. Each shortcut returns a fragment of
4376 HTML code that you can append to a string, save to a file, or, most
4377 commonly, print out so that it displays in the browser window.
4379 This example shows how to use the HTML methods:
4382 print $q->blockquote(
4383 "Many years ago on the island of",
4384 $q->a({href=>"http://crete.org/"},"Crete"),
4385 "there lived a minotaur named",
4386 $q->strong("Fred."),
4390 This results in the following HTML code (extra newlines have been
4391 added for readability):
4394 Many years ago on the island of
4395 <a HREF="http://crete.org/">Crete</a> there lived
4396 a minotaur named <strong>Fred.</strong>
4400 If you find the syntax for calling the HTML shortcuts awkward, you can
4401 import them into your namespace and dispense with the object syntax
4402 completely (see the next section for more details):
4404 use CGI ':standard';
4406 "Many years ago on the island of",
4407 a({href=>"http://crete.org/"},"Crete"),
4408 "there lived a minotaur named",
4413 =head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
4415 The HTML methods will accept zero, one or multiple arguments. If you
4416 provide no arguments, you get a single tag:
4420 If you provide one or more string arguments, they are concatenated
4421 together with spaces and placed between opening and closing tags:
4423 print h1("Chapter","1"); # <H1>Chapter 1</H1>"
4425 If the first argument is an associative array reference, then the keys
4426 and values of the associative array become the HTML tag's attributes:
4428 print a({-href=>'fred.html',-target=>'_new'},
4429 "Open a new frame");
4431 <A HREF="fred.html",TARGET="_new">Open a new frame</A>
4433 You may dispense with the dashes in front of the attribute names if
4436 print img {src=>'fred.gif',align=>'LEFT'};
4438 <IMG ALIGN="LEFT" SRC="fred.gif">
4440 Sometimes an HTML tag attribute has no argument. For example, ordered
4441 lists can be marked as COMPACT. The syntax for this is an argument that
4442 that points to an undef string:
4444 print ol({compact=>undef},li('one'),li('two'),li('three'));
4446 Prior to CGI.pm version 2.41, providing an empty ('') string as an
4447 attribute argument was the same as providing undef. However, this has
4448 changed in order to accommodate those who want to create tags of the form
4449 <IMG ALT="">. The difference is shown in these two pieces of code:
4452 img({alt=>undef}) <IMG ALT>
4453 img({alt=>''}) <IMT ALT="">
4455 =head2 THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS
4457 One of the cool features of the HTML shortcuts is that they are
4458 distributive. If you give them an argument consisting of a
4459 B<reference> to a list, the tag will be distributed across each
4460 element of the list. For example, here's one way to make an ordered
4464 li({-type=>'disc'},['Sneezy','Doc','Sleepy','Happy']);
4467 This example will result in HTML output that looks like this:
4470 <LI TYPE="disc">Sneezy</LI>
4471 <LI TYPE="disc">Doc</LI>
4472 <LI TYPE="disc">Sleepy</LI>
4473 <LI TYPE="disc">Happy</LI>
4476 This is extremely useful for creating tables. For example:
4478 print table({-border=>undef},
4479 caption('When Should You Eat Your Vegetables?'),
4480 Tr({-align=>CENTER,-valign=>TOP},
4482 th(['Vegetable', 'Breakfast','Lunch','Dinner']),
4483 td(['Tomatoes' , 'no', 'yes', 'yes']),
4484 td(['Broccoli' , 'no', 'no', 'yes']),
4485 td(['Onions' , 'yes','yes', 'yes'])
4490 =head2 HTML SHORTCUTS AND LIST INTERPOLATION
4492 Consider this bit of code:
4494 print blockquote(em('Hi'),'mom!'));
4496 It will ordinarily return the string that you probably expect, namely:
4498 <BLOCKQUOTE><EM>Hi</EM> mom!</BLOCKQUOTE>
4500 Note the space between the element "Hi" and the element "mom!".
4501 CGI.pm puts the extra space there using array interpolation, which is
4502 controlled by the magic $" variable. Sometimes this extra space is
4503 not what you want, for example, when you are trying to align a series
4504 of images. In this case, you can simply change the value of $" to an
4509 print blockquote(em('Hi'),'mom!'));
4512 I suggest you put the code in a block as shown here. Otherwise the
4513 change to $" will affect all subsequent code until you explicitly
4516 =head2 NON-STANDARD HTML SHORTCUTS
4518 A few HTML tags don't follow the standard pattern for various
4521 B<comment()> generates an HTML comment (<!-- comment -->). Call it
4524 print comment('here is my comment');
4526 Because of conflicts with built-in Perl functions, the following functions
4527 begin with initial caps:
4536 In addition, start_html(), end_html(), start_form(), end_form(),
4537 start_multipart_form() and all the fill-out form tags are special.
4538 See their respective sections.
4540 =head2 PRETTY-PRINTING HTML
4542 By default, all the HTML produced by these functions comes out as one
4543 long line without carriage returns or indentation. This is yuck, but
4544 it does reduce the size of the documents by 10-20%. To get
4545 pretty-printed output, please use L<CGI::Pretty>, a subclass
4546 contributed by Brian Paulsen.
4548 =head1 CREATING FILL-OUT FORMS:
4550 I<General note> The various form-creating methods all return strings
4551 to the caller, containing the tag or tags that will create the requested
4552 form element. You are responsible for actually printing out these strings.
4553 It's set up this way so that you can place formatting tags
4554 around the form elements.
4556 I<Another note> The default values that you specify for the forms are only
4557 used the B<first> time the script is invoked (when there is no query
4558 string). On subsequent invocations of the script (when there is a query
4559 string), the former values are used even if they are blank.
4561 If you want to change the value of a field from its previous value, you have two
4564 (1) call the param() method to set it.
4566 (2) use the -override (alias -force) parameter (a new feature in version 2.15).
4567 This forces the default value to be used, regardless of the previous value:
4569 print $query->textfield(-name=>'field_name',
4570 -default=>'starting value',
4575 I<Yet another note> By default, the text and labels of form elements are
4576 escaped according to HTML rules. This means that you can safely use
4577 "<CLICK ME>" as the label for a button. However, it also interferes with
4578 your ability to incorporate special HTML character sequences, such as Á,
4579 into your fields. If you wish to turn off automatic escaping, call the
4580 autoEscape() method with a false value immediately after creating the CGI object:
4583 $query->autoEscape(undef);
4586 =head2 CREATING AN ISINDEX TAG
4588 print $query->isindex(-action=>$action);
4592 print $query->isindex($action);
4594 Prints out an <ISINDEX> tag. Not very exciting. The parameter
4595 -action specifies the URL of the script to process the query. The
4596 default is to process the query with the current script.
4598 =head2 STARTING AND ENDING A FORM
4600 print $query->startform(-method=>$method,
4602 -enctype=>$encoding);
4603 <... various form stuff ...>
4604 print $query->endform;
4608 print $query->startform($method,$action,$encoding);
4609 <... various form stuff ...>
4610 print $query->endform;
4612 startform() will return a <FORM> tag with the optional method,
4613 action and form encoding that you specify. The defaults are:
4617 enctype: application/x-www-form-urlencoded
4619 endform() returns the closing </FORM> tag.
4621 Startform()'s enctype argument tells the browser how to package the various
4622 fields of the form before sending the form to the server. Two
4623 values are possible:
4627 =item B<application/x-www-form-urlencoded>
4629 This is the older type of encoding used by all browsers prior to
4630 Netscape 2.0. It is compatible with many CGI scripts and is
4631 suitable for short fields containing text data. For your
4632 convenience, CGI.pm stores the name of this encoding
4633 type in B<$CGI::URL_ENCODED>.
4635 =item B<multipart/form-data>
4637 This is the newer type of encoding introduced by Netscape 2.0.
4638 It is suitable for forms that contain very large fields or that
4639 are intended for transferring binary data. Most importantly,
4640 it enables the "file upload" feature of Netscape 2.0 forms. For
4641 your convenience, CGI.pm stores the name of this encoding type
4642 in B<&CGI::MULTIPART>
4644 Forms that use this type of encoding are not easily interpreted
4645 by CGI scripts unless they use CGI.pm or another library designed
4650 For compatibility, the startform() method uses the older form of
4651 encoding by default. If you want to use the newer form of encoding
4652 by default, you can call B<start_multipart_form()> instead of
4655 JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
4656 for use with JavaScript. The -name parameter gives the
4657 form a name so that it can be identified and manipulated by
4658 JavaScript functions. -onSubmit should point to a JavaScript
4659 function that will be executed just before the form is submitted to your
4660 server. You can use this opportunity to check the contents of the form
4661 for consistency and completeness. If you find something wrong, you
4662 can put up an alert box or maybe fix things up yourself. You can
4663 abort the submission by returning false from this function.
4665 Usually the bulk of JavaScript functions are defined in a <SCRIPT>
4666 block in the HTML header and -onSubmit points to one of these function
4667 call. See start_html() for details.
4669 =head2 CREATING A TEXT FIELD
4671 print $query->textfield(-name=>'field_name',
4672 -default=>'starting value',
4677 print $query->textfield('field_name','starting value',50,80);
4679 textfield() will return a text input field.
4687 The first parameter is the required name for the field (-name).
4691 The optional second parameter is the default starting value for the field
4692 contents (-default).
4696 The optional third parameter is the size of the field in
4701 The optional fourth parameter is the maximum number of characters the
4702 field will accept (-maxlength).
4706 As with all these methods, the field will be initialized with its
4707 previous contents from earlier invocations of the script.
4708 When the form is processed, the value of the text field can be
4711 $value = $query->param('foo');
4713 If you want to reset it from its initial value after the script has been
4714 called once, you can do so like this:
4716 $query->param('foo',"I'm taking over this value!");
4718 NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
4719 value, you can force its current value by using the -override (alias -force)
4722 print $query->textfield(-name=>'field_name',
4723 -default=>'starting value',
4728 JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
4729 B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
4730 parameters to register JavaScript event handlers. The onChange
4731 handler will be called whenever the user changes the contents of the
4732 text field. You can do text validation if you like. onFocus and
4733 onBlur are called respectively when the insertion point moves into and
4734 out of the text field. onSelect is called when the user changes the
4735 portion of the text that is selected.
4737 =head2 CREATING A BIG TEXT FIELD
4739 print $query->textarea(-name=>'foo',
4740 -default=>'starting value',
4746 print $query->textarea('foo','starting value',10,50);
4748 textarea() is just like textfield, but it allows you to specify
4749 rows and columns for a multiline text entry box. You can provide
4750 a starting value for the field, which can be long and contain
4753 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
4754 B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
4755 recognized. See textfield().
4757 =head2 CREATING A PASSWORD FIELD
4759 print $query->password_field(-name=>'secret',
4760 -value=>'starting value',
4765 print $query->password_field('secret','starting value',50,80);
4767 password_field() is identical to textfield(), except that its contents
4768 will be starred out on the web page.
4770 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
4771 B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
4772 recognized. See textfield().
4774 =head2 CREATING A FILE UPLOAD FIELD
4776 print $query->filefield(-name=>'uploaded_file',
4777 -default=>'starting value',
4782 print $query->filefield('uploaded_file','starting value',50,80);
4784 filefield() will return a file upload field for Netscape 2.0 browsers.
4785 In order to take full advantage of this I<you must use the new
4786 multipart encoding scheme> for the form. You can do this either
4787 by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>,
4788 or by calling the new method B<start_multipart_form()> instead of
4789 vanilla B<startform()>.
4797 The first parameter is the required name for the field (-name).
4801 The optional second parameter is the starting value for the field contents
4802 to be used as the default file name (-default).
4804 For security reasons, browsers don't pay any attention to this field,
4805 and so the starting value will always be blank. Worse, the field
4806 loses its "sticky" behavior and forgets its previous contents. The
4807 starting value field is called for in the HTML specification, however,
4808 and possibly some browser will eventually provide support for it.
4812 The optional third parameter is the size of the field in
4817 The optional fourth parameter is the maximum number of characters the
4818 field will accept (-maxlength).
4822 When the form is processed, you can retrieve the entered filename
4825 $filename = $query->param('uploaded_file');
4827 In Netscape Navigator 2.0, the filename that gets returned is the full
4828 local filename on the B<remote user's> machine. If the remote user is
4829 on a Unix machine, the filename will follow Unix conventions:
4833 On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions:
4835 C:\PATH\TO\THE\FILE.MSW
4837 On a Macintosh machine, the filename will follow Mac conventions:
4839 HD 40:Desktop Folder:Sort Through:Reminders
4841 The filename returned is also a file handle. You can read the contents
4842 of the file using standard Perl file reading calls:
4844 # Read a text file and print it out
4845 while (<$filename>) {
4849 # Copy a binary file to somewhere safe
4850 open (OUTFILE,">>/usr/local/web/users/feedback");
4851 while ($bytesread=read($filename,$buffer,1024)) {
4852 print OUTFILE $buffer;
4855 When a file is uploaded the browser usually sends along some
4856 information along with it in the format of headers. The information
4857 usually includes the MIME content type. Future browsers may send
4858 other information as well (such as modification date and size). To
4859 retrieve this information, call uploadInfo(). It returns a reference to
4860 an associative array containing all the document headers.
4862 $filename = $query->param('uploaded_file');
4863 $type = $query->uploadInfo($filename)->{'Content-Type'};
4864 unless ($type eq 'text/html') {
4865 die "HTML FILES ONLY!";
4868 If you are using a machine that recognizes "text" and "binary" data
4869 modes, be sure to understand when and how to use them (see the Camel book).
4870 Otherwise you may find that binary files are corrupted during file uploads.
4872 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
4873 B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
4874 recognized. See textfield() for details.
4876 =head2 CREATING A POPUP MENU
4878 print $query->popup_menu('menu_name',
4879 ['eenie','meenie','minie'],
4884 %labels = ('eenie'=>'your first choice',
4885 'meenie'=>'your second choice',
4886 'minie'=>'your third choice');
4887 print $query->popup_menu('menu_name',
4888 ['eenie','meenie','minie'],
4891 -or (named parameter style)-
4893 print $query->popup_menu(-name=>'menu_name',
4894 -values=>['eenie','meenie','minie'],
4898 popup_menu() creates a menu.
4904 The required first argument is the menu's name (-name).
4908 The required second argument (-values) is an array B<reference>
4909 containing the list of menu items in the menu. You can pass the
4910 method an anonymous array, as shown in the example, or a reference to
4911 a named array, such as "\@foo".
4915 The optional third parameter (-default) is the name of the default
4916 menu choice. If not specified, the first item will be the default.
4917 The values of the previous choice will be maintained across queries.
4921 The optional fourth parameter (-labels) is provided for people who
4922 want to use different values for the user-visible label inside the
4923 popup menu nd the value returned to your script. It's a pointer to an
4924 associative array relating menu values to user-visible labels. If you
4925 leave this parameter blank, the menu values will be displayed by
4926 default. (You can also leave a label undefined if you want to).
4930 When the form is processed, the selected value of the popup menu can
4933 $popup_menu_value = $query->param('menu_name');
4935 JAVASCRIPTING: popup_menu() recognizes the following event handlers:
4936 B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
4937 B<-onBlur>. See the textfield() section for details on when these
4938 handlers are called.
4940 =head2 CREATING A SCROLLING LIST
4942 print $query->scrolling_list('list_name',
4943 ['eenie','meenie','minie','moe'],
4944 ['eenie','moe'],5,'true');
4947 print $query->scrolling_list('list_name',
4948 ['eenie','meenie','minie','moe'],
4949 ['eenie','moe'],5,'true',
4954 print $query->scrolling_list(-name=>'list_name',
4955 -values=>['eenie','meenie','minie','moe'],
4956 -default=>['eenie','moe'],
4961 scrolling_list() creates a scrolling list.
4965 =item B<Parameters:>
4969 The first and second arguments are the list name (-name) and values
4970 (-values). As in the popup menu, the second argument should be an
4975 The optional third argument (-default) can be either a reference to a
4976 list containing the values to be selected by default, or can be a
4977 single value to select. If this argument is missing or undefined,
4978 then nothing is selected when the list first appears. In the named
4979 parameter version, you can use the synonym "-defaults" for this
4984 The optional fourth argument is the size of the list (-size).
4988 The optional fifth argument can be set to true to allow multiple
4989 simultaneous selections (-multiple). Otherwise only one selection
4990 will be allowed at a time.
4994 The optional sixth argument is a pointer to an associative array
4995 containing long user-visible labels for the list items (-labels).
4996 If not provided, the values will be displayed.
4998 When this form is processed, all selected list items will be returned as
4999 a list under the parameter name 'list_name'. The values of the
5000 selected items can be retrieved with:
5002 @selected = $query->param('list_name');
5006 JAVASCRIPTING: scrolling_list() recognizes the following event
5007 handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
5008 and B<-onBlur>. See textfield() for the description of when these
5009 handlers are called.
5011 =head2 CREATING A GROUP OF RELATED CHECKBOXES
5013 print $query->checkbox_group(-name=>'group_name',
5014 -values=>['eenie','meenie','minie','moe'],
5015 -default=>['eenie','moe'],
5019 print $query->checkbox_group('group_name',
5020 ['eenie','meenie','minie','moe'],
5021 ['eenie','moe'],'true',\%labels);
5023 HTML3-COMPATIBLE BROWSERS ONLY:
5025 print $query->checkbox_group(-name=>'group_name',
5026 -values=>['eenie','meenie','minie','moe'],
5027 -rows=2,-columns=>2);
5030 checkbox_group() creates a list of checkboxes that are related
5035 =item B<Parameters:>
5039 The first and second arguments are the checkbox name and values,
5040 respectively (-name and -values). As in the popup menu, the second
5041 argument should be an array reference. These values are used for the
5042 user-readable labels printed next to the checkboxes as well as for the
5043 values passed to your script in the query string.
5047 The optional third argument (-default) can be either a reference to a
5048 list containing the values to be checked by default, or can be a
5049 single value to checked. If this argument is missing or undefined,
5050 then nothing is selected when the list first appears.
5054 The optional fourth argument (-linebreak) can be set to true to place
5055 line breaks between the checkboxes so that they appear as a vertical
5056 list. Otherwise, they will be strung together on a horizontal line.
5060 The optional fifth argument is a pointer to an associative array
5061 relating the checkbox values to the user-visible labels that will
5062 be printed next to them (-labels). If not provided, the values will
5063 be used as the default.
5067 B<HTML3-compatible browsers> (such as Netscape) can take advantage of
5068 the optional parameters B<-rows>, and B<-columns>. These parameters
5069 cause checkbox_group() to return an HTML3 compatible table containing
5070 the checkbox group formatted with the specified number of rows and
5071 columns. You can provide just the -columns parameter if you wish;
5072 checkbox_group will calculate the correct number of rows for you.
5074 To include row and column headings in the returned table, you
5075 can use the B<-rowheaders> and B<-colheaders> parameters. Both
5076 of these accept a pointer to an array of headings to use.
5077 The headings are just decorative. They don't reorganize the
5078 interpretation of the checkboxes -- they're still a single named
5083 When the form is processed, all checked boxes will be returned as
5084 a list under the parameter name 'group_name'. The values of the
5085 "on" checkboxes can be retrieved with:
5087 @turned_on = $query->param('group_name');
5089 The value returned by checkbox_group() is actually an array of button
5090 elements. You can capture them and use them within tables, lists,
5091 or in other creative ways:
5093 @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
5094 &use_in_creative_way(@h);
5096 JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
5097 parameter. This specifies a JavaScript code fragment or
5098 function call to be executed every time the user clicks on
5099 any of the buttons in the group. You can retrieve the identity
5100 of the particular button clicked on using the "this" variable.
5102 =head2 CREATING A STANDALONE CHECKBOX
5104 print $query->checkbox(-name=>'checkbox_name',
5105 -checked=>'checked',
5107 -label=>'CLICK ME');
5111 print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
5113 checkbox() is used to create an isolated checkbox that isn't logically
5114 related to any others.
5118 =item B<Parameters:>
5122 The first parameter is the required name for the checkbox (-name). It
5123 will also be used for the user-readable label printed next to the
5128 The optional second parameter (-checked) specifies that the checkbox
5129 is turned on by default. Synonyms are -selected and -on.
5133 The optional third parameter (-value) specifies the value of the
5134 checkbox when it is checked. If not provided, the word "on" is
5139 The optional fourth parameter (-label) is the user-readable label to
5140 be attached to the checkbox. If not provided, the checkbox name is
5145 The value of the checkbox can be retrieved using:
5147 $turned_on = $query->param('checkbox_name');
5149 JAVASCRIPTING: checkbox() recognizes the B<-onClick>
5150 parameter. See checkbox_group() for further details.
5152 =head2 CREATING A RADIO BUTTON GROUP
5154 print $query->radio_group(-name=>'group_name',
5155 -values=>['eenie','meenie','minie'],
5162 print $query->radio_group('group_name',['eenie','meenie','minie'],
5163 'meenie','true',\%labels);
5166 HTML3-COMPATIBLE BROWSERS ONLY:
5168 print $query->radio_group(-name=>'group_name',
5169 -values=>['eenie','meenie','minie','moe'],
5170 -rows=2,-columns=>2);
5172 radio_group() creates a set of logically-related radio buttons
5173 (turning one member of the group on turns the others off)
5177 =item B<Parameters:>
5181 The first argument is the name of the group and is required (-name).
5185 The second argument (-values) is the list of values for the radio
5186 buttons. The values and the labels that appear on the page are
5187 identical. Pass an array I<reference> in the second argument, either
5188 using an anonymous array, as shown, or by referencing a named array as
5193 The optional third parameter (-default) is the name of the default
5194 button to turn on. If not specified, the first item will be the
5195 default. You can provide a nonexistent button name, such as "-" to
5196 start up with no buttons selected.
5200 The optional fourth parameter (-linebreak) can be set to 'true' to put
5201 line breaks between the buttons, creating a vertical list.
5205 The optional fifth parameter (-labels) is a pointer to an associative
5206 array relating the radio button values to user-visible labels to be
5207 used in the display. If not provided, the values themselves are
5212 B<HTML3-compatible browsers> (such as Netscape) can take advantage
5214 parameters B<-rows>, and B<-columns>. These parameters cause
5215 radio_group() to return an HTML3 compatible table containing
5216 the radio group formatted with the specified number of rows
5217 and columns. You can provide just the -columns parameter if you
5218 wish; radio_group will calculate the correct number of rows
5221 To include row and column headings in the returned table, you
5222 can use the B<-rowheader> and B<-colheader> parameters. Both
5223 of these accept a pointer to an array of headings to use.
5224 The headings are just decorative. They don't reorganize the
5225 interpretation of the radio buttons -- they're still a single named
5230 When the form is processed, the selected radio button can
5233 $which_radio_button = $query->param('group_name');
5235 The value returned by radio_group() is actually an array of button
5236 elements. You can capture them and use them within tables, lists,
5237 or in other creative ways:
5239 @h = $query->radio_group(-name=>'group_name',-values=>\@values);
5240 &use_in_creative_way(@h);
5242 =head2 CREATING A SUBMIT BUTTON
5244 print $query->submit(-name=>'button_name',
5249 print $query->submit('button_name','value');
5251 submit() will create the query submission button. Every form
5252 should have one of these.
5256 =item B<Parameters:>
5260 The first argument (-name) is optional. You can give the button a
5261 name if you have several submission buttons in your form and you want
5262 to distinguish between them. The name will also be used as the
5263 user-visible label. Be aware that a few older browsers don't deal with this correctly and
5264 B<never> send back a value from a button.
5268 The second argument (-value) is also optional. This gives the button
5269 a value that will be passed to your script in the query string.
5273 You can figure out which button was pressed by using different
5274 values for each one:
5276 $which_one = $query->param('button_name');
5278 JAVASCRIPTING: radio_group() recognizes the B<-onClick>
5279 parameter. See checkbox_group() for further details.
5281 =head2 CREATING A RESET BUTTON
5285 reset() creates the "reset" button. Note that it restores the
5286 form to its value from the last time the script was called,
5287 NOT necessarily to the defaults.
5289 Note that this conflicts with the Perl reset() built-in. Use
5290 CORE::reset() to get the original reset function.
5292 =head2 CREATING A DEFAULT BUTTON
5294 print $query->defaults('button_label')
5296 defaults() creates a button that, when invoked, will cause the
5297 form to be completely reset to its defaults, wiping out all the
5298 changes the user ever made.
5300 =head2 CREATING A HIDDEN FIELD
5302 print $query->hidden(-name=>'hidden_name',
5303 -default=>['value1','value2'...]);
5307 print $query->hidden('hidden_name','value1','value2'...);
5309 hidden() produces a text field that can't be seen by the user. It
5310 is useful for passing state variable information from one invocation
5311 of the script to the next.
5315 =item B<Parameters:>
5319 The first argument is required and specifies the name of this
5324 The second argument is also required and specifies its value
5325 (-default). In the named parameter style of calling, you can provide
5326 a single value here or a reference to a whole list
5330 Fetch the value of a hidden field this way:
5332 $hidden_value = $query->param('hidden_name');
5334 Note, that just like all the other form elements, the value of a
5335 hidden field is "sticky". If you want to replace a hidden field with
5336 some other values after the script has been called once you'll have to
5339 $query->param('hidden_name','new','values','here');
5341 =head2 CREATING A CLICKABLE IMAGE BUTTON
5343 print $query->image_button(-name=>'button_name',
5344 -src=>'/source/URL',
5349 print $query->image_button('button_name','/source/URL','MIDDLE');
5351 image_button() produces a clickable image. When it's clicked on the
5352 position of the click is returned to your script as "button_name.x"
5353 and "button_name.y", where "button_name" is the name you've assigned
5356 JAVASCRIPTING: image_button() recognizes the B<-onClick>
5357 parameter. See checkbox_group() for further details.
5361 =item B<Parameters:>
5365 The first argument (-name) is required and specifies the name of this
5370 The second argument (-src) is also required and specifies the URL
5373 The third option (-align, optional) is an alignment type, and may be
5374 TOP, BOTTOM or MIDDLE
5378 Fetch the value of the button this way:
5379 $x = $query->param('button_name.x');
5380 $y = $query->param('button_name.y');
5382 =head2 CREATING A JAVASCRIPT ACTION BUTTON
5384 print $query->button(-name=>'button_name',
5385 -value=>'user visible label',
5386 -onClick=>"do_something()");
5390 print $query->button('button_name',"do_something()");
5392 button() produces a button that is compatible with Netscape 2.0's
5393 JavaScript. When it's pressed the fragment of JavaScript code
5394 pointed to by the B<-onClick> parameter will be executed. On
5395 non-Netscape browsers this form element will probably not even
5400 Netscape browsers versions 1.1 and higher, and all versions of
5401 Internet Explorer, support a so-called "cookie" designed to help
5402 maintain state within a browser session. CGI.pm has several methods
5403 that support cookies.
5405 A cookie is a name=value pair much like the named parameters in a CGI
5406 query string. CGI scripts create one or more cookies and send
5407 them to the browser in the HTTP header. The browser maintains a list
5408 of cookies that belong to a particular Web server, and returns them
5409 to the CGI script during subsequent interactions.
5411 In addition to the required name=value pair, each cookie has several
5412 optional attributes:
5416 =item 1. an expiration time
5418 This is a time/date string (in a special GMT format) that indicates
5419 when a cookie expires. The cookie will be saved and returned to your
5420 script until this expiration date is reached if the user exits
5421 the browser and restarts it. If an expiration date isn't specified, the cookie
5422 will remain active until the user quits the browser.
5426 This is a partial or complete domain name for which the cookie is
5427 valid. The browser will return the cookie to any host that matches
5428 the partial domain name. For example, if you specify a domain name
5429 of ".capricorn.com", then the browser will return the cookie to
5430 Web servers running on any of the machines "www.capricorn.com",
5431 "www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
5432 must contain at least two periods to prevent attempts to match
5433 on top level domains like ".edu". If no domain is specified, then
5434 the browser will only return the cookie to servers on the host the
5435 cookie originated from.
5439 If you provide a cookie path attribute, the browser will check it
5440 against your script's URL before returning the cookie. For example,
5441 if you specify the path "/cgi-bin", then the cookie will be returned
5442 to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
5443 and "/cgi-bin/customer_service/complain.pl", but not to the script
5444 "/cgi-private/site_admin.pl". By default, path is set to "/", which
5445 causes the cookie to be sent to any CGI script on your site.
5447 =item 4. a "secure" flag
5449 If the "secure" attribute is set, the cookie will only be sent to your
5450 script if the CGI request is occurring on a secure channel, such as SSL.
5454 The interface to HTTP cookies is the B<cookie()> method:
5456 $cookie = $query->cookie(-name=>'sessionID',
5459 -path=>'/cgi-bin/database',
5460 -domain=>'.capricorn.org',
5462 print $query->header(-cookie=>$cookie);
5464 B<cookie()> creates a new cookie. Its parameters include:
5470 The name of the cookie (required). This can be any string at all.
5471 Although browsers limit their cookie names to non-whitespace
5472 alphanumeric characters, CGI.pm removes this restriction by escaping
5473 and unescaping cookies behind the scenes.
5477 The value of the cookie. This can be any scalar value,
5478 array reference, or even associative array reference. For example,
5479 you can store an entire associative array into a cookie this way:
5481 $cookie=$query->cookie(-name=>'family information',
5482 -value=>\%childrens_ages);
5486 The optional partial path for which this cookie will be valid, as described
5491 The optional partial domain for which this cookie will be valid, as described
5496 The optional expiration date for this cookie. The format is as described
5497 in the section on the B<header()> method:
5499 "+1h" one hour from now
5503 If set to true, this cookie will only be used within a secure
5508 The cookie created by cookie() must be incorporated into the HTTP
5509 header within the string returned by the header() method:
5511 print $query->header(-cookie=>$my_cookie);
5513 To create multiple cookies, give header() an array reference:
5515 $cookie1 = $query->cookie(-name=>'riddle_name',
5516 -value=>"The Sphynx's Question");
5517 $cookie2 = $query->cookie(-name=>'answers',
5519 print $query->header(-cookie=>[$cookie1,$cookie2]);
5521 To retrieve a cookie, request it by name by calling cookie()
5522 method without the B<-value> parameter:
5526 %answers = $query->cookie(-name=>'answers');
5527 # $query->cookie('answers') will work too!
5529 The cookie and CGI namespaces are separate. If you have a parameter
5530 named 'answers' and a cookie named 'answers', the values retrieved by
5531 param() and cookie() are independent of each other. However, it's
5532 simple to turn a CGI parameter into a cookie, and vice-versa:
5534 # turn a CGI parameter into a cookie
5535 $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
5537 $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
5539 See the B<cookie.cgi> example script for some ideas on how to use
5540 cookies effectively.
5542 =head1 WORKING WITH FRAMES
5544 It's possible for CGI.pm scripts to write into several browser panels
5545 and windows using the HTML 4 frame mechanism. There are three
5546 techniques for defining new frames programmatically:
5550 =item 1. Create a <Frameset> document
5552 After writing out the HTTP header, instead of creating a standard
5553 HTML document using the start_html() call, create a <FRAMESET>
5554 document that defines the frames on the page. Specify your script(s)
5555 (with appropriate parameters) as the SRC for each of the frames.
5557 There is no specific support for creating <FRAMESET> sections
5558 in CGI.pm, but the HTML is very simple to write. See the frame
5559 documentation in Netscape's home pages for details
5561 http://home.netscape.com/assist/net_sites/frames.html
5563 =item 2. Specify the destination for the document in the HTTP header
5565 You may provide a B<-target> parameter to the header() method:
5567 print $q->header(-target=>'ResultsWindow');
5569 This will tell the browser to load the output of your script into the
5570 frame named "ResultsWindow". If a frame of that name doesn't already
5571 exist, the browser will pop up a new window and load your script's
5572 document into that. There are a number of magic names that you can
5573 use for targets. See the frame documents on Netscape's home pages for
5576 =item 3. Specify the destination for the document in the <FORM> tag
5578 You can specify the frame to load in the FORM tag itself. With
5579 CGI.pm it looks like this:
5581 print $q->startform(-target=>'ResultsWindow');
5583 When your script is reinvoked by the form, its output will be loaded
5584 into the frame named "ResultsWindow". If one doesn't already exist
5585 a new window will be created.
5589 The script "frameset.cgi" in the examples directory shows one way to
5590 create pages in which the fill-out form and the response live in
5591 side-by-side frames.
5593 =head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
5595 CGI.pm has limited support for HTML3's cascading style sheets (css).
5596 To incorporate a stylesheet into your document, pass the
5597 start_html() method a B<-style> parameter. The value of this
5598 parameter may be a scalar, in which case it is incorporated directly
5599 into a <STYLE> section, or it may be a hash reference. In the latter
5600 case you should provide the hash with one or more of B<-src> or
5601 B<-code>. B<-src> points to a URL where an externally-defined
5602 stylesheet can be found. B<-code> points to a scalar value to be
5603 incorporated into a <STYLE> section. Style definitions in B<-code>
5604 override similarly-named ones in B<-src>, hence the name "cascading."
5606 You may also specify the type of the stylesheet by adding the optional
5607 B<-type> parameter to the hash pointed to by B<-style>. If not
5608 specified, the style defaults to 'text/css'.
5610 To refer to a style within the body of your document, add the
5611 B<-class> parameter to any HTML element:
5613 print h1({-class=>'Fancy'},'Welcome to the Party');
5615 Or define styles on the fly with the B<-style> parameter:
5617 print h1({-style=>'Color: red;'},'Welcome to Hell');
5619 You may also use the new B<span()> element to apply a style to a
5622 print span({-style=>'Color: red;'},
5623 h1('Welcome to Hell'),
5624 "Where did that handbasket get to?"
5627 Note that you must import the ":html3" definitions to have the
5628 B<span()> method available. Here's a quick and dirty example of using
5629 CSS's. See the CSS specification at
5630 http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
5632 use CGI qw/:standard :html3/;
5634 #here's a stylesheet incorporated directly into the page
5644 font-family: sans-serif;
5650 print start_html( -title=>'CGI with Style',
5651 -style=>{-src=>'http://www.capricorn.com/style/st1.css',
5654 print h1('CGI with Style'),
5656 "Better read the cascading style sheet spec before playing with this!"),
5657 span({-style=>'color: magenta'},
5658 "Look Mom, no hands!",
5666 If you are running the script
5667 from the command line or in the perl debugger, you can pass the script
5668 a list of keywords or parameter=value pairs on the command line or
5669 from standard input (you don't have to worry about tricking your
5670 script into reading from environment variables).
5671 You can pass keywords like this:
5673 your_script.pl keyword1 keyword2 keyword3
5677 your_script.pl keyword1+keyword2+keyword3
5681 your_script.pl name1=value1 name2=value2
5685 your_script.pl name1=value1&name2=value2
5687 or even as newline-delimited parameters on standard input.
5689 When debugging, you can use quotes and backslashes to escape
5690 characters in the familiar shell manner, letting you place
5691 spaces and other funny characters in your parameter=value
5694 your_script.pl "name1='I am a long value'" "name2=two\ words"
5696 =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
5698 The dump() method produces a string consisting of all the query's
5699 name/value pairs formatted nicely as a nested list. This is useful
5700 for debugging purposes:
5705 Produces something that looks like:
5719 As a shortcut, you can interpolate the entire CGI object into a string
5720 and it will be replaced with the a nice HTML dump shown above:
5723 print "<H2>Current Values</H2> $query\n";
5725 =head1 FETCHING ENVIRONMENT VARIABLES
5727 Some of the more useful environment variables can be fetched
5728 through this interface. The methods are as follows:
5734 Return a list of MIME types that the remote browser accepts. If you
5735 give this method a single argument corresponding to a MIME type, as in
5736 $query->Accept('text/html'), it will return a floating point value
5737 corresponding to the browser's preference for this type from 0.0
5738 (don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
5739 list are handled correctly.
5741 Note that the capitalization changed between version 2.43 and 2.44 in
5742 order to avoid conflict with Perl's accept() function.
5744 =item B<raw_cookie()>
5746 Returns the HTTP_COOKIE variable, an HTTP extension implemented by
5747 Netscape browsers version 1.1 and higher, and all versions of Internet
5748 Explorer. Cookies have a special format, and this method call just
5749 returns the raw form (?cookie dough). See cookie() for ways of
5750 setting and retrieving cooked cookies.
5752 Called with no parameters, raw_cookie() returns the packed cookie
5753 structure. You can separate it into individual cookies by splitting
5754 on the character sequence "; ". Called with the name of a cookie,
5755 retrieves the B<unescaped> form of the cookie. You can use the
5756 regular cookie() method to get the names, or use the raw_fetch()
5757 method from the CGI::Cookie module.
5759 =item B<user_agent()>
5761 Returns the HTTP_USER_AGENT variable. If you give
5762 this method a single argument, it will attempt to
5763 pattern match on it, allowing you to do something
5764 like $query->user_agent(netscape);
5766 =item B<path_info()>
5768 Returns additional path information from the script URL.
5769 E.G. fetching /cgi-bin/your_script/additional/stuff will
5770 result in $query->path_info() returning
5773 NOTE: The Microsoft Internet Information Server
5774 is broken with respect to additional path information. If
5775 you use the Perl DLL library, the IIS server will attempt to
5776 execute the additional path information as a Perl script.
5777 If you use the ordinary file associations mapping, the
5778 path information will be present in the environment,
5779 but incorrect. The best thing to do is to avoid using additional
5780 path information in CGI scripts destined for use with IIS.
5782 =item B<path_translated()>
5784 As per path_info() but returns the additional
5785 path information translated into a physical path, e.g.
5786 "/usr/local/etc/httpd/htdocs/additional/stuff".
5788 The Microsoft IIS is broken with respect to the translated
5791 =item B<remote_host()>
5793 Returns either the remote host name or IP address.
5794 if the former is unavailable.
5796 =item B<script_name()>
5797 Return the script name as a partial URL, for self-refering
5802 Return the URL of the page the browser was viewing
5803 prior to fetching your script. Not available for all
5806 =item B<auth_type ()>
5808 Return the authorization/verification method in use for this
5811 =item B<server_name ()>
5813 Returns the name of the server, usually the machine's host
5816 =item B<virtual_host ()>
5818 When using virtual hosts, returns the name of the host that
5819 the browser attempted to contact
5821 =item B<server_software ()>
5823 Returns the server software and version number.
5825 =item B<remote_user ()>
5827 Return the authorization/verification name used for user
5828 verification, if this script is protected.
5830 =item B<user_name ()>
5832 Attempt to obtain the remote user's name, using a variety of different
5833 techniques. This only works with older browsers such as Mosaic.
5834 Newer browsers do not report the user name for privacy reasons!
5836 =item B<request_method()>
5838 Returns the method used to access your script, usually
5839 one of 'POST', 'GET' or 'HEAD'.
5843 =head1 USING NPH SCRIPTS
5845 NPH, or "no-parsed-header", scripts bypass the server completely by
5846 sending the complete HTTP header directly to the browser. This has
5847 slight performance benefits, but is of most use for taking advantage
5848 of HTTP extensions that are not directly supported by your server,
5849 such as server push and PICS headers.
5851 Servers use a variety of conventions for designating CGI scripts as
5852 NPH. Many Unix servers look at the beginning of the script's name for
5853 the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
5854 Internet Information Server, in contrast, try to decide whether a
5855 program is an NPH script by examining the first line of script output.
5858 CGI.pm supports NPH scripts with a special NPH mode. When in this
5859 mode, CGI.pm will output the necessary extra header information when
5860 the header() and redirect() methods are
5863 The Microsoft Internet Information Server requires NPH mode. As of version
5864 2.30, CGI.pm will automatically detect when the script is running under IIS
5865 and put itself into this mode. You do not need to do this manually, although
5866 it won't hurt anything if you do.
5868 There are a number of ways to put CGI.pm into NPH mode:
5872 =item In the B<use> statement
5874 Simply add the "-nph" pragmato the list of symbols to be imported into
5877 use CGI qw(:standard -nph)
5879 =item By calling the B<nph()> method:
5881 Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
5885 =item By using B<-nph> parameters in the B<header()> and B<redirect()> statements:
5887 print $q->header(-nph=>1);
5893 CGI.pm provides three simple functions for producing multipart
5894 documents of the type needed to implement server push. These
5895 functions were graciously provided by Ed Jordan <ed@fidalgo.net>. To
5896 import these into your namespace, you must import the ":push" set.
5897 You are also advised to put the script into NPH mode and to set $| to
5898 1 to avoid buffering problems.
5900 Here is a simple script that demonstrates server push:
5902 #!/usr/local/bin/perl
5903 use CGI qw/:push -nph/;
5905 print multipart_init(-boundary=>'----------------here we go!');
5907 print multipart_start(-type=>'text/plain'),
5908 "The current time is ",scalar(localtime),"\n",
5913 This script initializes server push by calling B<multipart_init()>.
5914 It then enters an infinite loop in which it begins a new multipart
5915 section by calling B<multipart_start()>, prints the current local time,
5916 and ends a multipart section with B<multipart_end()>. It then sleeps
5917 a second, and begins again.
5921 =item multipart_init()
5923 multipart_init(-boundary=>$boundary);
5925 Initialize the multipart system. The -boundary argument specifies
5926 what MIME boundary string to use to separate parts of the document.
5927 If not provided, CGI.pm chooses a reasonable boundary for you.
5929 =item multipart_start()
5931 multipart_start(-type=>$type)
5933 Start a new part of the multipart document using the specified MIME
5934 type. If not specified, text/html is assumed.
5936 =item multipart_end()
5940 End a part. You must remember to call multipart_end() once for each
5945 Users interested in server push applications should also have a look
5946 at the CGI::Push module.
5948 =head1 Avoiding Denial of Service Attacks
5950 A potential problem with CGI.pm is that, by default, it attempts to
5951 process form POSTings no matter how large they are. A wily hacker
5952 could attack your site by sending a CGI script a huge POST of many
5953 megabytes. CGI.pm will attempt to read the entire POST into a
5954 variable, growing hugely in size until it runs out of memory. While
5955 the script attempts to allocate the memory the system may slow down
5956 dramatically. This is a form of denial of service attack.
5958 Another possible attack is for the remote user to force CGI.pm to
5959 accept a huge file upload. CGI.pm will accept the upload and store it
5960 in a temporary directory even if your script doesn't expect to receive
5961 an uploaded file. CGI.pm will delete the file automatically when it
5962 terminates, but in the meantime the remote user may have filled up the
5963 server's disk space, causing problems for other programs.
5965 The best way to avoid denial of service attacks is to limit the amount
5966 of memory, CPU time and disk space that CGI scripts can use. Some Web
5967 servers come with built-in facilities to accomplish this. In other
5968 cases, you can use the shell I<limit> or I<ulimit>
5969 commands to put ceilings on CGI resource usage.
5972 CGI.pm also has some simple built-in protections against denial of
5973 service attacks, but you must activate them before you can use them.
5974 These take the form of two global variables in the CGI name space:
5978 =item B<$CGI::POST_MAX>
5980 If set to a non-negative integer, this variable puts a ceiling
5981 on the size of POSTings, in bytes. If CGI.pm detects a POST
5982 that is greater than the ceiling, it will immediately exit with an error
5983 message. This value will affect both ordinary POSTs and
5984 multipart POSTs, meaning that it limits the maximum size of file
5985 uploads as well. You should set this to a reasonably high
5986 value, such as 1 megabyte.
5988 =item B<$CGI::DISABLE_UPLOADS>
5990 If set to a non-zero value, this will disable file uploads
5991 completely. Other fill-out form values will work as usual.
5995 You can use these variables in either of two ways.
5999 =item B<1. On a script-by-script basis>
6001 Set the variable at the top of the script, right after the "use" statement:
6003 use CGI qw/:standard/;
6004 use CGI::Carp 'fatalsToBrowser';
6005 $CGI::POST_MAX=1024 * 100; # max 100K posts
6006 $CGI::DISABLE_UPLOADS = 1; # no uploads
6008 =item B<2. Globally for all scripts>
6010 Open up CGI.pm, find the definitions for $POST_MAX and
6011 $DISABLE_UPLOADS, and set them to the desired values. You'll
6012 find them towards the top of the file in a subroutine named
6013 initialize_globals().
6017 Since an attempt to send a POST larger than $POST_MAX bytes
6018 will cause a fatal error, you might want to use CGI::Carp to echo the
6019 fatal error message to the browser window as shown in the example
6020 above. Otherwise the remote user will see only a generic "Internal
6021 Server" error message. See the L<CGI::Carp> manual page for more
6024 =head1 COMPATIBILITY WITH CGI-LIB.PL
6026 To make it easier to port existing programs that use cgi-lib.pl
6027 the compatibility routine "ReadParse" is provided. Porting is
6031 require "cgi-lib.pl";
6033 print "The value of the antique is $in{antique}.\n";
6038 print "The value of the antique is $in{antique}.\n";
6040 CGI.pm's ReadParse() routine creates a tied variable named %in,
6041 which can be accessed to obtain the query variables. Like
6042 ReadParse, you can also provide your own variable. Infrequently
6043 used features of ReadParse, such as the creation of @in and $in
6044 variables, are not supported.
6046 Once you use ReadParse, you can retrieve the query object itself
6050 print $q->textfield(-name=>'wow',
6051 -value=>'does this really work?');
6053 This allows you to start using the more interesting features
6054 of CGI.pm without rewriting your old scripts from scratch.
6056 =head1 AUTHOR INFORMATION
6058 Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
6060 This library is free software; you can redistribute it and/or modify
6061 it under the same terms as Perl itself.
6063 Address bug reports and comments to: lstein@cshl.org. When sending
6064 bug reports, please provide the version of CGI.pm, the version of
6065 Perl, the name and version of your Web server, and the name and
6066 version of the operating system you are using. If the problem is even
6067 remotely browser dependent, please provide information about the
6068 affected browers as well.
6072 Thanks very much to:
6076 =item Matt Heffron (heffron@falstaff.css.beckman.com)
6078 =item James Taylor (james.taylor@srs.gov)
6080 =item Scott Anguish <sanguish@digifix.com>
6082 =item Mike Jewell (mlj3u@virginia.edu)
6084 =item Timothy Shimmin (tes@kbs.citri.edu.au)
6086 =item Joergen Haegg (jh@axis.se)
6088 =item Laurent Delfosse (delfosse@delfosse.com)
6090 =item Richard Resnick (applepi1@aol.com)
6092 =item Craig Bishop (csb@barwonwater.vic.gov.au)
6094 =item Tony Curtis (tc@vcpc.univie.ac.at)
6096 =item Tim Bunce (Tim.Bunce@ig.co.uk)
6098 =item Tom Christiansen (tchrist@convex.com)
6100 =item Andreas Koenig (k@franz.ww.TU-Berlin.DE)
6102 =item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au)
6104 =item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu)
6106 =item Stephen Dahmen (joyfire@inxpress.net)
6108 =item Ed Jordan (ed@fidalgo.net)
6110 =item David Alan Pisoni (david@cnation.com)
6112 =item Doug MacEachern (dougm@opengroup.org)
6114 =item Robin Houston (robin@oneworld.org)
6116 =item ...and many many more...
6118 for suggestions and bug fixes.
6122 =head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
6125 #!/usr/local/bin/perl
6131 print $query->header;
6132 print $query->start_html("Example CGI.pm Form");
6133 print "<H1> Example CGI.pm Form</H1>\n";
6134 &print_prompt($query);
6137 print $query->end_html;
6142 print $query->startform;
6143 print "<EM>What's your name?</EM><BR>";
6144 print $query->textfield('name');
6145 print $query->checkbox('Not my real name');
6147 print "<P><EM>Where can you find English Sparrows?</EM><BR>";
6148 print $query->checkbox_group(
6149 -name=>'Sparrow locations',
6150 -values=>[England,France,Spain,Asia,Hoboken],
6152 -defaults=>[England,Asia]);
6154 print "<P><EM>How far can they fly?</EM><BR>",
6155 $query->radio_group(
6157 -values=>['10 ft','1 mile','10 miles','real far'],
6158 -default=>'1 mile');
6160 print "<P><EM>What's your favorite color?</EM> ";
6161 print $query->popup_menu(-name=>'Color',
6162 -values=>['black','brown','red','yellow'],
6165 print $query->hidden('Reference','Monty Python and the Holy Grail');
6167 print "<P><EM>What have you got there?</EM><BR>";
6168 print $query->scrolling_list(
6169 -name=>'possessions',
6170 -values=>['A Coconut','A Grail','An Icon',
6171 'A Sword','A Ticket'],
6175 print "<P><EM>Any parting comments?</EM><BR>";
6176 print $query->textarea(-name=>'Comments',
6180 print "<P>",$query->Reset;
6181 print $query->submit('Action','Shout');
6182 print $query->submit('Action','Scream');
6183 print $query->endform;
6191 print "<H2>Here are the current settings in this form</H2>";
6193 foreach $key ($query->param) {
6194 print "<STRONG>$key</STRONG> -> ";
6195 @values = $query->param($key);
6196 print join(", ",@values),"<BR>\n";
6203 <ADDRESS>Lincoln D. Stein</ADDRESS><BR>
6204 <A HREF="/">Home Page</A>
6210 This module has grown large and monolithic. Furthermore it's doing many
6211 things, such as handling URLs, parsing CGI input, writing HTML, etc., that
6212 are also done in the LWP modules. It should be discarded in favor of
6213 the CGI::* modules, but somehow I continue to work on it.
6215 Note that the code is truly contorted in order to avoid spurious
6216 warnings when programs are run with the B<-w> switch.
6220 L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
6221 L<CGI::Base>, L<CGI::Form>, L<CGI::Push>, L<CGI::Fast>,