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.30 2000/03/28 21:31:40 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';
26 use CGI::Util qw(rearrange make_attributes unescape escape expires);
28 # >>>>> Here are some globals that you might want to adjust <<<<<<
29 sub initialize_globals {
30 # Set this to 1 to enable copious autoloader debugging messages
33 # Change this to the preferred DTD to print in start_html()
34 # or use default_dtd('text of DTD to use');
35 $DEFAULT_DTD = [ '-//W3C//DTD HTML 4.01 Transitional//EN',
36 'http://www.w3.org/TR/html4/loose.dtd' ] ;
38 # Set this to 1 to enable NOSTICKY scripts
40 # 1) use CGI qw(-nosticky)
41 # 2) $CGI::nosticky(1)
44 # Set this to 1 to enable NPH scripts
48 # 3) print header(-nph=>1)
51 # Set this to 1 to enable debugging from @ARGV
52 # Set to 2 to enable debugging from STDIN
55 # Set this to 1 to make the temporary files created
56 # during file uploads safe from prying eyes
58 # 1) use CGI qw(:private_tempfiles)
59 # 2) CGI::private_tempfiles(1);
60 $PRIVATE_TEMPFILES = 0;
62 # Set this to a positive value to limit the size of a POSTing
63 # to a certain number of bytes:
66 # Change this to 1 to disable uploads entirely:
69 # Automatically determined -- don't change
72 # Change this to 1 to suppress redundant HTTP headers
75 # separate the name=value pairs by semicolons rather than ampersands
76 $USE_PARAM_SEMICOLONS = 1;
78 # Other globals that you shouldn't worry about.
84 # prevent complaints by mod_perl
88 # ------------------ START OF THE LIBRARY ------------
93 # FIGURE OUT THE OS WE'RE RUNNING UNDER
94 # Some systems support the $^O variable. If not
95 # available then require() the Config library
99 $OS = $Config::Config{'osname'};
104 } elsif ($OS=~/vms/i) {
106 } elsif ($OS=~/bsdos/i) {
108 } elsif ($OS=~/dos/i) {
110 } elsif ($OS=~/^MacOS$/i) {
112 } elsif ($OS=~/os2/i) {
118 # Some OS logic. Binary mode enabled on DOS, NT and VMS
119 $needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin)/;
121 # This is the default class for the CGI object to use when all else fails.
122 $DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
124 # This is where to look for autoloaded routines.
125 $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
127 # The path separator is a slash, backslash or semicolon, depending
130 UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
133 # This no longer seems to be necessary
134 # Turn on NPH scripts by default when running under IIS server!
135 # $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
136 $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
138 # Turn on special checking for Doug MacEachern's modperl
139 if (exists $ENV{'GATEWAY_INTERFACE'}
141 ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//))
146 # Turn on special checking for ActiveState's PerlEx
147 $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
149 # Define the CRLF sequence. I can't use a simple "\r\n" because the meaning
150 # of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF
151 # and sometimes CR). The most popular VMS web server
152 # doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't
153 # use ASCII, so \015\012 means something different. I find this all
155 $EBCDIC = "\t" ne "\011";
164 if ($needs_binmode) {
165 $CGI::DefaultClass->binmode(main::STDOUT);
166 $CGI::DefaultClass->binmode(main::STDIN);
167 $CGI::DefaultClass->binmode(main::STDERR);
171 ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em
172 tt u i b blockquote pre img a address cite samp dfn html head
173 base body Link nextid title meta kbd start_html end_html
174 input Select option comment charset escapeHTML/],
175 ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
176 embed basefont style span layer ilayer font frameset frame script small big/],
177 ':netscape'=>[qw/blink fontsize center/],
178 ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
179 submit reset defaults radio_group popup_menu button autoEscape
180 scrolling_list image_button start_form end_form startform endform
181 start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
182 ':cgi'=>[qw/param upload path_info path_translated url self_url script_name cookie Dump
183 raw_cookie request_method query_string Accept user_agent remote_host content_type
184 remote_addr referer server_name server_software server_port server_protocol
185 virtual_host remote_ident auth_type http
186 save_parameters restore_parameters param_fetch
187 remote_user user_name header redirect import_names put
188 Delete Delete_all url_param cgi_error/],
189 ':ssl' => [qw/https/],
190 ':imagemap' => [qw/Area Map/],
191 ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/],
192 ':html' => [qw/:html2 :html3 :netscape/],
193 ':standard' => [qw/:html2 :html3 :form :cgi/],
194 ':push' => [qw/multipart_init multipart_start multipart_end/],
195 ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
198 # to import symbols into caller
202 # This causes modules to clash.
206 $self->_setup_symbols(@_);
207 my ($callpack, $callfile, $callline) = caller;
209 # To allow overriding, search through the packages
210 # Till we find one in which the correct subroutine is defined.
211 my @packages = ($self,@{"$self\:\:ISA"});
212 foreach $sym (keys %EXPORT) {
214 my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
215 foreach $pck (@packages) {
216 if (defined(&{"$pck\:\:$sym"})) {
221 *{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
227 $pack->_setup_symbols('-compile',@_);
232 return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
234 return ($tag) unless $EXPORT_TAGS{$tag};
235 foreach (@{$EXPORT_TAGS{$tag}}) {
236 push(@r,&expand_tags($_));
242 # The new routine. This will check the current environment
243 # for an existing query string, and initialize itself, if so.
246 my($class,$initializer) = @_;
248 bless $self,ref $class || $class || $DefaultClass;
249 if ($MOD_PERL && defined Apache->request) {
250 Apache->request->register_cleanup(\&CGI::_reset_globals);
253 $self->_reset_globals if $PERLEX;
254 $self->init($initializer);
258 # We provide a DESTROY method so that the autoloader
259 # doesn't bother trying to find it.
263 # Returns the value(s)of a named parameter.
264 # If invoked in a list context, returns the
265 # entire list. Otherwise returns the first
266 # member of the list.
267 # If name is not provided, return a list of all
268 # the known parameters names available.
269 # If more than one argument is provided, the
270 # second and subsequent arguments are used to
271 # set the value of the parameter.
274 my($self,@p) = self_or_default(@_);
275 return $self->all_parameters unless @p;
276 my($name,$value,@other);
278 # For compatibility between old calling style and use_named_parameters() style,
279 # we have to special case for a single parameter present.
281 ($name,$value,@other) = rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
284 if (substr($p[0],0,1) eq '-') {
285 @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
287 foreach ($value,@other) {
288 push(@values,$_) if defined($_);
291 # If values is provided, then we set it.
293 $self->add_parameter($name);
294 $self->{$name}=[@values];
300 return unless defined($name) && $self->{$name};
301 return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
304 sub self_or_default {
305 return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI');
306 unless (defined($_[0]) &&
307 (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case
309 $Q = $CGI::DefaultClass->new unless defined($Q);
312 return wantarray ? @_ : $Q;
316 local $^W=0; # prevent a warning
317 if (defined($_[0]) &&
318 (substr(ref($_[0]),0,3) eq 'CGI'
319 || UNIVERSAL::isa($_[0],'CGI'))) {
322 return ($DefaultClass,@_);
326 ########################################
327 # THESE METHODS ARE MORE OR LESS PRIVATE
328 # GO TO THE __DATA__ SECTION TO SEE MORE
330 ########################################
332 # Initialize the query object from the environment.
333 # If a parameter list is found, this object will be set
334 # to an associative array in which parameter names are keys
335 # and the values are stored as lists
336 # If a keyword list is found, this method creates a bogus
337 # parameter list with the single parameter 'keywords'.
340 my($self,$initializer) = @_;
341 my($query_string,$meth,$content_length,$fh,@lines) = ('','','','');
344 # if we get called more than once, we want to initialize
345 # ourselves from the original query (which may be gone
346 # if it was read from STDIN originally.)
347 if (@QUERY_PARAM && !defined($initializer)) {
348 foreach (@QUERY_PARAM) {
349 $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
354 $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
355 $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0;
357 $fh = to_filehandle($initializer) if $initializer;
361 # avoid unreasonably large postings
362 if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
363 $self->cgi_error("413 Request entity too large");
367 # Process multipart postings, but only if the initializer is
370 && defined($ENV{'CONTENT_TYPE'})
371 && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
372 && !defined($initializer)
374 my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
375 $self->read_multipart($boundary,$content_length);
379 # If initializer is defined, then read parameters
381 if (defined($initializer)) {
382 if (UNIVERSAL::isa($initializer,'CGI')) {
383 $query_string = $initializer->query_string;
386 if (ref($initializer) && ref($initializer) eq 'HASH') {
387 foreach (keys %$initializer) {
388 $self->param('-name'=>$_,'-value'=>$initializer->{$_});
393 if (defined($fh) && ($fh ne '')) {
399 # massage back into standard format
400 if ("@lines" =~ /=/) {
401 $query_string=join("&",@lines);
403 $query_string=join("+",@lines);
408 # last chance -- treat it as a string
409 $initializer = $$initializer if ref($initializer) eq 'SCALAR';
410 $query_string = $initializer;
415 # If method is GET or HEAD, fetch the query from
417 if ($meth=~/^(GET|HEAD)$/) {
419 $query_string = Apache->request->args;
421 $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
422 $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'};
427 if ($meth eq 'POST') {
428 $self->read_from_client(\*STDIN,\$query_string,$content_length,0)
429 if $content_length > 0;
430 # Some people want to have their cake and eat it too!
431 # Uncomment this line to have the contents of the query string
432 # APPENDED to the POST data.
433 # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
437 # If $meth is not of GET, POST or HEAD, assume we're being debugged offline.
438 # Check the command line and then the standard input for data.
439 # We use the shellwords package in order to behave the way that
440 # UN*X programmers expect.
441 $query_string = read_from_cmdline() if $DEBUG;
444 # We now have the query string in hand. We do slightly
445 # different things for keyword lists and parameter lists.
446 if (defined $query_string && $query_string) {
447 if ($query_string =~ /[&=;]/) {
448 $self->parse_params($query_string);
450 $self->add_parameter('keywords');
451 $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
455 # Special case. Erase everything if there is a field named
457 if ($self->param('.defaults')) {
461 # Associative array containing our defined fieldnames
462 $self->{'.fieldnames'} = {};
463 foreach ($self->param('.cgifields')) {
464 $self->{'.fieldnames'}->{$_}++;
467 # Clear out our default submission button flag if present
468 $self->delete('.submit');
469 $self->delete('.cgifields');
471 # set charset to the safe ISO-8859-1
472 $self->charset('ISO-8859-1');
473 $self->save_request unless $initializer;
476 # FUNCTIONS TO OVERRIDE:
477 # Turn a string into a filehandle
480 return undef unless $thingy;
481 return $thingy if UNIVERSAL::isa($thingy,'GLOB');
482 return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
485 while (my $package = caller($caller++)) {
486 my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
487 return $tmp if defined(fileno($tmp));
493 # send output to the browser
495 my($self,@p) = self_or_default(@_);
499 # print to standard output (for overriding in mod_perl)
505 # get/set last cgi_error
507 my ($self,$err) = self_or_default(@_);
508 $self->{'.cgi_error'} = $err if defined $err;
509 return $self->{'.cgi_error'};
514 # We're going to play with the package globals now so that if we get called
515 # again, we initialize ourselves in exactly the same way. This allows
516 # us to have several of these objects.
517 @QUERY_PARAM = $self->param; # save list of parameters
518 foreach (@QUERY_PARAM) {
519 next unless defined $_;
520 $QUERY_PARAM{$_}=$self->{$_};
525 my($self,$tosplit) = @_;
526 my(@pairs) = split(/[&;]/,$tosplit);
529 ($param,$value) = split('=',$_,2);
530 $value = '' unless defined $value;
531 $param = unescape($param);
532 $value = unescape($value);
533 $self->add_parameter($param);
534 push (@{$self->{$param}},$value);
540 return unless defined $param;
541 push (@{$self->{'.parameters'}},$param)
542 unless defined($self->{$param});
547 return () unless defined($self) && $self->{'.parameters'};
548 return () unless @{$self->{'.parameters'}};
549 return @{$self->{'.parameters'}};
552 # put a filehandle into binary mode (DOS)
554 CORE::binmode($_[1]);
558 my ($self,$tagname) = @_;
563 (substr(ref(\$_[0]),0,3) eq 'CGI' ||
564 UNIVERSAL::isa(\$_[0],'CGI')));
566 if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
567 my(\@attr) = make_attributes(shift()||undef,1);
568 \$attr = " \@attr" if \@attr;
571 if ($tagname=~/start_(\w+)/i) {
572 $func .= qq! return "<\U$1\E\$attr>";} !;
573 } elsif ($tagname=~/end_(\w+)/i) {
574 $func .= qq! return "<\U/$1\E>"; } !;
577 my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
578 return \$tag unless \@_;
579 my \@result = map { "\$tag\$_\$untag" }
580 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
588 print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
589 my $func = &_compile;
594 my($func) = $AUTOLOAD;
595 my($pack,$func_name);
597 local($1,$2); # this fixes an obscure variable suicide problem.
598 $func=~/(.+)::([^:]+)$/;
599 ($pack,$func_name) = ($1,$2);
600 $pack=~s/::SUPER$//; # fix another obscure problem
601 $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
602 unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
604 my($sub) = \%{"$pack\:\:SUBS"};
606 my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
607 eval "package $pack; $$auto";
609 $$auto = ''; # Free the unneeded storage (but don't undef it!!!)
611 my($code) = $sub->{$func_name};
613 $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
615 (my $base = $func_name) =~ s/^(start_|end_)//i;
616 if ($EXPORT{':any'} ||
619 (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
620 && $EXPORT_OK{$base}) {
621 $code = $CGI::DefaultClass->_make_tag_func($func_name);
624 die "Undefined subroutine $AUTOLOAD\n" unless $code;
625 eval "package $pack; $code";
631 CORE::delete($sub->{$func_name}); #free storage
632 return "$pack\:\:$func_name";
635 sub _reset_globals { initialize_globals(); }
641 $HEADERS_ONCE++, next if /^[:-]unique_headers$/;
642 $NPH++, next if /^[:-]nph$/;
643 $NOSTICKY++, next if /^[:-]nosticky$/;
644 $DEBUG=0, next if /^[:-]no_?[Dd]ebug$/;
645 $DEBUG=2, next if /^[:-][Dd]ebug$/;
646 $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
647 $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
648 $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
649 $EXPORT{$_}++, next if /^[:-]any$/;
650 $compile++, next if /^[:-]compile$/;
652 # This is probably extremely evil code -- to be deleted some day.
653 if (/^[-]autoload$/) {
654 my($pkg) = caller(1);
655 *{"${pkg}::AUTOLOAD"} = sub {
656 my($routine) = $AUTOLOAD;
657 $routine =~ s/^.*::/CGI::/;
663 foreach (&expand_tags($_)) {
664 tr/a-zA-Z0-9_//cd; # don't allow weird function names
668 _compile_all(keys %EXPORT) if $compile;
672 my ($self,$charset) = self_or_default(@_);
673 $self->{'.charset'} = $charset if defined $charset;
677 ###############################################################################
678 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
679 ###############################################################################
680 $AUTOLOADED_ROUTINES = ''; # get rid of -w warning
681 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
685 'URL_ENCODED'=> <<'END_OF_FUNC',
686 sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
689 'MULTIPART' => <<'END_OF_FUNC',
690 sub MULTIPART { 'multipart/form-data'; }
693 'SERVER_PUSH' => <<'END_OF_FUNC',
694 sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
697 'new_MultipartBuffer' => <<'END_OF_FUNC',
698 # Create a new multipart buffer
699 sub new_MultipartBuffer {
700 my($self,$boundary,$length,$filehandle) = @_;
701 return MultipartBuffer->new($self,$boundary,$length,$filehandle);
705 'read_from_client' => <<'END_OF_FUNC',
706 # Read data from a file handle
707 sub read_from_client {
708 my($self, $fh, $buff, $len, $offset) = @_;
709 local $^W=0; # prevent a warning
710 return undef unless defined($fh);
711 return read($fh, $$buff, $len, $offset);
715 'delete' => <<'END_OF_FUNC',
717 # Deletes the named parameter entirely.
720 my($self,$name) = self_or_default(@_);
721 CORE::delete $self->{$name};
722 CORE::delete $self->{'.fieldnames'}->{$name};
723 @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
724 return wantarray ? () : undef;
728 #### Method: import_names
729 # Import all parameters into the given namespace.
730 # Assumes namespace 'Q' if not specified
732 'import_names' => <<'END_OF_FUNC',
734 my($self,$namespace,$delete) = self_or_default(@_);
735 $namespace = 'Q' unless defined($namespace);
736 die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
737 if ($delete || $MOD_PERL || exists $ENV{'FCGI_ROLE'}) {
738 # can anyone find an easier way to do this?
739 foreach (keys %{"${namespace}::"}) {
740 local *symbol = "${namespace}::${_}";
746 my($param,@value,$var);
747 foreach $param ($self->param) {
748 # protect against silly names
749 ($var = $param)=~tr/a-zA-Z0-9_/_/c;
750 $var =~ s/^(?=\d)/_/;
751 local *symbol = "${namespace}::$var";
752 @value = $self->param($param);
759 #### Method: keywords
760 # Keywords acts a bit differently. Calling it in a list context
761 # returns the list of keywords.
762 # Calling it in a scalar context gives you the size of the list.
764 'keywords' => <<'END_OF_FUNC',
766 my($self,@values) = self_or_default(@_);
767 # If values is provided, then we set it.
768 $self->{'keywords'}=[@values] if @values;
769 my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
774 # These are some tie() interfaces for compatibility
775 # with Steve Brenner's cgi-lib.pl routines
776 'Vars' => <<'END_OF_FUNC',
781 return %in if wantarray;
786 # These are some tie() interfaces for compatibility
787 # with Steve Brenner's cgi-lib.pl routines
788 'ReadParse' => <<'END_OF_FUNC',
798 return scalar(keys %in);
802 'PrintHeader' => <<'END_OF_FUNC',
804 my($self) = self_or_default(@_);
805 return $self->header();
809 'HtmlTop' => <<'END_OF_FUNC',
811 my($self,@p) = self_or_default(@_);
812 return $self->start_html(@p);
816 'HtmlBot' => <<'END_OF_FUNC',
818 my($self,@p) = self_or_default(@_);
819 return $self->end_html(@p);
823 'SplitParam' => <<'END_OF_FUNC',
826 my (@params) = split ("\0", $param);
827 return (wantarray ? @params : $params[0]);
831 'MethGet' => <<'END_OF_FUNC',
833 return request_method() eq 'GET';
837 'MethPost' => <<'END_OF_FUNC',
839 return request_method() eq 'POST';
843 'TIEHASH' => <<'END_OF_FUNC',
845 return $_[1] if defined $_[1];
846 return $Q ||= new shift;
850 'STORE' => <<'END_OF_FUNC',
854 my @vals = split("\0",shift);
855 $self->param(-name=>$tag,-value=>\@vals);
859 'FETCH' => <<'END_OF_FUNC',
861 return $_[0] if $_[1] eq 'CGI';
862 return undef unless defined $_[0]->param($_[1]);
863 return join("\0",$_[0]->param($_[1]));
867 'FIRSTKEY' => <<'END_OF_FUNC',
869 $_[0]->{'.iterator'}=0;
870 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
874 'NEXTKEY' => <<'END_OF_FUNC',
876 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
880 'EXISTS' => <<'END_OF_FUNC',
882 exists $_[0]->{$_[1]};
886 'DELETE' => <<'END_OF_FUNC',
888 $_[0]->delete($_[1]);
892 'CLEAR' => <<'END_OF_FUNC',
900 # Append a new value to an existing query
905 my($name,$value) = rearrange([NAME,[VALUE,VALUES]],@p);
906 my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
908 $self->add_parameter($name);
909 push(@{$self->{$name}},@values);
911 return $self->param($name);
915 #### Method: delete_all
916 # Delete all parameters
918 'delete_all' => <<'EOF',
920 my($self) = self_or_default(@_);
927 my($self,@p) = self_or_default(@_);
932 'Delete_all' => <<'EOF',
934 my($self,@p) = self_or_default(@_);
935 $self->delete_all(@p);
939 #### Method: autoescape
940 # If you want to turn off the autoescaping features,
941 # call this method with undef as the argument
942 'autoEscape' => <<'END_OF_FUNC',
944 my($self,$escape) = self_or_default(@_);
945 $self->{'dontescape'}=!$escape;
951 # Return the current version
953 'version' => <<'END_OF_FUNC',
959 #### Method: url_param
960 # Return a parameter in the QUERY_STRING, regardless of
961 # whether this was a POST or a GET
963 'url_param' => <<'END_OF_FUNC',
965 my ($self,@p) = self_or_default(@_);
966 my $name = shift(@p);
967 return undef unless exists($ENV{QUERY_STRING});
968 unless (exists($self->{'.url_param'})) {
969 $self->{'.url_param'}={}; # empty hash
970 if ($ENV{QUERY_STRING} =~ /=/) {
971 my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING});
974 ($param,$value) = split('=',$_,2);
975 $param = unescape($param);
976 $value = unescape($value);
977 push(@{$self->{'.url_param'}->{$param}},$value);
980 $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})];
983 return keys %{$self->{'.url_param'}} unless defined($name);
984 return () unless $self->{'.url_param'}->{$name};
985 return wantarray ? @{$self->{'.url_param'}->{$name}}
986 : $self->{'.url_param'}->{$name}->[0];
991 # Returns a string in which all the known parameter/value
992 # pairs are represented as nested lists, mainly for the purposes
995 'Dump' => <<'END_OF_FUNC',
997 my($self) = self_or_default(@_);
998 my($param,$value,@result);
999 return '<UL></UL>' unless $self->param;
1000 push(@result,"<UL>");
1001 foreach $param ($self->param) {
1002 my($name)=$self->escapeHTML($param);
1003 push(@result,"<LI><STRONG>$param</STRONG>");
1004 push(@result,"<UL>");
1005 foreach $value ($self->param($param)) {
1006 $value = $self->escapeHTML($value);
1007 $value =~ s/\n/<BR>\n/g;
1008 push(@result,"<LI>$value");
1010 push(@result,"</UL>");
1012 push(@result,"</UL>\n");
1013 return join("\n",@result);
1017 #### Method as_string
1019 # synonym for "dump"
1021 'as_string' => <<'END_OF_FUNC',
1028 # Write values out to a filehandle in such a way that they can
1029 # be reinitialized by the filehandle form of the new() method
1031 'save' => <<'END_OF_FUNC',
1033 my($self,$filehandle) = self_or_default(@_);
1034 $filehandle = to_filehandle($filehandle);
1036 local($,) = ''; # set print field separator back to a sane value
1037 local($\) = ''; # set output line separator to a sane value
1038 foreach $param ($self->param) {
1039 my($escaped_param) = escape($param);
1041 foreach $value ($self->param($param)) {
1042 print $filehandle "$escaped_param=",escape("$value"),"\n";
1045 print $filehandle "=\n"; # end of record
1050 #### Method: save_parameters
1051 # An alias for save() that is a better name for exportation.
1052 # Only intended to be used with the function (non-OO) interface.
1054 'save_parameters' => <<'END_OF_FUNC',
1055 sub save_parameters {
1057 return save(to_filehandle($fh));
1061 #### Method: restore_parameters
1062 # A way to restore CGI parameters from an initializer.
1063 # Only intended to be used with the function (non-OO) interface.
1065 'restore_parameters' => <<'END_OF_FUNC',
1066 sub restore_parameters {
1067 $Q = $CGI::DefaultClass->new(@_);
1071 #### Method: multipart_init
1072 # Return a Content-Type: style header for server-push
1073 # This has to be NPH, and it is advisable to set $| = 1
1075 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1078 'multipart_init' => <<'END_OF_FUNC',
1079 sub multipart_init {
1080 my($self,@p) = self_or_default(@_);
1081 my($boundary,@other) = rearrange([BOUNDARY],@p);
1082 $boundary = $boundary || '------- =_aaaaaaaaaa0';
1083 $self->{'separator'} = "\n--$boundary\n";
1084 $type = SERVER_PUSH($boundary);
1085 return $self->header(
1088 (map { split "=", $_, 2 } @other),
1089 ) . $self->multipart_end;
1094 #### Method: multipart_start
1095 # Return a Content-Type: style header for server-push, start of section
1097 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1100 'multipart_start' => <<'END_OF_FUNC',
1101 sub multipart_start {
1102 my($self,@p) = self_or_default(@_);
1103 my($type,@other) = rearrange([TYPE],@p);
1104 $type = $type || 'text/html';
1105 return $self->header(
1107 (map { split "=", $_, 2 } @other),
1113 #### Method: multipart_end
1114 # Return a Content-Type: style header for server-push, end of section
1116 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
1119 'multipart_end' => <<'END_OF_FUNC',
1121 my($self,@p) = self_or_default(@_);
1122 return $self->{'separator'};
1128 # Return a Content-Type: style header
1131 'header' => <<'END_OF_FUNC',
1133 my($self,@p) = self_or_default(@_);
1136 return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
1138 my($type,$status,$cookie,$target,$expires,$nph,$charset,@other) =
1139 rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
1140 'STATUS',['COOKIE','COOKIES'],'TARGET',
1141 'EXPIRES','NPH','CHARSET'],@p);
1144 if (defined $charset) {
1145 $self->charset($charset);
1147 $charset = $self->charset;
1150 # rearrange() was designed for the HTML portion, so we
1151 # need to fix it up a little.
1153 next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
1154 ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
1157 $type ||= 'text/html' unless defined($type);
1158 $type .= "; charset=$charset" if $type ne '' and $type !~ /\bcharset\b/;
1160 # Maybe future compatibility. Maybe not.
1161 my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
1162 push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
1164 push(@header,"Status: $status") if $status;
1165 push(@header,"Window-Target: $target") if $target;
1166 # push all the cookies -- there may be several
1168 my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
1170 my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
1171 push(@header,"Set-Cookie: $cs") if $cs ne '';
1174 # if the user indicates an expiration time, then we need
1175 # both an Expires and a Date header (so that the browser is
1177 push(@header,"Expires: " . expires($expires,'http'))
1179 push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
1180 push(@header,"Pragma: no-cache") if $self->cache();
1181 push(@header,@other);
1182 push(@header,"Content-Type: $type") if $type ne '';
1184 my $header = join($CRLF,@header)."${CRLF}${CRLF}";
1185 if ($MOD_PERL and not $nph) {
1186 my $r = Apache->request;
1187 $r->send_cgi_header($header);
1196 # Control whether header() will produce the no-cache
1199 'cache' => <<'END_OF_FUNC',
1201 my($self,$new_value) = self_or_default(@_);
1202 $new_value = '' unless $new_value;
1203 if ($new_value ne '') {
1204 $self->{'cache'} = $new_value;
1206 return $self->{'cache'};
1211 #### Method: redirect
1212 # Return a Location: style header
1215 'redirect' => <<'END_OF_FUNC',
1217 my($self,@p) = self_or_default(@_);
1218 my($url,$target,$cookie,$nph,@other) = rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
1219 $url = $url || $self->self_url;
1221 foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
1223 '-Status'=>'302 Moved',
1226 unshift(@o,'-Target'=>$target) if $target;
1227 unshift(@o,'-Cookie'=>$cookie) if $cookie;
1228 unshift(@o,'-Type'=>'');
1229 return $self->header(@o);
1234 #### Method: start_html
1235 # Canned HTML header
1238 # $title -> (optional) The title for this HTML document (-title)
1239 # $author -> (optional) e-mail address of the author (-author)
1240 # $base -> (optional) if set to true, will enter the BASE address of this document
1241 # for resolving relative references (-base)
1242 # $xbase -> (optional) alternative base at some remote location (-xbase)
1243 # $target -> (optional) target window to load all links into (-target)
1244 # $script -> (option) Javascript code (-script)
1245 # $no_script -> (option) Javascript <noscript> tag (-noscript)
1246 # $meta -> (optional) Meta information tags
1247 # $head -> (optional) any other elements you'd like to incorporate into the <HEAD> tag
1248 # (a scalar or array ref)
1249 # $style -> (optional) reference to an external style sheet
1250 # @other -> (optional) any other named parameters you'd like to incorporate into
1253 'start_html' => <<'END_OF_FUNC',
1255 my($self,@p) = &self_or_default(@_);
1256 my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,@other) =
1257 rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
1259 # strangely enough, the title needs to be escaped as HTML
1260 # while the author needs to be escaped as a URL
1261 $title = $self->escapeHTML($title || 'Untitled Document');
1262 $author = $self->escape($author);
1265 if (ref $dtd && $ref eq 'ARRAY') {
1266 $dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|;
1268 $dtd = $DEFAULT_DTD unless $dtd =~ m|^-//|;
1271 $dtd = $DEFAULT_DTD;
1273 if (ref($dtd) && ref($dtd) eq 'ARRAY') {
1274 push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
1276 push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">));
1278 push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
1279 push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if defined $author;
1281 if ($base || $xbase || $target) {
1282 my $href = $xbase || $self->url('-path'=>1);
1283 my $t = $target ? qq/ TARGET="$target"/ : '';
1284 push(@result,qq/<BASE HREF="$href"$t>/);
1287 if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
1288 foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
1291 push(@result,ref($head) ? @$head : $head) if $head;
1293 # handle the infrequently-used -style and -script parameters
1294 push(@result,$self->_style($style)) if defined $style;
1295 push(@result,$self->_script($script)) if defined $script;
1297 # handle -noscript parameter
1298 push(@result,<<END) if $noscript;
1304 my($other) = @other ? " @other" : '';
1305 push(@result,"</HEAD><BODY$other>");
1306 return join("\n",@result);
1311 # internal method for generating a CSS style section
1313 '_style' => <<'END_OF_FUNC',
1315 my ($self,$style) = @_;
1317 my $type = 'text/css';
1319 my($src,$code,$stype,@other) =
1320 rearrange([SRC,CODE,TYPE],
1321 '-foo'=>'bar', # a trick to allow the '-' to be omitted
1322 ref($style) eq 'ARRAY' ? @$style : %$style);
1323 $type = $stype if $stype;
1324 push(@result,qq/<LINK REL="stylesheet" TYPE="$type" HREF="$src">/) if $src;
1325 push(@result,style({'type'=>$type},"<!--\n$code\n-->")) if $code;
1327 push(@result,style({'type'=>$type},"<!--\n$style\n-->"));
1334 '_script' => <<'END_OF_FUNC',
1336 my ($self,$script) = @_;
1338 my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
1339 foreach $script (@scripts) {
1340 my($src,$code,$language);
1341 if (ref($script)) { # script is a hash
1342 ($src,$code,$language, $type) =
1343 rearrange([SRC,CODE,LANGUAGE,TYPE],
1344 '-foo'=>'bar', # a trick to allow the '-' to be omitted
1345 ref($script) eq 'ARRAY' ? @$script : %$script);
1346 # User may not have specified language
1347 $language ||= 'JavaScript';
1348 unless (defined $type) {
1349 $type = lc $language;
1350 # strip '1.2' from 'javascript1.2'
1351 $type =~ s/^(\D+).*$/text\/$1/;
1354 ($src,$code,$language, $type) = ('',$script,'JavaScript', 'text/javascript');
1357 push(@satts,'src'=>$src) if $src;
1358 push(@satts,'language'=>$language);
1359 push(@satts,'type'=>$type);
1360 $code = "<!-- Hide script\n$code\n// End script hiding -->"
1361 if $code && $type=~/javascript/i;
1362 $code = "<!-- Hide script\n$code\n\# End script hiding -->"
1363 if $code && $type=~/perl/i;
1364 $code = "<!-- Hide script\n$code\n\# End script hiding -->"
1365 if $code && $type=~/tcl/i;
1366 $code = "<!-- Hide script\n$code\n' End script hiding -->"
1367 if $code && $type=~/vbscript/i;
1368 push(@result,script({@satts},$code || ''));
1374 #### Method: end_html
1375 # End an HTML document.
1376 # Trivial method for completeness. Just returns "</BODY>"
1378 'end_html' => <<'END_OF_FUNC',
1380 return "</BODY></HTML>";
1385 ################################
1386 # METHODS USED IN BUILDING FORMS
1387 ################################
1389 #### Method: isindex
1390 # Just prints out the isindex tag.
1392 # $action -> optional URL of script to run
1394 # A string containing a <ISINDEX> tag
1395 'isindex' => <<'END_OF_FUNC',
1397 my($self,@p) = self_or_default(@_);
1398 my($action,@other) = rearrange([ACTION],@p);
1399 $action = qq/ACTION="$action"/ if $action;
1400 my($other) = @other ? " @other" : '';
1401 return "<ISINDEX $action$other>";
1406 #### Method: startform
1409 # $method -> optional submission method to use (GET or POST)
1410 # $action -> optional URL of script to run
1411 # $enctype ->encoding to use (URL_ENCODED or MULTIPART)
1412 'startform' => <<'END_OF_FUNC',
1414 my($self,@p) = self_or_default(@_);
1416 my($method,$action,$enctype,@other) =
1417 rearrange([METHOD,ACTION,ENCTYPE],@p);
1419 $method = $method || 'POST';
1420 $enctype = $enctype || &URL_ENCODED;
1421 $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
1422 'ACTION="'.$self->script_name.'"' : '';
1423 my($other) = @other ? " @other" : '';
1424 $self->{'.parametersToAdd'}={};
1425 return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
1430 #### Method: start_form
1431 # synonym for startform
1432 'start_form' => <<'END_OF_FUNC',
1438 'end_multipart_form' => <<'END_OF_FUNC',
1439 sub end_multipart_form {
1444 #### Method: start_multipart_form
1445 # synonym for startform
1446 'start_multipart_form' => <<'END_OF_FUNC',
1447 sub start_multipart_form {
1448 my($self,@p) = self_or_default(@_);
1449 if (defined($param[0]) && substr($param[0],0,1) eq '-') {
1451 $p{'-enctype'}=&MULTIPART;
1452 return $self->startform(%p);
1454 my($method,$action,@other) =
1455 rearrange([METHOD,ACTION],@p);
1456 return $self->startform($method,$action,&MULTIPART,@other);
1462 #### Method: endform
1464 'endform' => <<'END_OF_FUNC',
1466 my($self,@p) = self_or_default(@_);
1468 return wantarray ? ("</FORM>") : "\n</FORM>";
1470 return wantarray ? ($self->get_fields,"</FORM>") :
1471 $self->get_fields ."\n</FORM>";
1477 #### Method: end_form
1478 # synonym for endform
1479 'end_form' => <<'END_OF_FUNC',
1486 '_textfield' => <<'END_OF_FUNC',
1488 my($self,$tag,@p) = self_or_default(@_);
1489 my($name,$default,$size,$maxlength,$override,@other) =
1490 rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
1492 my $current = $override ? $default :
1493 (defined($self->param($name)) ? $self->param($name) : $default);
1495 $current = defined($current) ? $self->escapeHTML($current) : '';
1496 $name = defined($name) ? $self->escapeHTML($name) : '';
1497 my($s) = defined($size) ? qq/ SIZE=$size/ : '';
1498 my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
1499 my($other) = @other ? " @other" : '';
1500 # this entered at cristy's request to fix problems with file upload fields
1501 # and WebTV -- not sure it won't break stuff
1502 my($value) = $current ne '' ? qq(VALUE="$current") : '';
1503 return qq/<INPUT TYPE="$tag" NAME="$name" $value$s$m$other>/;
1507 #### Method: textfield
1509 # $name -> Name of the text field
1510 # $default -> Optional default value of the field if not
1512 # $size -> Optional width of field in characaters.
1513 # $maxlength -> Optional maximum number of characters.
1515 # A string containing a <INPUT TYPE="text"> field
1517 'textfield' => <<'END_OF_FUNC',
1519 my($self,@p) = self_or_default(@_);
1520 $self->_textfield('text',@p);
1525 #### Method: filefield
1527 # $name -> Name of the file upload field
1528 # $size -> Optional width of field in characaters.
1529 # $maxlength -> Optional maximum number of characters.
1531 # A string containing a <INPUT TYPE="text"> field
1533 'filefield' => <<'END_OF_FUNC',
1535 my($self,@p) = self_or_default(@_);
1536 $self->_textfield('file',@p);
1541 #### Method: password
1542 # Create a "secret password" entry field
1544 # $name -> Name of the field
1545 # $default -> Optional default value of the field if not
1547 # $size -> Optional width of field in characters.
1548 # $maxlength -> Optional maximum characters that can be entered.
1550 # A string containing a <INPUT TYPE="password"> field
1552 'password_field' => <<'END_OF_FUNC',
1553 sub password_field {
1554 my ($self,@p) = self_or_default(@_);
1555 $self->_textfield('password',@p);
1559 #### Method: textarea
1561 # $name -> Name of the text field
1562 # $default -> Optional default value of the field if not
1564 # $rows -> Optional number of rows in text area
1565 # $columns -> Optional number of columns in text area
1567 # A string containing a <TEXTAREA></TEXTAREA> tag
1569 'textarea' => <<'END_OF_FUNC',
1571 my($self,@p) = self_or_default(@_);
1573 my($name,$default,$rows,$cols,$override,@other) =
1574 rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
1576 my($current)= $override ? $default :
1577 (defined($self->param($name)) ? $self->param($name) : $default);
1579 $name = defined($name) ? $self->escapeHTML($name) : '';
1580 $current = defined($current) ? $self->escapeHTML($current) : '';
1581 my($r) = $rows ? " ROWS=$rows" : '';
1582 my($c) = $cols ? " COLS=$cols" : '';
1583 my($other) = @other ? " @other" : '';
1584 return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
1590 # Create a javascript button.
1592 # $name -> (optional) Name for the button. (-name)
1593 # $value -> (optional) Value of the button when selected (and visible name) (-value)
1594 # $onclick -> (optional) Text of the JavaScript to run when the button is
1597 # A string containing a <INPUT TYPE="button"> tag
1599 'button' => <<'END_OF_FUNC',
1601 my($self,@p) = self_or_default(@_);
1603 my($label,$value,$script,@other) = rearrange([NAME,[VALUE,LABEL],
1604 [ONCLICK,SCRIPT]],@p);
1606 $label=$self->escapeHTML($label);
1607 $value=$self->escapeHTML($value);
1608 $script=$self->escapeHTML($script);
1611 $name = qq/ NAME="$label"/ if $label;
1612 $value = $value || $label;
1614 $val = qq/ VALUE="$value"/ if $value;
1615 $script = qq/ ONCLICK="$script"/ if $script;
1616 my($other) = @other ? " @other" : '';
1617 return qq/<INPUT TYPE="button"$name$val$script$other>/;
1623 # Create a "submit query" button.
1625 # $name -> (optional) Name for the button.
1626 # $value -> (optional) Value of the button when selected (also doubles as label).
1627 # $label -> (optional) Label printed on the button(also doubles as the value).
1629 # A string containing a <INPUT TYPE="submit"> tag
1631 'submit' => <<'END_OF_FUNC',
1633 my($self,@p) = self_or_default(@_);
1635 my($label,$value,@other) = rearrange([NAME,[VALUE,LABEL]],@p);
1637 $label=$self->escapeHTML($label);
1638 $value=$self->escapeHTML($value);
1640 my($name) = ' NAME=".submit"' unless $NOSTICKY;
1641 $name = qq/ NAME="$label"/ if defined($label);
1642 $value = defined($value) ? $value : $label;
1644 $val = qq/ VALUE="$value"/ if defined($value);
1645 my($other) = @other ? " @other" : '';
1646 return qq/<INPUT TYPE="submit"$name$val$other>/;
1652 # Create a "reset" button.
1654 # $name -> (optional) Name for the button.
1656 # A string containing a <INPUT TYPE="reset"> tag
1658 'reset' => <<'END_OF_FUNC',
1660 my($self,@p) = self_or_default(@_);
1661 my($label,@other) = rearrange([NAME],@p);
1662 $label=$self->escapeHTML($label);
1663 my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
1664 my($other) = @other ? " @other" : '';
1665 return qq/<INPUT TYPE="reset"$value$other>/;
1670 #### Method: defaults
1671 # Create a "defaults" button.
1673 # $name -> (optional) Name for the button.
1675 # A string containing a <INPUT TYPE="submit" NAME=".defaults"> tag
1677 # Note: this button has a special meaning to the initialization script,
1678 # and tells it to ERASE the current query string so that your defaults
1681 'defaults' => <<'END_OF_FUNC',
1683 my($self,@p) = self_or_default(@_);
1685 my($label,@other) = rearrange([[NAME,VALUE]],@p);
1687 $label=$self->escapeHTML($label);
1688 $label = $label || "Defaults";
1689 my($value) = qq/ VALUE="$label"/;
1690 my($other) = @other ? " @other" : '';
1691 return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
1696 #### Method: comment
1697 # Create an HTML <!-- comment -->
1698 # Parameters: a string
1699 'comment' => <<'END_OF_FUNC',
1701 my($self,@p) = self_or_CGI(@_);
1702 return "<!-- @p -->";
1706 #### Method: checkbox
1707 # Create a checkbox that is not logically linked to any others.
1708 # The field value is "on" when the button is checked.
1710 # $name -> Name of the checkbox
1711 # $checked -> (optional) turned on by default if true
1712 # $value -> (optional) value of the checkbox, 'on' by default
1713 # $label -> (optional) a user-readable label printed next to the box.
1714 # Otherwise the checkbox name is used.
1716 # A string containing a <INPUT TYPE="checkbox"> field
1718 'checkbox' => <<'END_OF_FUNC',
1720 my($self,@p) = self_or_default(@_);
1722 my($name,$checked,$value,$label,$override,@other) =
1723 rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
1725 $value = defined $value ? $value : 'on';
1727 if (!$override && ($self->{'.fieldnames'}->{$name} ||
1728 defined $self->param($name))) {
1729 $checked = grep($_ eq $value,$self->param($name)) ? ' CHECKED' : '';
1731 $checked = $checked ? ' CHECKED' : '';
1733 my($the_label) = defined $label ? $label : $name;
1734 $name = $self->escapeHTML($name);
1735 $value = $self->escapeHTML($value);
1736 $the_label = $self->escapeHTML($the_label);
1737 my($other) = @other ? " @other" : '';
1738 $self->register_parameter($name);
1739 return qq{<INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label};
1744 #### Method: checkbox_group
1745 # Create a list of logically-linked checkboxes.
1747 # $name -> Common name for all the check boxes
1748 # $values -> A pointer to a regular array containing the
1749 # values for each checkbox in the group.
1750 # $defaults -> (optional)
1751 # 1. If a pointer to a regular array of checkbox values,
1752 # then this will be used to decide which
1753 # checkboxes to turn on by default.
1754 # 2. If a scalar, will be assumed to hold the
1755 # value of a single checkbox in the group to turn on.
1756 # $linebreak -> (optional) Set to true to place linebreaks
1757 # between the buttons.
1758 # $labels -> (optional)
1759 # A pointer to an associative array of labels to print next to each checkbox
1760 # in the form $label{'value'}="Long explanatory label".
1761 # Otherwise the provided values are used as the labels.
1763 # An ARRAY containing a series of <INPUT TYPE="checkbox"> fields
1765 'checkbox_group' => <<'END_OF_FUNC',
1766 sub checkbox_group {
1767 my($self,@p) = self_or_default(@_);
1769 my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
1770 $rowheaders,$colheaders,$override,$nolabels,@other) =
1771 rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
1772 LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
1773 ROWHEADERS,COLHEADERS,
1774 [OVERRIDE,FORCE],NOLABELS],@p);
1776 my($checked,$break,$result,$label);
1778 my(%checked) = $self->previous_or_default($name,$defaults,$override);
1780 $break = $linebreak ? "<BR>" : '';
1781 $name=$self->escapeHTML($name);
1783 # Create the elements
1784 my(@elements,@values);
1786 @values = $self->_set_values_and_labels($values,\$labels,$name);
1788 my($other) = @other ? " @other" : '';
1790 $checked = $checked{$_} ? ' CHECKED' : '';
1792 unless (defined($nolabels) && $nolabels) {
1794 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1795 $label = $self->escapeHTML($label);
1797 $_ = $self->escapeHTML($_);
1798 push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label}${break}/);
1800 $self->register_parameter($name);
1801 return wantarray ? @elements : join(' ',@elements)
1802 unless defined($columns) || defined($rows);
1803 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1807 # Escape HTML -- used internally
1808 'escapeHTML' => <<'END_OF_FUNC',
1810 my ($self,$toencode) = self_or_default(@_);
1811 return undef unless defined($toencode);
1812 return $toencode if ref($self) && $self->{'dontescape'};
1813 if (uc $self->{'.charset'} eq 'ISO-8859-1') {
1814 # fix non-compliant bug in IE and Netscape
1815 $toencode =~ s{(.)}{
1816 if ($1 eq '<') { '<' }
1817 elsif ($1 eq '>') { '>' }
1818 elsif ($1 eq '&') { '&' }
1819 elsif ($1 eq '"') { '"' }
1820 elsif ($1 eq "\x8b") { '‹' }
1821 elsif ($1 eq "\x9b") { '›' }
1825 $toencode =~ s/(.)/'&#'.ord($1).';'/gsex;
1831 # unescape HTML -- used internally
1832 'unescapeHTML' => <<'END_OF_FUNC',
1834 my $string = ref($_[0]) ? $_[1] : $_[0];
1835 return undef unless defined($string);
1836 # thanks to Randal Schwartz for the correct solution to this one
1837 $string=~ s[&(.*?);]{
1843 /^#(\d+)$/ ? chr($1) :
1844 /^#x([0-9a-f]+)$/i ? chr(hex($1)) :
1851 # Internal procedure - don't use
1852 '_tableize' => <<'END_OF_FUNC',
1854 my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
1857 if (defined($columns)) {
1858 $rows = int(0.99 + @elements/$columns) unless defined($rows);
1860 if (defined($rows)) {
1861 $columns = int(0.99 + @elements/$rows) unless defined($columns);
1864 # rearrange into a pretty table
1865 $result = "<TABLE>";
1867 unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
1868 $result .= "<TR>" if @{$colheaders};
1869 foreach (@{$colheaders}) {
1870 $result .= "<TH>$_</TH>";
1872 for ($row=0;$row<$rows;$row++) {
1874 $result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
1875 for ($column=0;$column<$columns;$column++) {
1876 $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"
1877 if defined($elements[$column*$rows + $row]);
1881 $result .= "</TABLE>";
1887 #### Method: radio_group
1888 # Create a list of logically-linked radio buttons.
1890 # $name -> Common name for all the buttons.
1891 # $values -> A pointer to a regular array containing the
1892 # values for each button in the group.
1893 # $default -> (optional) Value of the button to turn on by default. Pass '-'
1894 # to turn _nothing_ on.
1895 # $linebreak -> (optional) Set to true to place linebreaks
1896 # between the buttons.
1897 # $labels -> (optional)
1898 # A pointer to an associative array of labels to print next to each checkbox
1899 # in the form $label{'value'}="Long explanatory label".
1900 # Otherwise the provided values are used as the labels.
1902 # An ARRAY containing a series of <INPUT TYPE="radio"> fields
1904 'radio_group' => <<'END_OF_FUNC',
1906 my($self,@p) = self_or_default(@_);
1908 my($name,$values,$default,$linebreak,$labels,
1909 $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
1910 rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
1911 ROWS,[COLUMNS,COLS],
1912 ROWHEADERS,COLHEADERS,
1913 [OVERRIDE,FORCE],NOLABELS],@p);
1914 my($result,$checked);
1916 if (!$override && defined($self->param($name))) {
1917 $checked = $self->param($name);
1919 $checked = $default;
1921 my(@elements,@values);
1922 @values = $self->_set_values_and_labels($values,\$labels,$name);
1924 # If no check array is specified, check the first by default
1925 $checked = $values[0] unless defined($checked) && $checked ne '';
1926 $name=$self->escapeHTML($name);
1928 my($other) = @other ? " @other" : '';
1930 my($checkit) = $checked eq $_ ? ' CHECKED' : '';
1931 my($break) = $linebreak ? '<BR>' : '';
1933 unless (defined($nolabels) && $nolabels) {
1935 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1936 $label = $self->escapeHTML($label);
1938 $_=$self->escapeHTML($_);
1939 push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label}${break}/);
1941 $self->register_parameter($name);
1942 return wantarray ? @elements : join(' ',@elements)
1943 unless defined($columns) || defined($rows);
1944 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1949 #### Method: popup_menu
1950 # Create a popup menu.
1952 # $name -> Name for all the menu
1953 # $values -> A pointer to a regular array containing the
1954 # text of each menu item.
1955 # $default -> (optional) Default item to display
1956 # $labels -> (optional)
1957 # A pointer to an associative array of labels to print next to each checkbox
1958 # in the form $label{'value'}="Long explanatory label".
1959 # Otherwise the provided values are used as the labels.
1961 # A string containing the definition of a popup menu.
1963 'popup_menu' => <<'END_OF_FUNC',
1965 my($self,@p) = self_or_default(@_);
1967 my($name,$values,$default,$labels,$override,@other) =
1968 rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
1969 my($result,$selected);
1971 if (!$override && defined($self->param($name))) {
1972 $selected = $self->param($name);
1974 $selected = $default;
1976 $name=$self->escapeHTML($name);
1977 my($other) = @other ? " @other" : '';
1980 @values = $self->_set_values_and_labels($values,\$labels,$name);
1982 $result = qq/<SELECT NAME="$name"$other>\n/;
1984 my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
1986 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
1987 my($value) = $self->escapeHTML($_);
1988 $label=$self->escapeHTML($label);
1989 $result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
1992 $result .= "</SELECT>\n";
1998 #### Method: scrolling_list
1999 # Create a scrolling list.
2001 # $name -> name for the list
2002 # $values -> A pointer to a regular array containing the
2003 # values for each option line in the list.
2004 # $defaults -> (optional)
2005 # 1. If a pointer to a regular array of options,
2006 # then this will be used to decide which
2007 # lines to turn on by default.
2008 # 2. Otherwise holds the value of the single line to turn on.
2009 # $size -> (optional) Size of the list.
2010 # $multiple -> (optional) If set, allow multiple selections.
2011 # $labels -> (optional)
2012 # A pointer to an associative array of labels to print next to each checkbox
2013 # in the form $label{'value'}="Long explanatory label".
2014 # Otherwise the provided values are used as the labels.
2016 # A string containing the definition of a scrolling list.
2018 'scrolling_list' => <<'END_OF_FUNC',
2019 sub scrolling_list {
2020 my($self,@p) = self_or_default(@_);
2021 my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
2022 = rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
2023 SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
2025 my($result,@values);
2026 @values = $self->_set_values_and_labels($values,\$labels,$name);
2028 $size = $size || scalar(@values);
2030 my(%selected) = $self->previous_or_default($name,$defaults,$override);
2031 my($is_multiple) = $multiple ? ' MULTIPLE' : '';
2032 my($has_size) = $size ? " SIZE=$size" : '';
2033 my($other) = @other ? " @other" : '';
2035 $name=$self->escapeHTML($name);
2036 $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
2038 my($selectit) = $selected{$_} ? 'SELECTED' : '';
2040 $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
2041 $label=$self->escapeHTML($label);
2042 my($value)=$self->escapeHTML($_);
2043 $result .= "<OPTION $selectit VALUE=\"$value\">$label</OPTION>\n";
2045 $result .= "</SELECT>\n";
2046 $self->register_parameter($name);
2054 # $name -> Name of the hidden field
2055 # @default -> (optional) Initial values of field (may be an array)
2057 # $default->[initial values of field]
2059 # A string containing a <INPUT TYPE="hidden" NAME="name" VALUE="value">
2061 'hidden' => <<'END_OF_FUNC',
2063 my($self,@p) = self_or_default(@_);
2065 # this is the one place where we departed from our standard
2066 # calling scheme, so we have to special-case (darn)
2068 my($name,$default,$override,@other) =
2069 rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
2071 my $do_override = 0;
2072 if ( ref($p[0]) || substr($p[0],0,1) eq '-') {
2073 @value = ref($default) ? @{$default} : $default;
2074 $do_override = $override;
2076 foreach ($default,$override,@other) {
2077 push(@value,$_) if defined($_);
2081 # use previous values if override is not set
2082 my @prev = $self->param($name);
2083 @value = @prev if !$do_override && @prev;
2085 $name=$self->escapeHTML($name);
2087 $_ = defined($_) ? $self->escapeHTML($_) : '';
2088 push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
2090 return wantarray ? @result : join('',@result);
2095 #### Method: image_button
2097 # $name -> Name of the button
2098 # $src -> URL of the image source
2099 # $align -> Alignment style (TOP, BOTTOM or MIDDLE)
2101 # A string containing a <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment">
2103 'image_button' => <<'END_OF_FUNC',
2105 my($self,@p) = self_or_default(@_);
2107 my($name,$src,$alignment,@other) =
2108 rearrange([NAME,SRC,ALIGN],@p);
2110 my($align) = $alignment ? " ALIGN=\U$alignment" : '';
2111 my($other) = @other ? " @other" : '';
2112 $name=$self->escapeHTML($name);
2113 return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
2118 #### Method: self_url
2119 # Returns a URL containing the current script and all its
2120 # param/value pairs arranged as a query. You can use this
2121 # to create a link that, when selected, will reinvoke the
2122 # script with all its state information preserved.
2124 'self_url' => <<'END_OF_FUNC',
2126 my($self,@p) = self_or_default(@_);
2127 return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p);
2132 # This is provided as a synonym to self_url() for people unfortunate
2133 # enough to have incorporated it into their programs already!
2134 'state' => <<'END_OF_FUNC',
2142 # Like self_url, but doesn't return the query string part of
2145 'url' => <<'END_OF_FUNC',
2147 my($self,@p) = self_or_default(@_);
2148 my ($relative,$absolute,$full,$path_info,$query) =
2149 rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
2151 $full++ if !($relative || $absolute);
2153 my $path = $self->path_info;
2155 if (exists($ENV{REQUEST_URI})) {
2157 $script_name = $ENV{REQUEST_URI};
2158 # strip query string
2159 substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0;
2161 if (exists($ENV{PATH_INFO})) {
2162 my $decoded_path = unescape($ENV{PATH_INFO});
2163 substr($script_name,$index) = '' if ($index = rindex($script_name,$decoded_path)) >= 0;
2166 $script_name = $self->script_name;
2170 my $protocol = $self->protocol();
2171 $url = "$protocol://";
2172 my $vh = http('host');
2176 $url .= server_name();
2177 my $port = $self->server_port;
2179 unless (lc($protocol) eq 'http' && $port == 80)
2180 || (lc($protocol) eq 'https' && $port == 443);
2182 $url .= $script_name;
2183 } elsif ($relative) {
2184 ($url) = $script_name =~ m!([^/]+)$!;
2185 } elsif ($absolute) {
2186 $url = $script_name;
2188 $url .= $path if $path_info and defined $path;
2189 $url .= "?" . $self->query_string if $query and $self->query_string;
2190 $url = '' unless defined $url;
2191 $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/uc sprintf("%%%02x",ord($1))/eg;
2198 # Set or read a cookie from the specified name.
2199 # Cookie can then be passed to header().
2200 # Usual rules apply to the stickiness of -value.
2202 # -name -> name for this cookie (optional)
2203 # -value -> value of this cookie (scalar, array or hash)
2204 # -path -> paths for which this cookie is valid (optional)
2205 # -domain -> internet domain in which this cookie is valid (optional)
2206 # -secure -> if true, cookie only passed through secure channel (optional)
2207 # -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional)
2209 'cookie' => <<'END_OF_FUNC',
2211 my($self,@p) = self_or_default(@_);
2212 my($name,$value,$path,$domain,$secure,$expires) =
2213 rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
2215 require CGI::Cookie;
2217 # if no value is supplied, then we retrieve the
2218 # value of the cookie, if any. For efficiency, we cache the parsed
2219 # cookies in our state variables.
2220 unless ( defined($value) ) {
2221 $self->{'.cookies'} = CGI::Cookie->fetch
2222 unless $self->{'.cookies'};
2224 # If no name is supplied, then retrieve the names of all our cookies.
2225 return () unless $self->{'.cookies'};
2226 return keys %{$self->{'.cookies'}} unless $name;
2227 return () unless $self->{'.cookies'}->{$name};
2228 return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne '';
2231 # If we get here, we're creating a new cookie
2232 return undef unless $name; # this is an error
2235 push(@param,'-name'=>$name);
2236 push(@param,'-value'=>$value);
2237 push(@param,'-domain'=>$domain) if $domain;
2238 push(@param,'-path'=>$path) if $path;
2239 push(@param,'-expires'=>$expires) if $expires;
2240 push(@param,'-secure'=>$secure) if $secure;
2242 return CGI::Cookie->new(@param);
2246 'parse_keywordlist' => <<'END_OF_FUNC',
2247 sub parse_keywordlist {
2248 my($self,$tosplit) = @_;
2249 $tosplit = unescape($tosplit); # unescape the keywords
2250 $tosplit=~tr/+/ /; # pluses to spaces
2251 my(@keywords) = split(/\s+/,$tosplit);
2256 'param_fetch' => <<'END_OF_FUNC',
2258 my($self,@p) = self_or_default(@_);
2259 my($name) = rearrange([NAME],@p);
2260 unless (exists($self->{$name})) {
2261 $self->add_parameter($name);
2262 $self->{$name} = [];
2265 return $self->{$name};
2269 ###############################################
2270 # OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
2271 ###############################################
2273 #### Method: path_info
2274 # Return the extra virtual path information provided
2275 # after the URL (if any)
2277 'path_info' => <<'END_OF_FUNC',
2279 my ($self,$info) = self_or_default(@_);
2280 if (defined($info)) {
2281 $info = "/$info" if $info ne '' && substr($info,0,1) ne '/';
2282 $self->{'.path_info'} = $info;
2283 } elsif (! defined($self->{'.path_info'}) ) {
2284 $self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ?
2285 $ENV{'PATH_INFO'} : '';
2287 # hack to fix broken path info in IIS
2288 $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
2291 return $self->{'.path_info'};
2296 #### Method: request_method
2297 # Returns 'POST', 'GET', 'PUT' or 'HEAD'
2299 'request_method' => <<'END_OF_FUNC',
2300 sub request_method {
2301 return $ENV{'REQUEST_METHOD'};
2305 #### Method: content_type
2306 # Returns the content_type string
2308 'content_type' => <<'END_OF_FUNC',
2310 return $ENV{'CONTENT_TYPE'};
2314 #### Method: path_translated
2315 # Return the physical path information provided
2316 # by the URL (if any)
2318 'path_translated' => <<'END_OF_FUNC',
2319 sub path_translated {
2320 return $ENV{'PATH_TRANSLATED'};
2325 #### Method: query_string
2326 # Synthesize a query string from our current
2329 'query_string' => <<'END_OF_FUNC',
2331 my($self) = self_or_default(@_);
2332 my($param,$value,@pairs);
2333 foreach $param ($self->param) {
2334 my($eparam) = escape($param);
2335 foreach $value ($self->param($param)) {
2336 $value = escape($value);
2337 next unless defined $value;
2338 push(@pairs,"$eparam=$value");
2341 return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs);
2347 # Without parameters, returns an array of the
2348 # MIME types the browser accepts.
2349 # With a single parameter equal to a MIME
2350 # type, will return undef if the browser won't
2351 # accept it, 1 if the browser accepts it but
2352 # doesn't give a preference, or a floating point
2353 # value between 0.0 and 1.0 if the browser
2354 # declares a quantitative score for it.
2355 # This handles MIME type globs correctly.
2357 'Accept' => <<'END_OF_FUNC',
2359 my($self,$search) = self_or_CGI(@_);
2360 my(%prefs,$type,$pref,$pat);
2362 my(@accept) = split(',',$self->http('accept'));
2365 ($pref) = /q=(\d\.\d+|\d+)/;
2366 ($type) = m#(\S+/[^;]+)#;
2368 $prefs{$type}=$pref || 1;
2371 return keys %prefs unless $search;
2373 # if a search type is provided, we may need to
2374 # perform a pattern matching operation.
2375 # The MIME types use a glob mechanism, which
2376 # is easily translated into a perl pattern match
2378 # First return the preference for directly supported
2380 return $prefs{$search} if $prefs{$search};
2382 # Didn't get it, so try pattern matching.
2383 foreach (keys %prefs) {
2384 next unless /\*/; # not a pattern match
2385 ($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
2386 $pat =~ s/\*/.*/g; # turn it into a pattern
2387 return $prefs{$_} if $search=~/$pat/;
2393 #### Method: user_agent
2394 # If called with no parameters, returns the user agent.
2395 # If called with one parameter, does a pattern match (case
2396 # insensitive) on the user agent.
2398 'user_agent' => <<'END_OF_FUNC',
2400 my($self,$match)=self_or_CGI(@_);
2401 return $self->http('user_agent') unless $match;
2402 return $self->http('user_agent') =~ /$match/i;
2407 #### Method: raw_cookie
2408 # Returns the magic cookies for the session.
2409 # The cookies are not parsed or altered in any way, i.e.
2410 # cookies are returned exactly as given in the HTTP
2411 # headers. If a cookie name is given, only that cookie's
2412 # value is returned, otherwise the entire raw cookie
2415 'raw_cookie' => <<'END_OF_FUNC',
2417 my($self,$key) = self_or_CGI(@_);
2419 require CGI::Cookie;
2421 if (defined($key)) {
2422 $self->{'.raw_cookies'} = CGI::Cookie->raw_fetch
2423 unless $self->{'.raw_cookies'};
2425 return () unless $self->{'.raw_cookies'};
2426 return () unless $self->{'.raw_cookies'}->{$key};
2427 return $self->{'.raw_cookies'}->{$key};
2429 return $self->http('cookie') || $ENV{'COOKIE'} || '';
2433 #### Method: virtual_host
2434 # Return the name of the virtual_host, which
2435 # is not always the same as the server
2437 'virtual_host' => <<'END_OF_FUNC',
2439 my $vh = http('host') || server_name();
2440 $vh =~ s/:\d+$//; # get rid of port number
2445 #### Method: remote_host
2446 # Return the name of the remote host, or its IP
2447 # address if unavailable. If this variable isn't
2448 # defined, it returns "localhost" for debugging
2451 'remote_host' => <<'END_OF_FUNC',
2453 return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}
2459 #### Method: remote_addr
2460 # Return the IP addr of the remote host.
2462 'remote_addr' => <<'END_OF_FUNC',
2464 return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
2469 #### Method: script_name
2470 # Return the partial URL to this script for
2471 # self-referencing scripts. Also see
2472 # self_url(), which returns a URL with all state information
2475 'script_name' => <<'END_OF_FUNC',
2477 return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
2478 # These are for debugging
2479 return "/$0" unless $0=~/^\//;
2485 #### Method: referer
2486 # Return the HTTP_REFERER: useful for generating
2489 'referer' => <<'END_OF_FUNC',
2491 my($self) = self_or_CGI(@_);
2492 return $self->http('referer');
2497 #### Method: server_name
2498 # Return the name of the server
2500 'server_name' => <<'END_OF_FUNC',
2502 return $ENV{'SERVER_NAME'} || 'localhost';
2506 #### Method: server_software
2507 # Return the name of the server software
2509 'server_software' => <<'END_OF_FUNC',
2510 sub server_software {
2511 return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
2515 #### Method: server_port
2516 # Return the tcp/ip port the server is running on
2518 'server_port' => <<'END_OF_FUNC',
2520 return $ENV{'SERVER_PORT'} || 80; # for debugging
2524 #### Method: server_protocol
2525 # Return the protocol (usually HTTP/1.0)
2527 'server_protocol' => <<'END_OF_FUNC',
2528 sub server_protocol {
2529 return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging
2534 # Return the value of an HTTP variable, or
2535 # the list of variables if none provided
2537 'http' => <<'END_OF_FUNC',
2539 my ($self,$parameter) = self_or_CGI(@_);
2540 return $ENV{$parameter} if $parameter=~/^HTTP/;
2541 $parameter =~ tr/-/_/;
2542 return $ENV{"HTTP_\U$parameter\E"} if $parameter;
2544 foreach (keys %ENV) {
2545 push(@p,$_) if /^HTTP/;
2552 # Return the value of HTTPS
2554 'https' => <<'END_OF_FUNC',
2557 my ($self,$parameter) = self_or_CGI(@_);
2558 return $ENV{HTTPS} unless $parameter;
2559 return $ENV{$parameter} if $parameter=~/^HTTPS/;
2560 $parameter =~ tr/-/_/;
2561 return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
2563 foreach (keys %ENV) {
2564 push(@p,$_) if /^HTTPS/;
2570 #### Method: protocol
2571 # Return the protocol (http or https currently)
2573 'protocol' => <<'END_OF_FUNC',
2577 return 'https' if uc($self->https()) eq 'ON';
2578 return 'https' if $self->server_port == 443;
2579 my $prot = $self->server_protocol;
2580 my($protocol,$version) = split('/',$prot);
2581 return "\L$protocol\E";
2585 #### Method: remote_ident
2586 # Return the identity of the remote user
2587 # (but only if his host is running identd)
2589 'remote_ident' => <<'END_OF_FUNC',
2591 return $ENV{'REMOTE_IDENT'};
2596 #### Method: auth_type
2597 # Return the type of use verification/authorization in use, if any.
2599 'auth_type' => <<'END_OF_FUNC',
2601 return $ENV{'AUTH_TYPE'};
2606 #### Method: remote_user
2607 # Return the authorization name used for user
2610 'remote_user' => <<'END_OF_FUNC',
2612 return $ENV{'REMOTE_USER'};
2617 #### Method: user_name
2618 # Try to return the remote user's name by hook or by
2621 'user_name' => <<'END_OF_FUNC',
2623 my ($self) = self_or_CGI(@_);
2624 return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
2628 #### Method: nosticky
2629 # Set or return the NOSTICKY global flag
2631 'nosticky' => <<'END_OF_FUNC',
2633 my ($self,$param) = self_or_CGI(@_);
2634 $CGI::NOSTICKY = $param if defined($param);
2635 return $CGI::NOSTICKY;
2640 # Set or return the NPH global flag
2642 'nph' => <<'END_OF_FUNC',
2644 my ($self,$param) = self_or_CGI(@_);
2645 $CGI::NPH = $param if defined($param);
2650 #### Method: private_tempfiles
2651 # Set or return the private_tempfiles global flag
2653 'private_tempfiles' => <<'END_OF_FUNC',
2654 sub private_tempfiles {
2655 my ($self,$param) = self_or_CGI(@_);
2656 $CGI::PRIVATE_TEMPFILES = $param if defined($param);
2657 return $CGI::PRIVATE_TEMPFILES;
2661 #### Method: default_dtd
2662 # Set or return the default_dtd global
2664 'default_dtd' => <<'END_OF_FUNC',
2666 my ($self,$param,$param2) = self_or_CGI(@_);
2667 if (defined $param2 && defined $param) {
2668 $CGI::DEFAULT_DTD = [ $param, $param2 ];
2669 } elsif (defined $param) {
2670 $CGI::DEFAULT_DTD = $param;
2672 return $CGI::DEFAULT_DTD;
2676 # -------------- really private subroutines -----------------
2677 'previous_or_default' => <<'END_OF_FUNC',
2678 sub previous_or_default {
2679 my($self,$name,$defaults,$override) = @_;
2682 if (!$override && ($self->{'.fieldnames'}->{$name} ||
2683 defined($self->param($name)) ) ) {
2684 grep($selected{$_}++,$self->param($name));
2685 } elsif (defined($defaults) && ref($defaults) &&
2686 (ref($defaults) eq 'ARRAY')) {
2687 grep($selected{$_}++,@{$defaults});
2689 $selected{$defaults}++ if defined($defaults);
2696 'register_parameter' => <<'END_OF_FUNC',
2697 sub register_parameter {
2698 my($self,$param) = @_;
2699 $self->{'.parametersToAdd'}->{$param}++;
2703 'get_fields' => <<'END_OF_FUNC',
2706 return $self->CGI::hidden('-name'=>'.cgifields',
2707 '-values'=>[keys %{$self->{'.parametersToAdd'}}],
2712 'read_from_cmdline' => <<'END_OF_FUNC',
2713 sub read_from_cmdline {
2716 if ($DEBUG && @ARGV) {
2718 } elsif ($DEBUG > 1) {
2719 require "shellwords.pl";
2720 print STDERR "(offline mode: enter name=value pairs on standard input)\n";
2721 chomp(@lines = <STDIN>); # remove newlines
2722 $input = join(" ",@lines);
2723 @words = &shellwords($input);
2730 if ("@words"=~/=/) {
2731 $query_string = join('&',@words);
2733 $query_string = join('+',@words);
2735 return $query_string;
2740 # subroutine: read_multipart
2742 # Read multipart data and store it into our parameters.
2743 # An interesting feature is that if any of the parts is a file, we
2744 # create a temporary file and open up a filehandle on it so that the
2745 # caller can read from it if necessary.
2747 'read_multipart' => <<'END_OF_FUNC',
2748 sub read_multipart {
2749 my($self,$boundary,$length,$filehandle) = @_;
2750 my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle);
2751 return unless $buffer;
2754 while (!$buffer->eof) {
2755 %header = $buffer->readHeader;
2758 $self->cgi_error("400 Bad request (malformed multipart POST)");
2762 my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
2764 # Bug: Netscape doesn't escape quotation marks in file names!!!
2765 my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
2767 # add this parameter to our list
2768 $self->add_parameter($param);
2770 # If no filename specified, then just read the data and assign it
2771 # to our parameter list.
2772 if ( !defined($filename) || $filename eq '' ) {
2773 my($value) = $buffer->readBody;
2774 push(@{$self->{$param}},$value);
2778 my ($tmpfile,$tmp,$filehandle);
2780 # If we get here, then we are dealing with a potentially large
2781 # uploaded form. Save the data to a temporary file, then open
2782 # the file for reading.
2784 # skip the file if uploads disabled
2785 if ($DISABLE_UPLOADS) {
2786 while (defined($data = $buffer->read)) { }
2790 # choose a relatively unpredictable tmpfile sequence number
2791 my $seqno = unpack("%16C*",join('',localtime,values %ENV));
2792 for (my $cnt=10;$cnt>0;$cnt--) {
2793 next unless $tmpfile = new TempFile($seqno);
2794 $tmp = $tmpfile->as_string;
2795 last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
2796 $seqno += int rand(100);
2798 die "CGI open of tmpfile: $!\n" unless $filehandle;
2799 $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
2803 while (defined($data = $buffer->read)) {
2804 print $filehandle $data;
2807 # back up to beginning of file
2808 seek($filehandle,0,0);
2809 $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
2811 # Save some information about the uploaded file where we can get
2813 $self->{'.tmpfiles'}->{fileno($filehandle)}= {
2817 push(@{$self->{$param}},$filehandle);
2823 'upload' =><<'END_OF_FUNC',
2825 my($self,$param_name) = self_or_default(@_);
2826 my $param = $self->param($param_name);
2827 return unless $param;
2828 return unless ref($param) && fileno($param);
2833 'tmpFileName' => <<'END_OF_FUNC',
2835 my($self,$filename) = self_or_default(@_);
2836 return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ?
2837 $self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string
2842 'uploadInfo' => <<'END_OF_FUNC',
2844 my($self,$filename) = self_or_default(@_);
2845 return $self->{'.tmpfiles'}->{fileno($filename)}->{info};
2849 # internal routine, don't use
2850 '_set_values_and_labels' => <<'END_OF_FUNC',
2851 sub _set_values_and_labels {
2854 $$l = $v if ref($v) eq 'HASH' && !ref($$l);
2855 return $self->param($n) if !defined($v);
2856 return $v if !ref($v);
2857 return ref($v) eq 'HASH' ? keys %$v : @$v;
2861 '_compile_all' => <<'END_OF_FUNC',
2864 next if defined(&$_);
2865 $AUTOLOAD = "CGI::$_";
2875 #########################################################
2876 # Globals and stubs for other packages that we use.
2877 #########################################################
2879 ################### Fh -- lightweight filehandle ###############
2888 *Fh::AUTOLOAD = \&CGI::AUTOLOAD;
2890 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2891 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2893 'asString' => <<'END_OF_FUNC',
2896 # get rid of package name
2897 (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//;
2901 # This was an extremely clever patch that allowed "use strict refs".
2902 # Unfortunately it relied on another bug that caused leaky file descriptors.
2903 # The underlying bug has been fixed, so this no longer works. However
2904 # "strict refs" still works for some reason.
2906 # return ${*{$self}{SCALAR}};
2911 'compare' => <<'END_OF_FUNC',
2915 return "$self" cmp $value;
2919 'new' => <<'END_OF_FUNC',
2921 my($pack,$name,$file,$delete) = @_;
2922 require Fcntl unless defined &Fcntl::O_RDWR;
2923 my $fv = ('Fh::' . ++$FH . quotemeta($name));
2926 sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
2927 unlink($file) if $delete;
2928 CORE::delete $Fh::{$FH};
2929 return bless $ref,$pack;
2933 'DESTROY' => <<'END_OF_FUNC',
2943 ######################## MultipartBuffer ####################
2944 package MultipartBuffer;
2946 # how many bytes to read at a time. We use
2947 # a 4K buffer by default.
2948 $INITIAL_FILLUNIT = 1024 * 4;
2949 $TIMEOUT = 240*60; # 4 hour timeout for big files
2950 $SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers
2953 #reuse the autoload function
2954 *MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
2956 # avoid autoloader warnings
2959 ###############################################################################
2960 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
2961 ###############################################################################
2962 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2963 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2966 'new' => <<'END_OF_FUNC',
2968 my($package,$interface,$boundary,$length,$filehandle) = @_;
2969 $FILLUNIT = $INITIAL_FILLUNIT;
2972 my($package) = caller;
2973 # force into caller's package if necessary
2974 $IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
2976 $IN = "main::STDIN" unless $IN;
2978 $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
2980 # If the user types garbage into the file upload field,
2981 # then Netscape passes NOTHING to the server (not good).
2982 # We may hang on this read in that case. So we implement
2983 # a read timeout. If nothing is ready to read
2984 # by then, we return.
2986 # Netscape seems to be a little bit unreliable
2987 # about providing boundary strings.
2988 my $boundary_read = 0;
2991 # Under the MIME spec, the boundary consists of the
2992 # characters "--" PLUS the Boundary string
2994 # BUG: IE 3.01 on the Macintosh uses just the boundary -- not
2995 # the two extra hyphens. We do a special case here on the user-agent!!!!
2996 $boundary = "--$boundary" unless CGI::user_agent('MSIE\s+3\.0[12];\s*Mac');
2998 } else { # otherwise we find it ourselves
3000 ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
3001 $boundary = <$IN>; # BUG: This won't work correctly under mod_perl
3002 $length -= length($boundary);
3003 chomp($boundary); # remove the CRLF
3004 $/ = $old; # restore old line separator
3008 my $self = {LENGTH=>$length,
3009 BOUNDARY=>$boundary,
3011 INTERFACE=>$interface,
3015 $FILLUNIT = length($boundary)
3016 if length($boundary) > $FILLUNIT;
3018 my $retval = bless $self,ref $package || $package;
3020 # Read the preamble and the topmost (boundary) line plus the CRLF.
3021 unless ($boundary_read) {
3022 while ($self->read(0)) { }
3024 die "Malformed multipart POST\n" if $self->eof;
3030 'readHeader' => <<'END_OF_FUNC',
3037 local($CRLF) = "\015\012" if $CGI::OS eq 'VMS';
3040 $self->fillBuffer($FILLUNIT);
3041 $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
3042 $ok++ if $self->{BUFFER} eq '';
3043 $bad++ if !$ok && $self->{LENGTH} <= 0;
3044 # this was a bad idea
3045 # $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT;
3046 } until $ok || $bad;
3049 my($header) = substr($self->{BUFFER},0,$end+2);
3050 substr($self->{BUFFER},0,$end+4) = '';
3054 # See RFC 2045 Appendix A and RFC 822 sections 3.4.8
3055 # (Folding Long Header Fields), 3.4.3 (Comments)
3056 # and 3.4.5 (Quoted-Strings).
3058 my $token = '[-\w!\#$%&\'*+.^_\`|{}~]';
3059 $header=~s/$CRLF\s+/ /og; # merge continuation lines
3060 while ($header=~/($token+):\s+([^$CRLF]*)/mgox) {
3061 my ($field_name,$field_value) = ($1,$2); # avoid taintedness
3062 $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize
3063 $return{$field_name}=$field_value;
3069 # This reads and returns the body as a single scalar value.
3070 'readBody' => <<'END_OF_FUNC',
3075 while (defined($data = $self->read)) {
3076 $returnval .= $data;
3082 # This will read $bytes or until the boundary is hit, whichever happens
3083 # first. After the boundary is hit, we return undef. The next read will
3084 # skip over the boundary and begin reading again;
3085 'read' => <<'END_OF_FUNC',
3087 my($self,$bytes) = @_;
3089 # default number of bytes to read
3090 $bytes = $bytes || $FILLUNIT;
3092 # Fill up our internal buffer in such a way that the boundary
3093 # is never split between reads.
3094 $self->fillBuffer($bytes);
3096 # Find the boundary in the buffer (it may not be there).
3097 my $start = index($self->{BUFFER},$self->{BOUNDARY});
3098 # protect against malformed multipart POST operations
3099 die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
3101 # If the boundary begins the data, then skip past it
3102 # and return undef. The +2 here is a fiendish plot to
3103 # remove the CR/LF pair at the end of the boundary.
3106 # clear us out completely if we've hit the last boundary.
3107 if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
3113 # just remove the boundary.
3114 substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
3119 if ($start > 0) { # read up to the boundary
3120 $bytesToReturn = $start > $bytes ? $bytes : $start;
3121 } else { # read the requested number of bytes
3122 # leave enough bytes in the buffer to allow us to read
3123 # the boundary. Thanks to Kevin Hendrick for finding
3125 $bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
3128 my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
3129 substr($self->{BUFFER},0,$bytesToReturn)='';
3131 # If we hit the boundary, remove the CRLF from the end.
3132 return ($start > 0) ? substr($returnval,0,-2) : $returnval;
3137 # This fills up our internal buffer in such a way that the
3138 # boundary is never split between reads
3139 'fillBuffer' => <<'END_OF_FUNC',
3141 my($self,$bytes) = @_;
3142 return unless $self->{LENGTH};
3144 my($boundaryLength) = length($self->{BOUNDARY});
3145 my($bufferLength) = length($self->{BUFFER});
3146 my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
3147 $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
3149 # Try to read some data. We may hang here if the browser is screwed up.
3150 my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
3154 $self->{BUFFER} = '' unless defined $self->{BUFFER};
3156 # An apparent bug in the Apache server causes the read()
3157 # to return zero bytes repeatedly without blocking if the
3158 # remote user aborts during a file transfer. I don't know how
3159 # they manage this, but the workaround is to abort if we get
3160 # more than SPIN_LOOP_MAX consecutive zero reads.
3161 if ($bytesRead == 0) {
3162 die "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
3163 if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
3165 $self->{ZERO_LOOP_COUNTER}=0;
3168 $self->{LENGTH} -= $bytesRead;
3173 # Return true when we've finished reading
3174 'eof' => <<'END_OF_FUNC'
3177 return 1 if (length($self->{BUFFER}) == 0)
3178 && ($self->{LENGTH} <= 0);
3186 ####################################################################################
3187 ################################## TEMPORARY FILES #################################
3188 ####################################################################################
3192 $MAC = $CGI::OS eq 'MACINTOSH';
3193 my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
3194 unless ($TMPDIRECTORY) {
3195 @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
3196 "C:${SL}temp","${SL}tmp","${SL}temp",
3197 "${vol}${SL}Temporary Items",
3198 "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH");
3199 unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'};
3201 # this feature was supposed to provide per-user tmpfiles, but
3202 # it is problematic.
3203 # unshift(@TEMP,(getpwuid($<))[7].'/tmp') if $CGI::OS eq 'UNIX';
3204 # Rob: getpwuid() is unfortunately UNIX specific. On brain dead OS'es this
3205 # : can generate a 'getpwuid() not implemented' exception, even though
3206 # : it's never called. Found under DOS/Win with the DJGPP perl port.
3207 # : Refer to getpwuid() only at run-time if we're fortunate and have UNIX.
3208 # unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
3211 do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
3215 $TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY;
3218 # cute feature, but overload implementation broke it
3219 # %OVERLOAD = ('""'=>'as_string');
3220 *TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
3222 ###############################################################################
3223 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
3224 ###############################################################################
3225 $AUTOLOADED_ROUTINES = ''; # prevent -w error
3226 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
3229 'new' => <<'END_OF_FUNC',
3231 my($package,$sequence) = @_;
3233 for (my $i = 0; $i < $MAXTRIES; $i++) {
3234 last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
3236 # untaint the darn thing
3237 return unless $filename =~ m!^([a-zA-Z0-9_ '":/.\$\\]+)$!;
3239 return bless \$filename;
3243 'DESTROY' => <<'END_OF_FUNC',
3246 unlink $$self; # get rid of the file
3250 'as_string' => <<'END_OF_FUNC'
3262 # We get a whole bunch of warnings about "possibly uninitialized variables"
3263 # when running with the -w switch. Touch them all once to get rid of the
3264 # warnings. This is ugly and I hate it.
3269 $MultipartBuffer::SPIN_LOOP_MAX;
3270 $MultipartBuffer::CRLF;
3271 $MultipartBuffer::TIMEOUT;
3272 $MultipartBuffer::INITIAL_FILLUNIT;
3283 CGI - Simple Common Gateway Interface Class
3287 # CGI script that creates a fill-out form
3288 # and echoes back its values.
3290 use CGI qw/:standard/;
3292 start_html('A Simple Example'),
3293 h1('A Simple Example'),
3295 "What's your name? ",textfield('name'),p,
3296 "What's the combination?", p,
3297 checkbox_group(-name=>'words',
3298 -values=>['eenie','meenie','minie','moe'],
3299 -defaults=>['eenie','minie']), p,
3300 "What's your favorite color? ",
3301 popup_menu(-name=>'color',
3302 -values=>['red','green','blue','chartreuse']),p,
3308 print "Your name is",em(param('name')),p,
3309 "The keywords are: ",em(join(", ",param('words'))),p,
3310 "Your favorite color is ",em(param('color')),
3316 This perl library uses perl5 objects to make it easy to create Web
3317 fill-out forms and parse their contents. This package defines CGI
3318 objects, entities that contain the values of the current query string
3319 and other state variables. Using a CGI object's methods, you can
3320 examine keywords and parameters passed to your script, and create
3321 forms whose initial values are taken from the current query (thereby
3322 preserving state information). The module provides shortcut functions
3323 that produce boilerplate HTML, reducing typing and coding errors. It
3324 also provides functionality for some of the more advanced features of
3325 CGI scripting, including support for file uploads, cookies, cascading
3326 style sheets, server push, and frames.
3328 CGI.pm also provides a simple function-oriented programming style for
3329 those who don't need its object-oriented features.
3331 The current version of CGI.pm is available at
3333 http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
3334 ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
3338 =head2 PROGRAMMING STYLE
3340 There are two styles of programming with CGI.pm, an object-oriented
3341 style and a function-oriented style. In the object-oriented style you
3342 create one or more CGI objects and then use object methods to create
3343 the various elements of the page. Each CGI object starts out with the
3344 list of named parameters that were passed to your CGI script by the
3345 server. You can modify the objects, save them to a file or database
3346 and recreate them. Because each object corresponds to the "state" of
3347 the CGI script, and because each object's parameter list is
3348 independent of the others, this allows you to save the state of the
3349 script and restore it later.
3351 For example, using the object oriented style, here is how you create
3352 a simple "Hello World" HTML page:
3354 #!/usr/local/bin/perl -w
3355 use CGI; # load CGI routines
3356 $q = new CGI; # create new CGI object
3357 print $q->header, # create the HTTP header
3358 $q->start_html('hello world'), # start the HTML
3359 $q->h1('hello world'), # level 1 header
3360 $q->end_html; # end the HTML
3362 In the function-oriented style, there is one default CGI object that
3363 you rarely deal with directly. Instead you just call functions to
3364 retrieve CGI parameters, create HTML tags, manage cookies, and so
3365 on. This provides you with a cleaner programming interface, but
3366 limits you to using one CGI object at a time. The following example
3367 prints the same page, but uses the function-oriented interface.
3368 The main differences are that we now need to import a set of functions
3369 into our name space (usually the "standard" functions), and we don't
3370 need to create the CGI object.
3372 #!/usr/local/bin/perl
3373 use CGI qw/:standard/; # load standard CGI routines
3374 print header, # create the HTTP header
3375 start_html('hello world'), # start the HTML
3376 h1('hello world'), # level 1 header
3377 end_html; # end the HTML
3379 The examples in this document mainly use the object-oriented style.
3380 See HOW TO IMPORT FUNCTIONS for important information on
3381 function-oriented programming in CGI.pm
3383 =head2 CALLING CGI.PM ROUTINES
3385 Most CGI.pm routines accept several arguments, sometimes as many as 20
3386 optional ones! To simplify this interface, all routines use a named
3387 argument calling style that looks like this:
3389 print $q->header(-type=>'image/gif',-expires=>'+3d');
3391 Each argument name is preceded by a dash. Neither case nor order
3392 matters in the argument list. -type, -Type, and -TYPE are all
3393 acceptable. In fact, only the first argument needs to begin with a
3394 dash. If a dash is present in the first argument, CGI.pm assumes
3395 dashes for the subsequent ones.
3397 Several routines are commonly called with just one argument. In the
3398 case of these routines you can provide the single argument without an
3399 argument name. header() happens to be one of these routines. In this
3400 case, the single argument is the document type.
3402 print $q->header('text/html');
3404 Other such routines are documented below.
3406 Sometimes named arguments expect a scalar, sometimes a reference to an
3407 array, and sometimes a reference to a hash. Often, you can pass any
3408 type of argument and the routine will do whatever is most appropriate.
3409 For example, the param() routine is used to set a CGI parameter to a
3410 single or a multi-valued value. The two cases are shown below:
3412 $q->param(-name=>'veggie',-value=>'tomato');
3413 $q->param(-name=>'veggie',-value=>['tomato','tomahto','potato','potahto']);
3415 A large number of routines in CGI.pm actually aren't specifically
3416 defined in the module, but are generated automatically as needed.
3417 These are the "HTML shortcuts," routines that generate HTML tags for
3418 use in dynamically-generated pages. HTML tags have both attributes
3419 (the attribute="value" pairs within the tag itself) and contents (the
3420 part between the opening and closing pairs.) To distinguish between
3421 attributes and contents, CGI.pm uses the convention of passing HTML
3422 attributes as a hash reference as the first argument, and the
3423 contents, if any, as any subsequent arguments. It works out like
3429 h1('some','contents'); <H1>some contents</H1>
3430 h1({-align=>left}); <H1 ALIGN="LEFT">
3431 h1({-align=>left},'contents'); <H1 ALIGN="LEFT">contents</H1>
3433 HTML tags are described in more detail later.
3435 Many newcomers to CGI.pm are puzzled by the difference between the
3436 calling conventions for the HTML shortcuts, which require curly braces
3437 around the HTML tag attributes, and the calling conventions for other
3438 routines, which manage to generate attributes without the curly
3439 brackets. Don't be confused. As a convenience the curly braces are
3440 optional in all but the HTML shortcuts. If you like, you can use
3441 curly braces when calling any routine that takes named arguments. For
3444 print $q->header( {-type=>'image/gif',-expires=>'+3d'} );
3446 If you use the B<-w> switch, you will be warned that some CGI.pm argument
3447 names conflict with built-in Perl functions. The most frequent of
3448 these is the -values argument, used to create multi-valued menus,
3449 radio button clusters and the like. To get around this warning, you
3450 have several choices:
3454 =item 1. Use another name for the argument, if one is available. For
3455 example, -value is an alias for -values.
3457 =item 2. Change the capitalization, e.g. -Values
3459 =item 3. Put quotes around the argument name, e.g. '-values'
3463 Many routines will do something useful with a named argument that it
3464 doesn't recognize. For example, you can produce non-standard HTTP
3465 header fields by providing them as named arguments:
3467 print $q->header(-type => 'text/html',
3468 -cost => 'Three smackers',
3469 -annoyance_level => 'high',
3470 -complaints_to => 'bit bucket');
3472 This will produce the following nonstandard HTTP header:
3475 Cost: Three smackers
3476 Annoyance-level: high
3477 Complaints-to: bit bucket
3478 Content-type: text/html
3480 Notice the way that underscores are translated automatically into
3481 hyphens. HTML-generating routines perform a different type of
3484 This feature allows you to keep up with the rapidly changing HTTP and
3487 =head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
3491 This will parse the input (from both POST and GET methods) and store
3492 it into a perl5 object called $query.
3494 =head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
3496 $query = new CGI(INPUTFILE);
3498 If you provide a file handle to the new() method, it will read
3499 parameters from the file (or STDIN, or whatever). The file can be in
3500 any of the forms describing below under debugging (i.e. a series of
3501 newline delimited TAG=VALUE pairs will work). Conveniently, this type
3502 of file is created by the save() method (see below). Multiple records
3503 can be saved and restored.
3505 Perl purists will be pleased to know that this syntax accepts
3506 references to file handles, or even references to filehandle globs,
3507 which is the "official" way to pass a filehandle:
3509 $query = new CGI(\*STDIN);
3511 You can also initialize the CGI object with a FileHandle or IO::File
3514 If you are using the function-oriented interface and want to
3515 initialize CGI state from a file handle, the way to do this is with
3516 B<restore_parameters()>. This will (re)initialize the
3517 default CGI object from the indicated file handle.
3519 open (IN,"test.in") || die;
3520 restore_parameters(IN);
3523 You can also initialize the query object from an associative array
3526 $query = new CGI( {'dinosaur'=>'barney',
3527 'song'=>'I love you',
3528 'friends'=>[qw/Jessica George Nancy/]}
3531 or from a properly formatted, URL-escaped query string:
3533 $query = new CGI('dinosaur=barney&color=purple');
3535 or from a previously existing CGI object (currently this clones the
3536 parameter list, but none of the other object-specific fields, such as
3539 $old_query = new CGI;
3540 $new_query = new CGI($old_query);
3542 To create an empty query, initialize it from an empty string or hash:
3544 $empty_query = new CGI("");
3548 $empty_query = new CGI({});
3550 =head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
3552 @keywords = $query->keywords
3554 If the script was invoked as the result of an <ISINDEX> search, the
3555 parsed keywords can be obtained as an array using the keywords() method.
3557 =head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT:
3559 @names = $query->param
3561 If the script was invoked with a parameter list
3562 (e.g. "name1=value1&name2=value2&name3=value3"), the param() method
3563 will return the parameter names as a list. If the script was invoked
3564 as an <ISINDEX> script and contains a string without ampersands
3565 (e.g. "value1+value2+value3") , there will be a single parameter named
3566 "keywords" containing the "+"-delimited keywords.
3568 NOTE: As of version 1.5, the array of parameter names returned will
3569 be in the same order as they were submitted by the browser.
3570 Usually this order is the same as the order in which the
3571 parameters are defined in the form (however, this isn't part
3572 of the spec, and so isn't guaranteed).
3574 =head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER:
3576 @values = $query->param('foo');
3580 $value = $query->param('foo');
3582 Pass the param() method a single argument to fetch the value of the
3583 named parameter. If the parameter is multivalued (e.g. from multiple
3584 selections in a scrolling list), you can ask to receive an array. Otherwise
3585 the method will return a single value.
3587 If a value is not given in the query string, as in the queries
3588 "name1=&name2=" or "name1&name2", it will be returned as an empty
3589 string. This feature is new in 2.63.
3591 =head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
3593 $query->param('foo','an','array','of','values');
3595 This sets the value for the named parameter 'foo' to an array of
3596 values. This is one way to change the value of a field AFTER
3597 the script has been invoked once before. (Another way is with
3598 the -override parameter accepted by all methods that generate
3601 param() also recognizes a named parameter style of calling described
3602 in more detail later:
3604 $query->param(-name=>'foo',-values=>['an','array','of','values']);
3608 $query->param(-name=>'foo',-value=>'the value');
3610 =head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
3612 $query->append(-name=>'foo',-values=>['yet','more','values']);
3614 This adds a value or list of values to the named parameter. The
3615 values are appended to the end of the parameter if it already exists.
3616 Otherwise the parameter is created. Note that this method only
3617 recognizes the named argument calling syntax.
3619 =head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE:
3621 $query->import_names('R');
3623 This creates a series of variables in the 'R' namespace. For example,
3624 $R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear.
3625 If no namespace is given, this method will assume 'Q'.
3626 WARNING: don't import anything into 'main'; this is a major security
3629 In older versions, this method was called B<import()>. As of version 2.20,
3630 this name has been removed completely to avoid conflict with the built-in
3631 Perl module B<import> operator.
3633 =head2 DELETING A PARAMETER COMPLETELY:
3635 $query->delete('foo');
3637 This completely clears a parameter. It sometimes useful for
3638 resetting parameters that you don't want passed down between
3641 If you are using the function call interface, use "Delete()" instead
3642 to avoid conflicts with Perl's built-in delete operator.
3644 =head2 DELETING ALL PARAMETERS:
3646 $query->delete_all();
3648 This clears the CGI object completely. It might be useful to ensure
3649 that all the defaults are taken when you create a fill-out form.
3651 Use Delete_all() instead if you are using the function call interface.
3653 =head2 DIRECT ACCESS TO THE PARAMETER LIST:
3655 $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
3656 unshift @{$q->param_fetch(-name=>'address')},'George Munster';
3658 If you need access to the parameter list in a way that isn't covered
3659 by the methods above, you can obtain a direct reference to it by
3660 calling the B<param_fetch()> method with the name of the . This
3661 will return an array reference to the named parameters, which you then
3662 can manipulate in any way you like.
3664 You can also use a named argument style using the B<-name> argument.
3666 =head2 FETCHING THE PARAMETER LIST AS A HASH:
3669 print $params->{'address'};
3670 @foo = split("\0",$params->{'foo'});
3676 Many people want to fetch the entire parameter list as a hash in which
3677 the keys are the names of the CGI parameters, and the values are the
3678 parameters' values. The Vars() method does this. Called in a scalar
3679 context, it returns the parameter list as a tied hash reference.
3680 Changing a key changes the value of the parameter in the underlying
3681 CGI parameter list. Called in an array context, it returns the
3682 parameter list as an ordinary hash. This allows you to read the
3683 contents of the parameter list, but not to change it.
3685 When using this, the thing you must watch out for are multivalued CGI
3686 parameters. Because a hash cannot distinguish between scalar and
3687 array context, multivalued parameters will be returned as a packed
3688 string, separated by the "\0" (null) character. You must split this
3689 packed string in order to get at the individual values. This is the
3690 convention introduced long ago by Steve Brenner in his cgi-lib.pl
3691 module for Perl version 4.
3693 If you wish to use Vars() as a function, import the I<:cgi-lib> set of
3694 function calls (also see the section on CGI-LIB compatibility).
3696 =head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
3698 $query->save(FILEHANDLE)
3700 This will write the current state of the form to the provided
3701 filehandle. You can read it back in by providing a filehandle
3702 to the new() method. Note that the filehandle can be a file, a pipe,
3705 The format of the saved file is:
3713 Both name and value are URL escaped. Multi-valued CGI parameters are
3714 represented as repeated names. A session record is delimited by a
3715 single = symbol. You can write out multiple records and read them
3716 back in with several calls to B<new>. You can do this across several
3717 sessions by opening the file in append mode, allowing you to create
3718 primitive guest books, or to keep a history of users' queries. Here's
3719 a short example of creating multiple session records:
3723 open (OUT,">>test.out") || die;
3725 foreach (0..$records) {
3727 $q->param(-name=>'counter',-value=>$_);
3732 # reopen for reading
3733 open (IN,"test.out") || die;
3735 my $q = new CGI(IN);
3736 print $q->param('counter'),"\n";
3739 The file format used for save/restore is identical to that used by the
3740 Whitehead Genome Center's data exchange format "Boulderio", and can be
3741 manipulated and even databased using Boulderio utilities. See
3743 http://stein.cshl.org/boulder/
3745 for further details.
3747 If you wish to use this method from the function-oriented (non-OO)
3748 interface, the exported name for this method is B<save_parameters()>.
3750 =head2 RETRIEVING CGI ERRORS
3752 Errors can occur while processing user input, particularly when
3753 processing uploaded files. When these errors occur, CGI will stop
3754 processing and return an empty parameter list. You can test for
3755 the existence and nature of errors using the I<cgi_error()> function.
3756 The error messages are formatted as HTTP status codes. You can either
3757 incorporate the error text into an HTML page, or use it as the value
3760 my $error = $q->cgi_error;
3762 print $q->header(-status=>$error),
3763 $q->start_html('Problems'),
3764 $q->h2('Request not processed'),
3769 When using the function-oriented interface (see the next section),
3770 errors may only occur the first time you call I<param()>. Be ready
3773 =head2 USING THE FUNCTION-ORIENTED INTERFACE
3775 To use the function-oriented interface, you must specify which CGI.pm
3776 routines or sets of routines to import into your script's namespace.
3777 There is a small overhead associated with this importation, but it
3780 use CGI <list of methods>;
3782 The listed methods will be imported into the current package; you can
3783 call them directly without creating a CGI object first. This example
3784 shows how to import the B<param()> and B<header()>
3785 methods, and then use them directly:
3787 use CGI 'param','header';
3788 print header('text/plain');
3789 $zipcode = param('zipcode');
3791 More frequently, you'll import common sets of functions by referring
3792 to the groups by name. All function sets are preceded with a ":"
3793 character as in ":html3" (for tags defined in the HTML 3 standard).
3795 Here is a list of the function sets you can import:
3801 Import all CGI-handling methods, such as B<param()>, B<path_info()>
3806 Import all fill-out form generating methods, such as B<textfield()>.
3810 Import all methods that generate HTML 2.0 standard elements.
3814 Import all methods that generate HTML 3.0 proposed elements (such as
3815 <table>, <super> and <sub>).
3819 Import all methods that generate Netscape-specific HTML extensions.
3823 Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
3828 Import "standard" features, 'html2', 'html3', 'form' and 'cgi'.
3832 Import all the available methods. For the full list, see the CGI.pm
3833 code, where the variable %EXPORT_TAGS is defined.
3837 If you import a function name that is not part of CGI.pm, the module
3838 will treat it as a new HTML tag and generate the appropriate
3839 subroutine. You can then use it like any other HTML tag. This is to
3840 provide for the rapidly-evolving HTML "standard." For example, say
3841 Microsoft comes out with a new tag called <GRADIENT> (which causes the
3842 user's desktop to be flooded with a rotating gradient fill until his
3843 machine reboots). You don't need to wait for a new version of CGI.pm
3844 to start using it immediately:
3846 use CGI qw/:standard :html3 gradient/;
3847 print gradient({-start=>'red',-end=>'blue'});
3849 Note that in the interests of execution speed CGI.pm does B<not> use
3850 the standard L<Exporter> syntax for specifying load symbols. This may
3851 change in the future.
3853 If you import any of the state-maintaining CGI or form-generating
3854 methods, a default CGI object will be created and initialized
3855 automatically the first time you use any of the methods that require
3856 one to be present. This includes B<param()>, B<textfield()>,
3857 B<submit()> and the like. (If you need direct access to the CGI
3858 object, you can find it in the global variable B<$CGI::Q>). By
3859 importing CGI.pm methods, you can create visually elegant scripts:
3861 use CGI qw/:standard/;
3864 start_html('Simple Script'),
3865 h1('Simple Script'),
3867 "What's your name? ",textfield('name'),p,
3868 "What's the combination?",
3869 checkbox_group(-name=>'words',
3870 -values=>['eenie','meenie','minie','moe'],
3871 -defaults=>['eenie','moe']),p,
3872 "What's your favorite color?",
3873 popup_menu(-name=>'color',
3874 -values=>['red','green','blue','chartreuse']),p,
3881 "Your name is ",em(param('name')),p,
3882 "The keywords are: ",em(join(", ",param('words'))),p,
3883 "Your favorite color is ",em(param('color')),".\n";
3889 In addition to the function sets, there are a number of pragmas that
3890 you can import. Pragmas, which are always preceded by a hyphen,
3891 change the way that CGI.pm functions in various ways. Pragmas,
3892 function sets, and individual functions can all be imported in the
3893 same use() line. For example, the following use statement imports the
3894 standard set of functions and enables debugging mode (pragma
3897 use CGI qw/:standard -debug/;
3899 The current list of pragmas is as follows:
3905 When you I<use CGI -any>, then any method that the query object
3906 doesn't recognize will be interpreted as a new HTML tag. This allows
3907 you to support the next I<ad hoc> Netscape or Microsoft HTML
3908 extension. This lets you go wild with new and unsupported tags:
3912 print $q->gradient({speed=>'fast',start=>'red',end=>'blue'});
3914 Since using <cite>any</cite> causes any mistyped method name
3915 to be interpreted as an HTML tag, use it with care or not at
3920 This causes the indicated autoloaded methods to be compiled up front,
3921 rather than deferred to later. This is useful for scripts that run
3922 for an extended period of time under FastCGI or mod_perl, and for
3923 those destined to be crunched by Malcom Beattie's Perl compiler. Use
3924 it in conjunction with the methods or method families you plan to use.
3926 use CGI qw(-compile :standard :html3);
3930 use CGI qw(-compile :all);
3932 Note that using the -compile pragma in this way will always have
3933 the effect of importing the compiled functions into the current
3934 namespace. If you want to compile without importing use the
3935 compile() method instead (see below).
3939 This makes CGI.pm not generating the hidden fields .submit
3940 and .cgifields. It is very useful if you don't want to
3941 have the hidden fields appear in the querystring in a GET method.
3942 For example, a search script generated this way will have
3943 a very nice url with search parameters for bookmarking.
3947 This makes CGI.pm produce a header appropriate for an NPH (no
3948 parsed header) script. You may need to do other things as well
3949 to tell the server that the script is NPH. See the discussion
3950 of NPH scripts below.
3952 =item -newstyle_urls
3954 Separate the name=value pairs in CGI parameter query strings with
3955 semicolons rather than ampersands. For example:
3957 ?name=fred;age=24;favorite_color=3
3959 Semicolon-delimited query strings are always accepted, but will not be
3960 emitted by self_url() and query_string() unless the -newstyle_urls
3961 pragma is specified.
3963 This became the default in version 2.64.
3965 =item -oldstyle_urls
3967 Separate the name=value pairs in CGI parameter query strings with
3968 ampersands rather than semicolons. This is no longer the default.
3972 This overrides the autoloader so that any function in your program
3973 that is not recognized is referred to CGI.pm for possible evaluation.
3974 This allows you to use all the CGI.pm functions without adding them to
3975 your symbol table, which is of concern for mod_perl users who are
3976 worried about memory consumption. I<Warning:> when
3977 I<-autoload> is in effect, you cannot use "poetry mode"
3978 (functions without the parenthesis). Use I<hr()> rather
3979 than I<hr>, or add something like I<use subs qw/hr p header/>
3980 to the top of your script.
3984 This turns off the command-line processing features. If you want to
3985 run a CGI.pm script from the command line to produce HTML, and you
3986 don't want it to read CGI parameters from the command line or STDIN,
3987 then use this pragma:
3989 use CGI qw(-no_debug :standard);
3993 This turns on full debugging. In addition to reading CGI arguments
3994 from the command-line processing, CGI.pm will pause and try to read
3995 arguments from STDIN, producing the message "(offline mode: enter
3996 name=value pairs on standard input)" features.
3998 See the section on debugging for more details.
4000 =item -private_tempfiles
4002 CGI.pm can process uploaded file. Ordinarily it spools the uploaded
4003 file to a temporary directory, then deletes the file when done.
4004 However, this opens the risk of eavesdropping as described in the file
4005 upload section. Another CGI script author could peek at this data
4006 during the upload, even if it is confidential information. On Unix
4007 systems, the -private_tempfiles pragma will cause the temporary file
4008 to be unlinked as soon as it is opened and before any data is written
4009 into it, reducing, but not eliminating the risk of eavesdropping
4010 (there is still a potential race condition). To make life harder for
4011 the attacker, the program chooses tempfile names by calculating a 32
4012 bit checksum of the incoming HTTP headers.
4014 To ensure that the temporary file cannot be read by other CGI scripts,
4015 use suEXEC or a CGI wrapper program to run your script. The temporary
4016 file is created with mode 0600 (neither world nor group readable).
4018 The temporary directory is selected using the following algorithm:
4020 1. if the current user (e.g. "nobody") has a directory named
4021 "tmp" in its home directory, use that (Unix systems only).
4023 2. if the environment variable TMPDIR exists, use the location
4026 3. Otherwise try the locations /usr/tmp, /var/tmp, C:\temp,
4027 /tmp, /temp, ::Temporary Items, and \WWW_ROOT.
4029 Each of these locations is checked that it is a directory and is
4030 writable. If not, the algorithm tries the next choice.
4034 =head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS
4036 Many of the methods generate HTML tags. As described below, tag
4037 functions automatically generate both the opening and closing tags.
4040 print h1('Level 1 Header');
4044 <H1>Level 1 Header</H1>
4046 There will be some times when you want to produce the start and end
4047 tags yourself. In this case, you can use the form start_I<tag_name>
4048 and end_I<tag_name>, as in:
4050 print start_h1,'Level 1 Header',end_h1;
4052 With a few exceptions (described below), start_I<tag_name> and
4053 end_I<tag_name> functions are not generated automatically when you
4054 I<use CGI>. However, you can specify the tags you want to generate
4055 I<start/end> functions for by putting an asterisk in front of their
4056 name, or, alternatively, requesting either "start_I<tag_name>" or
4057 "end_I<tag_name>" in the import list.
4061 use CGI qw/:standard *table start_ul/;
4063 In this example, the following functions are generated in addition to
4068 =item 1. start_table() (generates a <TABLE> tag)
4070 =item 2. end_table() (generates a </TABLE> tag)
4072 =item 3. start_ul() (generates a <UL> tag)
4074 =item 4. end_ul() (generates a </UL> tag)
4078 =head1 GENERATING DYNAMIC DOCUMENTS
4080 Most of CGI.pm's functions deal with creating documents on the fly.
4081 Generally you will produce the HTTP header first, followed by the
4082 document itself. CGI.pm provides functions for generating HTTP
4083 headers of various types as well as for generating HTML. For creating
4084 GIF images, see the GD.pm module.
4086 Each of these functions produces a fragment of HTML or HTTP which you
4087 can print out directly so that it displays in the browser window,
4088 append to a string, or save to a file for later use.
4090 =head2 CREATING A STANDARD HTTP HEADER:
4092 Normally the first thing you will do in any CGI script is print out an
4093 HTTP header. This tells the browser what type of document to expect,
4094 and gives other optional information, such as the language, expiration
4095 date, and whether to cache the document. The header can also be
4096 manipulated for special purposes, such as server push and pay per view
4099 print $query->header;
4103 print $query->header('image/gif');
4107 print $query->header('text/html','204 No response');
4111 print $query->header(-type=>'image/gif',
4113 -status=>'402 Payment required',
4119 header() returns the Content-type: header. You can provide your own
4120 MIME type if you choose, otherwise it defaults to text/html. An
4121 optional second parameter specifies the status code and a human-readable
4122 message. For example, you can specify 204, "No response" to create a
4123 script that tells the browser to do nothing at all.
4125 The last example shows the named argument style for passing arguments
4126 to the CGI methods using named parameters. Recognized parameters are
4127 B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other named
4128 parameters will be stripped of their initial hyphens and turned into
4129 header fields, allowing you to specify any HTTP header you desire.
4130 Internal underscores will be turned into hyphens:
4132 print $query->header(-Content_length=>3002);
4134 Most browsers will not cache the output from CGI scripts. Every time
4135 the browser reloads the page, the script is invoked anew. You can
4136 change this behavior with the B<-expires> parameter. When you specify
4137 an absolute or relative expiration interval with this parameter, some
4138 browsers and proxy servers will cache the script's output until the
4139 indicated expiration date. The following forms are all valid for the
4142 +30s 30 seconds from now
4143 +10m ten minutes from now
4144 +1h one hour from now
4145 -1d yesterday (i.e. "ASAP!")
4148 +10y in ten years time
4149 Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date
4151 The B<-cookie> parameter generates a header that tells the browser to provide
4152 a "magic cookie" during all subsequent transactions with your script.
4153 Netscape cookies have a special format that includes interesting attributes
4154 such as expiration time. Use the cookie() method to create and retrieve
4157 The B<-nph> parameter, if set to a true value, will issue the correct
4158 headers to work with a NPH (no-parse-header) script. This is important
4159 to use with certain servers that expect all their scripts to be NPH.
4161 The B<-charset> parameter can be used to control the character set
4162 sent to the browser. If not provided, defaults to ISO-8859-1. As a
4163 side effect, this sets the charset() method as well.
4165 =head2 GENERATING A REDIRECTION HEADER
4167 print $query->redirect('http://somewhere.else/in/movie/land');
4169 Sometimes you don't want to produce a document yourself, but simply
4170 redirect the browser elsewhere, perhaps choosing a URL based on the
4171 time of day or the identity of the user.
4173 The redirect() function redirects the browser to a different URL. If
4174 you use redirection like this, you should B<not> print out a header as
4175 well. As of version 2.0, we produce both the unofficial Location:
4176 header and the official URI: header. This should satisfy most servers
4179 One hint I can offer is that relative links may not work correctly
4180 when you generate a redirection to another document on your site.
4181 This is due to a well-intentioned optimization that some servers use.
4182 The solution to this is to use the full URL (including the http: part)
4183 of the document you are redirecting to.
4185 You can also use named arguments:
4187 print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
4190 The B<-nph> parameter, if set to a true value, will issue the correct
4191 headers to work with a NPH (no-parse-header) script. This is important
4192 to use with certain servers, such as Microsoft Internet Explorer, which
4193 expect all their scripts to be NPH.
4195 =head2 CREATING THE HTML DOCUMENT HEADER
4197 print $query->start_html(-title=>'Secrets of the Pyramids',
4198 -author=>'fred@capricorn.org',
4201 -meta=>{'keywords'=>'pharaoh secret mummy',
4202 'copyright'=>'copyright 1996 King Tut'},
4203 -style=>{'src'=>'/styles/style1.css'},
4206 After creating the HTTP header, most CGI scripts will start writing
4207 out an HTML document. The start_html() routine creates the top of the
4208 page, along with a lot of optional information that controls the
4209 page's appearance and behavior.
4211 This method returns a canned HTML header and the opening <BODY> tag.
4212 All parameters are optional. In the named parameter form, recognized
4213 parameters are -title, -author, -base, -xbase and -target (see below
4214 for the explanation). Any additional parameters you provide, such as
4215 the Netscape unofficial BGCOLOR attribute, are added to the <BODY>
4216 tag. Additional parameters must be proceeded by a hyphen.
4218 The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
4219 different from the current location, as in
4221 -xbase=>"http://home.mcom.com/"
4223 All relative links will be interpreted relative to this tag.
4225 The argument B<-target> allows you to provide a default target frame
4226 for all the links and fill-out forms on the page. B<This is a
4227 non-standard HTTP feature which only works with Netscape browsers!>
4228 See the Netscape documentation on frames for details of how to
4231 -target=>"answer_window"
4233 All relative links will be interpreted relative to this tag.
4234 You add arbitrary meta information to the header with the B<-meta>
4235 argument. This argument expects a reference to an associative array
4236 containing name/value pairs of meta information. These will be turned
4237 into a series of header <META> tags that look something like this:
4239 <META NAME="keywords" CONTENT="pharaoh secret mummy">
4240 <META NAME="description" CONTENT="copyright 1996 King Tut">
4242 There is no direct support for the HTTP-EQUIV type of <META> tag.
4243 This is because you can modify the HTTP header directly with the
4244 B<header()> method. For example, if you want to send the Refresh:
4245 header, do it in the header() method:
4247 print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
4249 The B<-style> tag is used to incorporate cascading stylesheets into
4250 your code. See the section on CASCADING STYLESHEETS for more information.
4252 You can place other arbitrary HTML elements to the <HEAD> section with the
4253 B<-head> tag. For example, to place the rarely-used <LINK> element in the
4254 head section, use this:
4256 print start_html(-head=>Link({-rel=>'next',
4257 -href=>'http://www.capricorn.com/s2.html'}));
4259 To incorporate multiple HTML elements into the <HEAD> section, just pass an
4262 print start_html(-head=>[
4264 -href=>'http://www.capricorn.com/s2.html'}),
4265 Link({-rel=>'previous',
4266 -href=>'http://www.capricorn.com/s1.html'})
4270 JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
4271 B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
4272 to add Netscape JavaScript calls to your pages. B<-script> should
4273 point to a block of text containing JavaScript function definitions.
4274 This block will be placed within a <SCRIPT> block inside the HTML (not
4275 HTTP) header. The block is placed in the header in order to give your
4276 page a fighting chance of having all its JavaScript functions in place
4277 even if the user presses the stop button before the page has loaded
4278 completely. CGI.pm attempts to format the script in such a way that
4279 JavaScript-naive browsers will not choke on the code: unfortunately
4280 there are some browsers, such as Chimera for Unix, that get confused
4283 The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
4284 code to execute when the page is respectively opened and closed by the
4285 browser. Usually these parameters are calls to functions defined in the
4289 print $query->header;
4291 // Ask a silly question
4292 function riddle_me_this() {
4293 var r = prompt("What walks on four legs in the morning, " +
4294 "two legs in the afternoon, " +
4295 "and three legs in the evening?");
4298 // Get a silly answer
4299 function response(answer) {
4300 if (answer == "man")
4301 alert("Right you are!");
4303 alert("Wrong! Guess again.");
4306 print $query->start_html(-title=>'The Riddle of the Sphinx',
4309 Use the B<-noScript> parameter to pass some HTML text that will be displayed on
4310 browsers that do not have JavaScript (or browsers where JavaScript is turned
4313 Netscape 3.0 recognizes several attributes of the <SCRIPT> tag,
4314 including LANGUAGE and SRC. The latter is particularly interesting,
4315 as it allows you to keep the JavaScript code in a file or CGI script
4316 rather than cluttering up each page with the source. To use these
4317 attributes pass a HASH reference in the B<-script> parameter containing
4318 one or more of -language, -src, or -code:
4320 print $q->start_html(-title=>'The Riddle of the Sphinx',
4321 -script=>{-language=>'JAVASCRIPT',
4322 -src=>'/javascript/sphinx.js'}
4325 print $q->(-title=>'The Riddle of the Sphinx',
4326 -script=>{-language=>'PERLSCRIPT',
4327 -code=>'print "hello world!\n;"'}
4331 A final feature allows you to incorporate multiple <SCRIPT> sections into the
4332 header. Just pass the list of script sections as an array reference.
4333 this allows you to specify different source files for different dialects
4334 of JavaScript. Example:
4336 print $q->start_html(-title=>'The Riddle of the Sphinx',
4338 { -language => 'JavaScript1.0',
4339 -src => '/javascript/utilities10.js'
4341 { -language => 'JavaScript1.1',
4342 -src => '/javascript/utilities11.js'
4344 { -language => 'JavaScript1.2',
4345 -src => '/javascript/utilities12.js'
4347 { -language => 'JavaScript28.2',
4348 -src => '/javascript/utilities219.js'
4354 If this looks a bit extreme, take my advice and stick with straight CGI scripting.
4358 http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
4360 for more information about JavaScript.
4362 The old-style positional parameters are as follows:
4366 =item B<Parameters:>
4374 The author's e-mail address (will create a <LINK REV="MADE"> tag if present
4378 A 'true' flag if you want to include a <BASE> tag in the header. This
4379 helps resolve relative addresses to absolute ones when the document is moved,
4380 but makes the document hierarchy non-portable. Use with care!
4384 Any other parameters you want to include in the <BODY> tag. This is a good
4385 place to put Netscape extensions, such as colors and wallpaper patterns.
4389 =head2 ENDING THE HTML DOCUMENT:
4391 print $query->end_html
4393 This ends an HTML document by printing the </BODY></HTML> tags.
4395 =head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
4397 $myself = $query->self_url;
4398 print q(<A HREF="$myself">I'm talking to myself.</A>);
4400 self_url() will return a URL, that, when selected, will reinvoke
4401 this script with all its state information intact. This is most
4402 useful when you want to jump around within the document using
4403 internal anchors but you don't want to disrupt the current contents
4404 of the form(s). Something like this will do the trick.
4406 $myself = $query->self_url;
4407 print "<A HREF=$myself#table1>See table 1</A>";
4408 print "<A HREF=$myself#table2>See table 2</A>";
4409 print "<A HREF=$myself#yourself>See for yourself</A>";
4411 If you want more control over what's returned, using the B<url()>
4414 You can also retrieve the unprocessed query string with query_string():
4416 $the_string = $query->query_string;
4418 =head2 OBTAINING THE SCRIPT'S URL
4420 $full_url = $query->url();
4421 $full_url = $query->url(-full=>1); #alternative syntax
4422 $relative_url = $query->url(-relative=>1);
4423 $absolute_url = $query->url(-absolute=>1);
4424 $url_with_path = $query->url(-path_info=>1);
4425 $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
4427 B<url()> returns the script's URL in a variety of formats. Called
4428 without any arguments, it returns the full form of the URL, including
4429 host name and port number
4431 http://your.host.com/path/to/script.cgi
4433 You can modify this format with the following named arguments:
4439 If true, produce an absolute URL, e.g.
4445 Produce a relative URL. This is useful if you want to reinvoke your
4446 script with different parameters. For example:
4452 Produce the full URL, exactly as if called without any arguments.
4453 This overrides the -relative and -absolute arguments.
4455 =item B<-path> (B<-path_info>)
4457 Append the additional path information to the URL. This can be
4458 combined with B<-full>, B<-absolute> or B<-relative>. B<-path_info>
4459 is provided as a synonym.
4461 =item B<-query> (B<-query_string>)
4463 Append the query string to the URL. This can be combined with
4464 B<-full>, B<-absolute> or B<-relative>. B<-query_string> is provided
4469 =head2 MIXING POST AND URL PARAMETERS
4471 $color = $query->url_param('color');
4473 It is possible for a script to receive CGI parameters in the URL as
4474 well as in the fill-out form by creating a form that POSTs to a URL
4475 containing a query string (a "?" mark followed by arguments). The
4476 B<param()> method will always return the contents of the POSTed
4477 fill-out form, ignoring the URL's query string. To retrieve URL
4478 parameters, call the B<url_param()> method. Use it in the same way as
4479 B<param()>. The main difference is that it allows you to read the
4480 parameters, but not set them.
4483 Under no circumstances will the contents of the URL query string
4484 interfere with similarly-named CGI parameters in POSTed forms. If you
4485 try to mix a URL query string with a form submitted with the GET
4486 method, the results will not be what you expect.
4488 =head1 CREATING STANDARD HTML ELEMENTS:
4490 CGI.pm defines general HTML shortcut methods for most, if not all of
4491 the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
4492 HTML element and return a fragment of HTML text that you can then
4493 print or manipulate as you like. Each shortcut returns a fragment of
4494 HTML code that you can append to a string, save to a file, or, most
4495 commonly, print out so that it displays in the browser window.
4497 This example shows how to use the HTML methods:
4500 print $q->blockquote(
4501 "Many years ago on the island of",
4502 $q->a({href=>"http://crete.org/"},"Crete"),
4503 "there lived a Minotaur named",
4504 $q->strong("Fred."),
4508 This results in the following HTML code (extra newlines have been
4509 added for readability):
4512 Many years ago on the island of
4513 <a HREF="http://crete.org/">Crete</a> there lived
4514 a minotaur named <strong>Fred.</strong>
4518 If you find the syntax for calling the HTML shortcuts awkward, you can
4519 import them into your namespace and dispense with the object syntax
4520 completely (see the next section for more details):
4522 use CGI ':standard';
4524 "Many years ago on the island of",
4525 a({href=>"http://crete.org/"},"Crete"),
4526 "there lived a minotaur named",
4531 =head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
4533 The HTML methods will accept zero, one or multiple arguments. If you
4534 provide no arguments, you get a single tag:
4538 If you provide one or more string arguments, they are concatenated
4539 together with spaces and placed between opening and closing tags:
4541 print h1("Chapter","1"); # <H1>Chapter 1</H1>"
4543 If the first argument is an associative array reference, then the keys
4544 and values of the associative array become the HTML tag's attributes:
4546 print a({-href=>'fred.html',-target=>'_new'},
4547 "Open a new frame");
4549 <A HREF="fred.html",TARGET="_new">Open a new frame</A>
4551 You may dispense with the dashes in front of the attribute names if
4554 print img {src=>'fred.gif',align=>'LEFT'};
4556 <IMG ALIGN="LEFT" SRC="fred.gif">
4558 Sometimes an HTML tag attribute has no argument. For example, ordered
4559 lists can be marked as COMPACT. The syntax for this is an argument that
4560 that points to an undef string:
4562 print ol({compact=>undef},li('one'),li('two'),li('three'));
4564 Prior to CGI.pm version 2.41, providing an empty ('') string as an
4565 attribute argument was the same as providing undef. However, this has
4566 changed in order to accommodate those who want to create tags of the form
4567 <IMG ALT="">. The difference is shown in these two pieces of code:
4570 img({alt=>undef}) <IMG ALT>
4571 img({alt=>''}) <IMT ALT="">
4573 =head2 THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS
4575 One of the cool features of the HTML shortcuts is that they are
4576 distributive. If you give them an argument consisting of a
4577 B<reference> to a list, the tag will be distributed across each
4578 element of the list. For example, here's one way to make an ordered
4582 li({-type=>'disc'},['Sneezy','Doc','Sleepy','Happy']);
4585 This example will result in HTML output that looks like this:
4588 <LI TYPE="disc">Sneezy</LI>
4589 <LI TYPE="disc">Doc</LI>
4590 <LI TYPE="disc">Sleepy</LI>
4591 <LI TYPE="disc">Happy</LI>
4594 This is extremely useful for creating tables. For example:
4596 print table({-border=>undef},
4597 caption('When Should You Eat Your Vegetables?'),
4598 Tr({-align=>CENTER,-valign=>TOP},
4600 th(['Vegetable', 'Breakfast','Lunch','Dinner']),
4601 td(['Tomatoes' , 'no', 'yes', 'yes']),
4602 td(['Broccoli' , 'no', 'no', 'yes']),
4603 td(['Onions' , 'yes','yes', 'yes'])
4608 =head2 HTML SHORTCUTS AND LIST INTERPOLATION
4610 Consider this bit of code:
4612 print blockquote(em('Hi'),'mom!'));
4614 It will ordinarily return the string that you probably expect, namely:
4616 <BLOCKQUOTE><EM>Hi</EM> mom!</BLOCKQUOTE>
4618 Note the space between the element "Hi" and the element "mom!".
4619 CGI.pm puts the extra space there using array interpolation, which is
4620 controlled by the magic $" variable. Sometimes this extra space is
4621 not what you want, for example, when you are trying to align a series
4622 of images. In this case, you can simply change the value of $" to an
4627 print blockquote(em('Hi'),'mom!'));
4630 I suggest you put the code in a block as shown here. Otherwise the
4631 change to $" will affect all subsequent code until you explicitly
4634 =head2 NON-STANDARD HTML SHORTCUTS
4636 A few HTML tags don't follow the standard pattern for various
4639 B<comment()> generates an HTML comment (<!-- comment -->). Call it
4642 print comment('here is my comment');
4644 Because of conflicts with built-in Perl functions, the following functions
4645 begin with initial caps:
4654 In addition, start_html(), end_html(), start_form(), end_form(),
4655 start_multipart_form() and all the fill-out form tags are special.
4656 See their respective sections.
4658 =head2 AUTOESCAPING HTML
4660 By default, all HTML that is emitted by the form-generating functions
4661 is passed through a function called escapeHTML():
4665 =item $escaped_string = escapeHTML("unescaped string");
4667 Escape HTML formatting characters in a string.
4671 Provided that you have specified a character set of ISO-8859-1 (the
4672 default), the standard HTML escaping rules will be used. The "<"
4673 character becomes "<", ">" becomes ">", "&" becomes "&", and
4674 the quote character becomes """. In addition, the hexadecimal
4675 0x8b and 0x9b characters, which many windows-based browsers interpret
4676 as the left and right angle-bracket characters, are replaced by their
4677 numeric HTML entities ("‹" and "›"). If you manually change
4678 the charset, either by calling the charset() method explicitly or by
4679 passing a -charset argument to header(), then B<all> characters will
4680 be replaced by their numeric entities, since CGI.pm has no lookup
4681 table for all the possible encodings.
4683 The automatic escaping does not apply to other shortcuts, such as
4684 h1(). You should call escapeHTML() yourself on untrusted data in
4685 order to protect your pages against nasty tricks that people may enter
4686 into guestbooks, etc.. To change the character set, use charset().
4687 To turn autoescaping off completely, use autoescape():
4691 =item $charset = charset([$charset]);
4693 Get or set the current character set.
4695 =item $flag = autoEscape([$flag]);
4697 Get or set the value of the autoescape flag.
4701 =head2 PRETTY-PRINTING HTML
4703 By default, all the HTML produced by these functions comes out as one
4704 long line without carriage returns or indentation. This is yuck, but
4705 it does reduce the size of the documents by 10-20%. To get
4706 pretty-printed output, please use L<CGI::Pretty>, a subclass
4707 contributed by Brian Paulsen.
4709 =head1 CREATING FILL-OUT FORMS:
4711 I<General note> The various form-creating methods all return strings
4712 to the caller, containing the tag or tags that will create the requested
4713 form element. You are responsible for actually printing out these strings.
4714 It's set up this way so that you can place formatting tags
4715 around the form elements.
4717 I<Another note> The default values that you specify for the forms are only
4718 used the B<first> time the script is invoked (when there is no query
4719 string). On subsequent invocations of the script (when there is a query
4720 string), the former values are used even if they are blank.
4722 If you want to change the value of a field from its previous value, you have two
4725 (1) call the param() method to set it.
4727 (2) use the -override (alias -force) parameter (a new feature in version 2.15).
4728 This forces the default value to be used, regardless of the previous value:
4730 print $query->textfield(-name=>'field_name',
4731 -default=>'starting value',
4736 I<Yet another note> By default, the text and labels of form elements are
4737 escaped according to HTML rules. This means that you can safely use
4738 "<CLICK ME>" as the label for a button. However, it also interferes with
4739 your ability to incorporate special HTML character sequences, such as Á,
4740 into your fields. If you wish to turn off automatic escaping, call the
4741 autoEscape() method with a false value immediately after creating the CGI object:
4744 $query->autoEscape(undef);
4746 =head2 CREATING AN ISINDEX TAG
4748 print $query->isindex(-action=>$action);
4752 print $query->isindex($action);
4754 Prints out an <ISINDEX> tag. Not very exciting. The parameter
4755 -action specifies the URL of the script to process the query. The
4756 default is to process the query with the current script.
4758 =head2 STARTING AND ENDING A FORM
4760 print $query->start_form(-method=>$method,
4762 -enctype=>$encoding);
4763 <... various form stuff ...>
4764 print $query->endform;
4768 print $query->start_form($method,$action,$encoding);
4769 <... various form stuff ...>
4770 print $query->endform;
4772 start_form() will return a <FORM> tag with the optional method,
4773 action and form encoding that you specify. The defaults are:
4777 enctype: application/x-www-form-urlencoded
4779 endform() returns the closing </FORM> tag.
4781 Start_form()'s enctype argument tells the browser how to package the various
4782 fields of the form before sending the form to the server. Two
4783 values are possible:
4785 B<Note:> This method was previously named startform(), and startform()
4786 is still recognized as an alias.
4790 =item B<application/x-www-form-urlencoded>
4792 This is the older type of encoding used by all browsers prior to
4793 Netscape 2.0. It is compatible with many CGI scripts and is
4794 suitable for short fields containing text data. For your
4795 convenience, CGI.pm stores the name of this encoding
4796 type in B<$CGI::URL_ENCODED>.
4798 =item B<multipart/form-data>
4800 This is the newer type of encoding introduced by Netscape 2.0.
4801 It is suitable for forms that contain very large fields or that
4802 are intended for transferring binary data. Most importantly,
4803 it enables the "file upload" feature of Netscape 2.0 forms. For
4804 your convenience, CGI.pm stores the name of this encoding type
4805 in B<&CGI::MULTIPART>
4807 Forms that use this type of encoding are not easily interpreted
4808 by CGI scripts unless they use CGI.pm or another library designed
4813 For compatibility, the start_form() method uses the older form of
4814 encoding by default. If you want to use the newer form of encoding
4815 by default, you can call B<start_multipart_form()> instead of
4818 JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
4819 for use with JavaScript. The -name parameter gives the
4820 form a name so that it can be identified and manipulated by
4821 JavaScript functions. -onSubmit should point to a JavaScript
4822 function that will be executed just before the form is submitted to your
4823 server. You can use this opportunity to check the contents of the form
4824 for consistency and completeness. If you find something wrong, you
4825 can put up an alert box or maybe fix things up yourself. You can
4826 abort the submission by returning false from this function.
4828 Usually the bulk of JavaScript functions are defined in a <SCRIPT>
4829 block in the HTML header and -onSubmit points to one of these function
4830 call. See start_html() for details.
4832 =head2 CREATING A TEXT FIELD
4834 print $query->textfield(-name=>'field_name',
4835 -default=>'starting value',
4840 print $query->textfield('field_name','starting value',50,80);
4842 textfield() will return a text input field.
4850 The first parameter is the required name for the field (-name).
4854 The optional second parameter is the default starting value for the field
4855 contents (-default).
4859 The optional third parameter is the size of the field in
4864 The optional fourth parameter is the maximum number of characters the
4865 field will accept (-maxlength).
4869 As with all these methods, the field will be initialized with its
4870 previous contents from earlier invocations of the script.
4871 When the form is processed, the value of the text field can be
4874 $value = $query->param('foo');
4876 If you want to reset it from its initial value after the script has been
4877 called once, you can do so like this:
4879 $query->param('foo',"I'm taking over this value!");
4881 NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
4882 value, you can force its current value by using the -override (alias -force)
4885 print $query->textfield(-name=>'field_name',
4886 -default=>'starting value',
4891 JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
4892 B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
4893 parameters to register JavaScript event handlers. The onChange
4894 handler will be called whenever the user changes the contents of the
4895 text field. You can do text validation if you like. onFocus and
4896 onBlur are called respectively when the insertion point moves into and
4897 out of the text field. onSelect is called when the user changes the
4898 portion of the text that is selected.
4900 =head2 CREATING A BIG TEXT FIELD
4902 print $query->textarea(-name=>'foo',
4903 -default=>'starting value',
4909 print $query->textarea('foo','starting value',10,50);
4911 textarea() is just like textfield, but it allows you to specify
4912 rows and columns for a multiline text entry box. You can provide
4913 a starting value for the field, which can be long and contain
4916 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
4917 B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
4918 recognized. See textfield().
4920 =head2 CREATING A PASSWORD FIELD
4922 print $query->password_field(-name=>'secret',
4923 -value=>'starting value',
4928 print $query->password_field('secret','starting value',50,80);
4930 password_field() is identical to textfield(), except that its contents
4931 will be starred out on the web page.
4933 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
4934 B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
4935 recognized. See textfield().
4937 =head2 CREATING A FILE UPLOAD FIELD
4939 print $query->filefield(-name=>'uploaded_file',
4940 -default=>'starting value',
4945 print $query->filefield('uploaded_file','starting value',50,80);
4947 filefield() will return a file upload field for Netscape 2.0 browsers.
4948 In order to take full advantage of this I<you must use the new
4949 multipart encoding scheme> for the form. You can do this either
4950 by calling B<start_form()> with an encoding type of B<$CGI::MULTIPART>,
4951 or by calling the new method B<start_multipart_form()> instead of
4952 vanilla B<start_form()>.
4960 The first parameter is the required name for the field (-name).
4964 The optional second parameter is the starting value for the field contents
4965 to be used as the default file name (-default).
4967 For security reasons, browsers don't pay any attention to this field,
4968 and so the starting value will always be blank. Worse, the field
4969 loses its "sticky" behavior and forgets its previous contents. The
4970 starting value field is called for in the HTML specification, however,
4971 and possibly some browser will eventually provide support for it.
4975 The optional third parameter is the size of the field in
4980 The optional fourth parameter is the maximum number of characters the
4981 field will accept (-maxlength).
4985 When the form is processed, you can retrieve the entered filename
4988 $filename = $query->param('uploaded_file');
4990 Different browsers will return slightly different things for the
4991 name. Some browsers return the filename only. Others return the full
4992 path to the file, using the path conventions of the user's machine.
4993 Regardless, the name returned is always the name of the file on the
4994 I<user's> machine, and is unrelated to the name of the temporary file
4995 that CGI.pm creates during upload spooling (see below).
4997 The filename returned is also a file handle. You can read the contents
4998 of the file using standard Perl file reading calls:
5000 # Read a text file and print it out
5001 while (<$filename>) {
5005 # Copy a binary file to somewhere safe
5006 open (OUTFILE,">>/usr/local/web/users/feedback");
5007 while ($bytesread=read($filename,$buffer,1024)) {
5008 print OUTFILE $buffer;
5011 However, there are problems with the dual nature of the upload fields.
5012 If you C<use strict>, then Perl will complain when you try to use a
5013 string as a filehandle. You can get around this by placing the file
5014 reading code in a block containing the C<no strict> pragma. More
5015 seriously, it is possible for the remote user to type garbage into the
5016 upload field, in which case what you get from param() is not a
5017 filehandle at all, but a string.
5019 To be safe, use the I<upload()> function (new in version 2.47). When
5020 called with the name of an upload field, I<upload()> returns a
5021 filehandle, or undef if the parameter is not a valid filehandle.
5023 $fh = $query->upload('uploaded_file');
5028 This is the recommended idiom.
5030 When a file is uploaded the browser usually sends along some
5031 information along with it in the format of headers. The information
5032 usually includes the MIME content type. Future browsers may send
5033 other information as well (such as modification date and size). To
5034 retrieve this information, call uploadInfo(). It returns a reference to
5035 an associative array containing all the document headers.
5037 $filename = $query->param('uploaded_file');
5038 $type = $query->uploadInfo($filename)->{'Content-Type'};
5039 unless ($type eq 'text/html') {
5040 die "HTML FILES ONLY!";
5043 If you are using a machine that recognizes "text" and "binary" data
5044 modes, be sure to understand when and how to use them (see the Camel book).
5045 Otherwise you may find that binary files are corrupted during file
5048 There are occasionally problems involving parsing the uploaded file.
5049 This usually happens when the user presses "Stop" before the upload is
5050 finished. In this case, CGI.pm will return undef for the name of the
5051 uploaded file and set I<cgi_error()> to the string "400 Bad request
5052 (malformed multipart POST)". This error message is designed so that
5053 you can incorporate it into a status code to be sent to the browser.
5056 $file = $query->upload('uploaded_file');
5057 if (!$file && $query->cgi_error) {
5058 print $query->header(-status=>$query->cgi_error);
5062 You are free to create a custom HTML page to complain about the error,
5065 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
5066 B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
5067 recognized. See textfield() for details.
5069 =head2 CREATING A POPUP MENU
5071 print $query->popup_menu('menu_name',
5072 ['eenie','meenie','minie'],
5077 %labels = ('eenie'=>'your first choice',
5078 'meenie'=>'your second choice',
5079 'minie'=>'your third choice');
5080 print $query->popup_menu('menu_name',
5081 ['eenie','meenie','minie'],
5084 -or (named parameter style)-
5086 print $query->popup_menu(-name=>'menu_name',
5087 -values=>['eenie','meenie','minie'],
5091 popup_menu() creates a menu.
5097 The required first argument is the menu's name (-name).
5101 The required second argument (-values) is an array B<reference>
5102 containing the list of menu items in the menu. You can pass the
5103 method an anonymous array, as shown in the example, or a reference to
5104 a named array, such as "\@foo".
5108 The optional third parameter (-default) is the name of the default
5109 menu choice. If not specified, the first item will be the default.
5110 The values of the previous choice will be maintained across queries.
5114 The optional fourth parameter (-labels) is provided for people who
5115 want to use different values for the user-visible label inside the
5116 popup menu nd the value returned to your script. It's a pointer to an
5117 associative array relating menu values to user-visible labels. If you
5118 leave this parameter blank, the menu values will be displayed by
5119 default. (You can also leave a label undefined if you want to).
5123 When the form is processed, the selected value of the popup menu can
5126 $popup_menu_value = $query->param('menu_name');
5128 JAVASCRIPTING: popup_menu() recognizes the following event handlers:
5129 B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
5130 B<-onBlur>. See the textfield() section for details on when these
5131 handlers are called.
5133 =head2 CREATING A SCROLLING LIST
5135 print $query->scrolling_list('list_name',
5136 ['eenie','meenie','minie','moe'],
5137 ['eenie','moe'],5,'true');
5140 print $query->scrolling_list('list_name',
5141 ['eenie','meenie','minie','moe'],
5142 ['eenie','moe'],5,'true',
5147 print $query->scrolling_list(-name=>'list_name',
5148 -values=>['eenie','meenie','minie','moe'],
5149 -default=>['eenie','moe'],
5154 scrolling_list() creates a scrolling list.
5158 =item B<Parameters:>
5162 The first and second arguments are the list name (-name) and values
5163 (-values). As in the popup menu, the second argument should be an
5168 The optional third argument (-default) can be either a reference to a
5169 list containing the values to be selected by default, or can be a
5170 single value to select. If this argument is missing or undefined,
5171 then nothing is selected when the list first appears. In the named
5172 parameter version, you can use the synonym "-defaults" for this
5177 The optional fourth argument is the size of the list (-size).
5181 The optional fifth argument can be set to true to allow multiple
5182 simultaneous selections (-multiple). Otherwise only one selection
5183 will be allowed at a time.
5187 The optional sixth argument is a pointer to an associative array
5188 containing long user-visible labels for the list items (-labels).
5189 If not provided, the values will be displayed.
5191 When this form is processed, all selected list items will be returned as
5192 a list under the parameter name 'list_name'. The values of the
5193 selected items can be retrieved with:
5195 @selected = $query->param('list_name');
5199 JAVASCRIPTING: scrolling_list() recognizes the following event
5200 handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
5201 and B<-onBlur>. See textfield() for the description of when these
5202 handlers are called.
5204 =head2 CREATING A GROUP OF RELATED CHECKBOXES
5206 print $query->checkbox_group(-name=>'group_name',
5207 -values=>['eenie','meenie','minie','moe'],
5208 -default=>['eenie','moe'],
5212 print $query->checkbox_group('group_name',
5213 ['eenie','meenie','minie','moe'],
5214 ['eenie','moe'],'true',\%labels);
5216 HTML3-COMPATIBLE BROWSERS ONLY:
5218 print $query->checkbox_group(-name=>'group_name',
5219 -values=>['eenie','meenie','minie','moe'],
5220 -rows=2,-columns=>2);
5223 checkbox_group() creates a list of checkboxes that are related
5228 =item B<Parameters:>
5232 The first and second arguments are the checkbox name and values,
5233 respectively (-name and -values). As in the popup menu, the second
5234 argument should be an array reference. These values are used for the
5235 user-readable labels printed next to the checkboxes as well as for the
5236 values passed to your script in the query string.
5240 The optional third argument (-default) can be either a reference to a
5241 list containing the values to be checked by default, or can be a
5242 single value to checked. If this argument is missing or undefined,
5243 then nothing is selected when the list first appears.
5247 The optional fourth argument (-linebreak) can be set to true to place
5248 line breaks between the checkboxes so that they appear as a vertical
5249 list. Otherwise, they will be strung together on a horizontal line.
5253 The optional fifth argument is a pointer to an associative array
5254 relating the checkbox values to the user-visible labels that will
5255 be printed next to them (-labels). If not provided, the values will
5256 be used as the default.
5260 B<HTML3-compatible browsers> (such as Netscape) can take advantage of
5261 the optional parameters B<-rows>, and B<-columns>. These parameters
5262 cause checkbox_group() to return an HTML3 compatible table containing
5263 the checkbox group formatted with the specified number of rows and
5264 columns. You can provide just the -columns parameter if you wish;
5265 checkbox_group will calculate the correct number of rows for you.
5267 To include row and column headings in the returned table, you
5268 can use the B<-rowheaders> and B<-colheaders> parameters. Both
5269 of these accept a pointer to an array of headings to use.
5270 The headings are just decorative. They don't reorganize the
5271 interpretation of the checkboxes -- they're still a single named
5276 When the form is processed, all checked boxes will be returned as
5277 a list under the parameter name 'group_name'. The values of the
5278 "on" checkboxes can be retrieved with:
5280 @turned_on = $query->param('group_name');
5282 The value returned by checkbox_group() is actually an array of button
5283 elements. You can capture them and use them within tables, lists,
5284 or in other creative ways:
5286 @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
5287 &use_in_creative_way(@h);
5289 JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
5290 parameter. This specifies a JavaScript code fragment or
5291 function call to be executed every time the user clicks on
5292 any of the buttons in the group. You can retrieve the identity
5293 of the particular button clicked on using the "this" variable.
5295 =head2 CREATING A STANDALONE CHECKBOX
5297 print $query->checkbox(-name=>'checkbox_name',
5298 -checked=>'checked',
5300 -label=>'CLICK ME');
5304 print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
5306 checkbox() is used to create an isolated checkbox that isn't logically
5307 related to any others.
5311 =item B<Parameters:>
5315 The first parameter is the required name for the checkbox (-name). It
5316 will also be used for the user-readable label printed next to the
5321 The optional second parameter (-checked) specifies that the checkbox
5322 is turned on by default. Synonyms are -selected and -on.
5326 The optional third parameter (-value) specifies the value of the
5327 checkbox when it is checked. If not provided, the word "on" is
5332 The optional fourth parameter (-label) is the user-readable label to
5333 be attached to the checkbox. If not provided, the checkbox name is
5338 The value of the checkbox can be retrieved using:
5340 $turned_on = $query->param('checkbox_name');
5342 JAVASCRIPTING: checkbox() recognizes the B<-onClick>
5343 parameter. See checkbox_group() for further details.
5345 =head2 CREATING A RADIO BUTTON GROUP
5347 print $query->radio_group(-name=>'group_name',
5348 -values=>['eenie','meenie','minie'],
5355 print $query->radio_group('group_name',['eenie','meenie','minie'],
5356 'meenie','true',\%labels);
5359 HTML3-COMPATIBLE BROWSERS ONLY:
5361 print $query->radio_group(-name=>'group_name',
5362 -values=>['eenie','meenie','minie','moe'],
5363 -rows=2,-columns=>2);
5365 radio_group() creates a set of logically-related radio buttons
5366 (turning one member of the group on turns the others off)
5370 =item B<Parameters:>
5374 The first argument is the name of the group and is required (-name).
5378 The second argument (-values) is the list of values for the radio
5379 buttons. The values and the labels that appear on the page are
5380 identical. Pass an array I<reference> in the second argument, either
5381 using an anonymous array, as shown, or by referencing a named array as
5386 The optional third parameter (-default) is the name of the default
5387 button to turn on. If not specified, the first item will be the
5388 default. You can provide a nonexistent button name, such as "-" to
5389 start up with no buttons selected.
5393 The optional fourth parameter (-linebreak) can be set to 'true' to put
5394 line breaks between the buttons, creating a vertical list.
5398 The optional fifth parameter (-labels) is a pointer to an associative
5399 array relating the radio button values to user-visible labels to be
5400 used in the display. If not provided, the values themselves are
5405 B<HTML3-compatible browsers> (such as Netscape) can take advantage
5407 parameters B<-rows>, and B<-columns>. These parameters cause
5408 radio_group() to return an HTML3 compatible table containing
5409 the radio group formatted with the specified number of rows
5410 and columns. You can provide just the -columns parameter if you
5411 wish; radio_group will calculate the correct number of rows
5414 To include row and column headings in the returned table, you
5415 can use the B<-rowheader> and B<-colheader> parameters. Both
5416 of these accept a pointer to an array of headings to use.
5417 The headings are just decorative. They don't reorganize the
5418 interpretation of the radio buttons -- they're still a single named
5423 When the form is processed, the selected radio button can
5426 $which_radio_button = $query->param('group_name');
5428 The value returned by radio_group() is actually an array of button
5429 elements. You can capture them and use them within tables, lists,
5430 or in other creative ways:
5432 @h = $query->radio_group(-name=>'group_name',-values=>\@values);
5433 &use_in_creative_way(@h);
5435 =head2 CREATING A SUBMIT BUTTON
5437 print $query->submit(-name=>'button_name',
5442 print $query->submit('button_name','value');
5444 submit() will create the query submission button. Every form
5445 should have one of these.
5449 =item B<Parameters:>
5453 The first argument (-name) is optional. You can give the button a
5454 name if you have several submission buttons in your form and you want
5455 to distinguish between them. The name will also be used as the
5456 user-visible label. Be aware that a few older browsers don't deal with this correctly and
5457 B<never> send back a value from a button.
5461 The second argument (-value) is also optional. This gives the button
5462 a value that will be passed to your script in the query string.
5466 You can figure out which button was pressed by using different
5467 values for each one:
5469 $which_one = $query->param('button_name');
5471 JAVASCRIPTING: radio_group() recognizes the B<-onClick>
5472 parameter. See checkbox_group() for further details.
5474 =head2 CREATING A RESET BUTTON
5478 reset() creates the "reset" button. Note that it restores the
5479 form to its value from the last time the script was called,
5480 NOT necessarily to the defaults.
5482 Note that this conflicts with the Perl reset() built-in. Use
5483 CORE::reset() to get the original reset function.
5485 =head2 CREATING A DEFAULT BUTTON
5487 print $query->defaults('button_label')
5489 defaults() creates a button that, when invoked, will cause the
5490 form to be completely reset to its defaults, wiping out all the
5491 changes the user ever made.
5493 =head2 CREATING A HIDDEN FIELD
5495 print $query->hidden(-name=>'hidden_name',
5496 -default=>['value1','value2'...]);
5500 print $query->hidden('hidden_name','value1','value2'...);
5502 hidden() produces a text field that can't be seen by the user. It
5503 is useful for passing state variable information from one invocation
5504 of the script to the next.
5508 =item B<Parameters:>
5512 The first argument is required and specifies the name of this
5517 The second argument is also required and specifies its value
5518 (-default). In the named parameter style of calling, you can provide
5519 a single value here or a reference to a whole list
5523 Fetch the value of a hidden field this way:
5525 $hidden_value = $query->param('hidden_name');
5527 Note, that just like all the other form elements, the value of a
5528 hidden field is "sticky". If you want to replace a hidden field with
5529 some other values after the script has been called once you'll have to
5532 $query->param('hidden_name','new','values','here');
5534 =head2 CREATING A CLICKABLE IMAGE BUTTON
5536 print $query->image_button(-name=>'button_name',
5537 -src=>'/source/URL',
5542 print $query->image_button('button_name','/source/URL','MIDDLE');
5544 image_button() produces a clickable image. When it's clicked on the
5545 position of the click is returned to your script as "button_name.x"
5546 and "button_name.y", where "button_name" is the name you've assigned
5549 JAVASCRIPTING: image_button() recognizes the B<-onClick>
5550 parameter. See checkbox_group() for further details.
5554 =item B<Parameters:>
5558 The first argument (-name) is required and specifies the name of this
5563 The second argument (-src) is also required and specifies the URL
5566 The third option (-align, optional) is an alignment type, and may be
5567 TOP, BOTTOM or MIDDLE
5571 Fetch the value of the button this way:
5572 $x = $query->param('button_name.x');
5573 $y = $query->param('button_name.y');
5575 =head2 CREATING A JAVASCRIPT ACTION BUTTON
5577 print $query->button(-name=>'button_name',
5578 -value=>'user visible label',
5579 -onClick=>"do_something()");
5583 print $query->button('button_name',"do_something()");
5585 button() produces a button that is compatible with Netscape 2.0's
5586 JavaScript. When it's pressed the fragment of JavaScript code
5587 pointed to by the B<-onClick> parameter will be executed. On
5588 non-Netscape browsers this form element will probably not even
5593 Netscape browsers versions 1.1 and higher, and all versions of
5594 Internet Explorer, support a so-called "cookie" designed to help
5595 maintain state within a browser session. CGI.pm has several methods
5596 that support cookies.
5598 A cookie is a name=value pair much like the named parameters in a CGI
5599 query string. CGI scripts create one or more cookies and send
5600 them to the browser in the HTTP header. The browser maintains a list
5601 of cookies that belong to a particular Web server, and returns them
5602 to the CGI script during subsequent interactions.
5604 In addition to the required name=value pair, each cookie has several
5605 optional attributes:
5609 =item 1. an expiration time
5611 This is a time/date string (in a special GMT format) that indicates
5612 when a cookie expires. The cookie will be saved and returned to your
5613 script until this expiration date is reached if the user exits
5614 the browser and restarts it. If an expiration date isn't specified, the cookie
5615 will remain active until the user quits the browser.
5619 This is a partial or complete domain name for which the cookie is
5620 valid. The browser will return the cookie to any host that matches
5621 the partial domain name. For example, if you specify a domain name
5622 of ".capricorn.com", then the browser will return the cookie to
5623 Web servers running on any of the machines "www.capricorn.com",
5624 "www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
5625 must contain at least two periods to prevent attempts to match
5626 on top level domains like ".edu". If no domain is specified, then
5627 the browser will only return the cookie to servers on the host the
5628 cookie originated from.
5632 If you provide a cookie path attribute, the browser will check it
5633 against your script's URL before returning the cookie. For example,
5634 if you specify the path "/cgi-bin", then the cookie will be returned
5635 to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
5636 and "/cgi-bin/customer_service/complain.pl", but not to the script
5637 "/cgi-private/site_admin.pl". By default, path is set to "/", which
5638 causes the cookie to be sent to any CGI script on your site.
5640 =item 4. a "secure" flag
5642 If the "secure" attribute is set, the cookie will only be sent to your
5643 script if the CGI request is occurring on a secure channel, such as SSL.
5647 The interface to HTTP cookies is the B<cookie()> method:
5649 $cookie = $query->cookie(-name=>'sessionID',
5652 -path=>'/cgi-bin/database',
5653 -domain=>'.capricorn.org',
5655 print $query->header(-cookie=>$cookie);
5657 B<cookie()> creates a new cookie. Its parameters include:
5663 The name of the cookie (required). This can be any string at all.
5664 Although browsers limit their cookie names to non-whitespace
5665 alphanumeric characters, CGI.pm removes this restriction by escaping
5666 and unescaping cookies behind the scenes.
5670 The value of the cookie. This can be any scalar value,
5671 array reference, or even associative array reference. For example,
5672 you can store an entire associative array into a cookie this way:
5674 $cookie=$query->cookie(-name=>'family information',
5675 -value=>\%childrens_ages);
5679 The optional partial path for which this cookie will be valid, as described
5684 The optional partial domain for which this cookie will be valid, as described
5689 The optional expiration date for this cookie. The format is as described
5690 in the section on the B<header()> method:
5692 "+1h" one hour from now
5696 If set to true, this cookie will only be used within a secure
5701 The cookie created by cookie() must be incorporated into the HTTP
5702 header within the string returned by the header() method:
5704 print $query->header(-cookie=>$my_cookie);
5706 To create multiple cookies, give header() an array reference:
5708 $cookie1 = $query->cookie(-name=>'riddle_name',
5709 -value=>"The Sphynx's Question");
5710 $cookie2 = $query->cookie(-name=>'answers',
5712 print $query->header(-cookie=>[$cookie1,$cookie2]);
5714 To retrieve a cookie, request it by name by calling cookie()
5715 method without the B<-value> parameter:
5719 %answers = $query->cookie(-name=>'answers');
5720 # $query->cookie('answers') will work too!
5722 The cookie and CGI namespaces are separate. If you have a parameter
5723 named 'answers' and a cookie named 'answers', the values retrieved by
5724 param() and cookie() are independent of each other. However, it's
5725 simple to turn a CGI parameter into a cookie, and vice-versa:
5727 # turn a CGI parameter into a cookie
5728 $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
5730 $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
5732 See the B<cookie.cgi> example script for some ideas on how to use
5733 cookies effectively.
5735 =head1 WORKING WITH FRAMES
5737 It's possible for CGI.pm scripts to write into several browser panels
5738 and windows using the HTML 4 frame mechanism. There are three
5739 techniques for defining new frames programmatically:
5743 =item 1. Create a <Frameset> document
5745 After writing out the HTTP header, instead of creating a standard
5746 HTML document using the start_html() call, create a <FRAMESET>
5747 document that defines the frames on the page. Specify your script(s)
5748 (with appropriate parameters) as the SRC for each of the frames.
5750 There is no specific support for creating <FRAMESET> sections
5751 in CGI.pm, but the HTML is very simple to write. See the frame
5752 documentation in Netscape's home pages for details
5754 http://home.netscape.com/assist/net_sites/frames.html
5756 =item 2. Specify the destination for the document in the HTTP header
5758 You may provide a B<-target> parameter to the header() method:
5760 print $q->header(-target=>'ResultsWindow');
5762 This will tell the browser to load the output of your script into the
5763 frame named "ResultsWindow". If a frame of that name doesn't already
5764 exist, the browser will pop up a new window and load your script's
5765 document into that. There are a number of magic names that you can
5766 use for targets. See the frame documents on Netscape's home pages for
5769 =item 3. Specify the destination for the document in the <FORM> tag
5771 You can specify the frame to load in the FORM tag itself. With
5772 CGI.pm it looks like this:
5774 print $q->start_form(-target=>'ResultsWindow');
5776 When your script is reinvoked by the form, its output will be loaded
5777 into the frame named "ResultsWindow". If one doesn't already exist
5778 a new window will be created.
5782 The script "frameset.cgi" in the examples directory shows one way to
5783 create pages in which the fill-out form and the response live in
5784 side-by-side frames.
5786 =head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
5788 CGI.pm has limited support for HTML3's cascading style sheets (css).
5789 To incorporate a stylesheet into your document, pass the
5790 start_html() method a B<-style> parameter. The value of this
5791 parameter may be a scalar, in which case it is incorporated directly
5792 into a <STYLE> section, or it may be a hash reference. In the latter
5793 case you should provide the hash with one or more of B<-src> or
5794 B<-code>. B<-src> points to a URL where an externally-defined
5795 stylesheet can be found. B<-code> points to a scalar value to be
5796 incorporated into a <STYLE> section. Style definitions in B<-code>
5797 override similarly-named ones in B<-src>, hence the name "cascading."
5799 You may also specify the type of the stylesheet by adding the optional
5800 B<-type> parameter to the hash pointed to by B<-style>. If not
5801 specified, the style defaults to 'text/css'.
5803 To refer to a style within the body of your document, add the
5804 B<-class> parameter to any HTML element:
5806 print h1({-class=>'Fancy'},'Welcome to the Party');
5808 Or define styles on the fly with the B<-style> parameter:
5810 print h1({-style=>'Color: red;'},'Welcome to Hell');
5812 You may also use the new B<span()> element to apply a style to a
5815 print span({-style=>'Color: red;'},
5816 h1('Welcome to Hell'),
5817 "Where did that handbasket get to?"
5820 Note that you must import the ":html3" definitions to have the
5821 B<span()> method available. Here's a quick and dirty example of using
5822 CSS's. See the CSS specification at
5823 http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
5825 use CGI qw/:standard :html3/;
5827 #here's a stylesheet incorporated directly into the page
5837 font-family: sans-serif;
5843 print start_html( -title=>'CGI with Style',
5844 -style=>{-src=>'http://www.capricorn.com/style/st1.css',
5847 print h1('CGI with Style'),
5849 "Better read the cascading style sheet spec before playing with this!"),
5850 span({-style=>'color: magenta'},
5851 "Look Mom, no hands!",
5859 If you are running the script from the command line or in the perl
5860 debugger, you can pass the script a list of keywords or
5861 parameter=value pairs on the command line or from standard input (you
5862 don't have to worry about tricking your script into reading from
5863 environment variables). You can pass keywords like this:
5865 your_script.pl keyword1 keyword2 keyword3
5869 your_script.pl keyword1+keyword2+keyword3
5873 your_script.pl name1=value1 name2=value2
5877 your_script.pl name1=value1&name2=value2
5879 To turn off this feature, use the -no_debug pragma.
5881 To test the POST method, you may enable full debugging with the -debug
5882 pragma. This will allow you to feed newline-delimited name=value
5883 pairs to the script on standard input.
5885 When debugging, you can use quotes and backslashes to escape
5886 characters in the familiar shell manner, letting you place
5887 spaces and other funny characters in your parameter=value
5890 your_script.pl "name1='I am a long value'" "name2=two\ words"
5892 =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
5894 The Dump() method produces a string consisting of all the query's
5895 name/value pairs formatted nicely as a nested list. This is useful
5896 for debugging purposes:
5901 Produces something that looks like:
5915 As a shortcut, you can interpolate the entire CGI object into a string
5916 and it will be replaced with the a nice HTML dump shown above:
5919 print "<H2>Current Values</H2> $query\n";
5921 =head1 FETCHING ENVIRONMENT VARIABLES
5923 Some of the more useful environment variables can be fetched
5924 through this interface. The methods are as follows:
5930 Return a list of MIME types that the remote browser accepts. If you
5931 give this method a single argument corresponding to a MIME type, as in
5932 $query->Accept('text/html'), it will return a floating point value
5933 corresponding to the browser's preference for this type from 0.0
5934 (don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
5935 list are handled correctly.
5937 Note that the capitalization changed between version 2.43 and 2.44 in
5938 order to avoid conflict with Perl's accept() function.
5940 =item B<raw_cookie()>
5942 Returns the HTTP_COOKIE variable, an HTTP extension implemented by
5943 Netscape browsers version 1.1 and higher, and all versions of Internet
5944 Explorer. Cookies have a special format, and this method call just
5945 returns the raw form (?cookie dough). See cookie() for ways of
5946 setting and retrieving cooked cookies.
5948 Called with no parameters, raw_cookie() returns the packed cookie
5949 structure. You can separate it into individual cookies by splitting
5950 on the character sequence "; ". Called with the name of a cookie,
5951 retrieves the B<unescaped> form of the cookie. You can use the
5952 regular cookie() method to get the names, or use the raw_fetch()
5953 method from the CGI::Cookie module.
5955 =item B<user_agent()>
5957 Returns the HTTP_USER_AGENT variable. If you give
5958 this method a single argument, it will attempt to
5959 pattern match on it, allowing you to do something
5960 like $query->user_agent(netscape);
5962 =item B<path_info()>
5964 Returns additional path information from the script URL.
5965 E.G. fetching /cgi-bin/your_script/additional/stuff will
5966 result in $query->path_info() returning
5969 NOTE: The Microsoft Internet Information Server
5970 is broken with respect to additional path information. If
5971 you use the Perl DLL library, the IIS server will attempt to
5972 execute the additional path information as a Perl script.
5973 If you use the ordinary file associations mapping, the
5974 path information will be present in the environment,
5975 but incorrect. The best thing to do is to avoid using additional
5976 path information in CGI scripts destined for use with IIS.
5978 =item B<path_translated()>
5980 As per path_info() but returns the additional
5981 path information translated into a physical path, e.g.
5982 "/usr/local/etc/httpd/htdocs/additional/stuff".
5984 The Microsoft IIS is broken with respect to the translated
5987 =item B<remote_host()>
5989 Returns either the remote host name or IP address.
5990 if the former is unavailable.
5992 =item B<script_name()>
5993 Return the script name as a partial URL, for self-refering
5998 Return the URL of the page the browser was viewing
5999 prior to fetching your script. Not available for all
6002 =item B<auth_type ()>
6004 Return the authorization/verification method in use for this
6007 =item B<server_name ()>
6009 Returns the name of the server, usually the machine's host
6012 =item B<virtual_host ()>
6014 When using virtual hosts, returns the name of the host that
6015 the browser attempted to contact
6017 =item B<server_software ()>
6019 Returns the server software and version number.
6021 =item B<remote_user ()>
6023 Return the authorization/verification name used for user
6024 verification, if this script is protected.
6026 =item B<user_name ()>
6028 Attempt to obtain the remote user's name, using a variety of different
6029 techniques. This only works with older browsers such as Mosaic.
6030 Newer browsers do not report the user name for privacy reasons!
6032 =item B<request_method()>
6034 Returns the method used to access your script, usually
6035 one of 'POST', 'GET' or 'HEAD'.
6037 =item B<content_type()>
6039 Returns the content_type of data submitted in a POST, generally
6040 multipart/form-data or application/x-www-form-urlencoded
6044 Called with no arguments returns the list of HTTP environment
6045 variables, including such things as HTTP_USER_AGENT,
6046 HTTP_ACCEPT_LANGUAGE, and HTTP_ACCEPT_CHARSET, corresponding to the
6047 like-named HTTP header fields in the request. Called with the name of
6048 an HTTP header field, returns its value. Capitalization and the use
6049 of hyphens versus underscores are not significant.
6051 For example, all three of these examples are equivalent:
6053 $requested_language = $q->http('Accept-language');
6054 $requested_language = $q->http('Accept_language');
6055 $requested_language = $q->http('HTTP_ACCEPT_LANGUAGE');
6059 The same as I<http()>, but operates on the HTTPS environment variables
6060 present when the SSL protocol is in effect. Can be used to determine
6061 whether SSL is turned on.
6065 =head1 USING NPH SCRIPTS
6067 NPH, or "no-parsed-header", scripts bypass the server completely by
6068 sending the complete HTTP header directly to the browser. This has
6069 slight performance benefits, but is of most use for taking advantage
6070 of HTTP extensions that are not directly supported by your server,
6071 such as server push and PICS headers.
6073 Servers use a variety of conventions for designating CGI scripts as
6074 NPH. Many Unix servers look at the beginning of the script's name for
6075 the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
6076 Internet Information Server, in contrast, try to decide whether a
6077 program is an NPH script by examining the first line of script output.
6080 CGI.pm supports NPH scripts with a special NPH mode. When in this
6081 mode, CGI.pm will output the necessary extra header information when
6082 the header() and redirect() methods are
6085 The Microsoft Internet Information Server requires NPH mode. As of version
6086 2.30, CGI.pm will automatically detect when the script is running under IIS
6087 and put itself into this mode. You do not need to do this manually, although
6088 it won't hurt anything if you do.
6090 There are a number of ways to put CGI.pm into NPH mode:
6094 =item In the B<use> statement
6096 Simply add the "-nph" pragmato the list of symbols to be imported into
6099 use CGI qw(:standard -nph)
6101 =item By calling the B<nph()> method:
6103 Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
6107 =item By using B<-nph> parameters in the B<header()> and B<redirect()> statements:
6109 print $q->header(-nph=>1);
6115 CGI.pm provides three simple functions for producing multipart
6116 documents of the type needed to implement server push. These
6117 functions were graciously provided by Ed Jordan <ed@fidalgo.net>. To
6118 import these into your namespace, you must import the ":push" set.
6119 You are also advised to put the script into NPH mode and to set $| to
6120 1 to avoid buffering problems.
6122 Here is a simple script that demonstrates server push:
6124 #!/usr/local/bin/perl
6125 use CGI qw/:push -nph/;
6127 print multipart_init(-boundary=>'----------------here we go!');
6129 print multipart_start(-type=>'text/plain'),
6130 "The current time is ",scalar(localtime),"\n",
6135 This script initializes server push by calling B<multipart_init()>.
6136 It then enters an infinite loop in which it begins a new multipart
6137 section by calling B<multipart_start()>, prints the current local time,
6138 and ends a multipart section with B<multipart_end()>. It then sleeps
6139 a second, and begins again.
6143 =item multipart_init()
6145 multipart_init(-boundary=>$boundary);
6147 Initialize the multipart system. The -boundary argument specifies
6148 what MIME boundary string to use to separate parts of the document.
6149 If not provided, CGI.pm chooses a reasonable boundary for you.
6151 =item multipart_start()
6153 multipart_start(-type=>$type)
6155 Start a new part of the multipart document using the specified MIME
6156 type. If not specified, text/html is assumed.
6158 =item multipart_end()
6162 End a part. You must remember to call multipart_end() once for each
6167 Users interested in server push applications should also have a look
6168 at the CGI::Push module.
6170 =head1 Avoiding Denial of Service Attacks
6172 A potential problem with CGI.pm is that, by default, it attempts to
6173 process form POSTings no matter how large they are. A wily hacker
6174 could attack your site by sending a CGI script a huge POST of many
6175 megabytes. CGI.pm will attempt to read the entire POST into a
6176 variable, growing hugely in size until it runs out of memory. While
6177 the script attempts to allocate the memory the system may slow down
6178 dramatically. This is a form of denial of service attack.
6180 Another possible attack is for the remote user to force CGI.pm to
6181 accept a huge file upload. CGI.pm will accept the upload and store it
6182 in a temporary directory even if your script doesn't expect to receive
6183 an uploaded file. CGI.pm will delete the file automatically when it
6184 terminates, but in the meantime the remote user may have filled up the
6185 server's disk space, causing problems for other programs.
6187 The best way to avoid denial of service attacks is to limit the amount
6188 of memory, CPU time and disk space that CGI scripts can use. Some Web
6189 servers come with built-in facilities to accomplish this. In other
6190 cases, you can use the shell I<limit> or I<ulimit>
6191 commands to put ceilings on CGI resource usage.
6194 CGI.pm also has some simple built-in protections against denial of
6195 service attacks, but you must activate them before you can use them.
6196 These take the form of two global variables in the CGI name space:
6200 =item B<$CGI::POST_MAX>
6202 If set to a non-negative integer, this variable puts a ceiling
6203 on the size of POSTings, in bytes. If CGI.pm detects a POST
6204 that is greater than the ceiling, it will immediately exit with an error
6205 message. This value will affect both ordinary POSTs and
6206 multipart POSTs, meaning that it limits the maximum size of file
6207 uploads as well. You should set this to a reasonably high
6208 value, such as 1 megabyte.
6210 =item B<$CGI::DISABLE_UPLOADS>
6212 If set to a non-zero value, this will disable file uploads
6213 completely. Other fill-out form values will work as usual.
6217 You can use these variables in either of two ways.
6221 =item B<1. On a script-by-script basis>
6223 Set the variable at the top of the script, right after the "use" statement:
6225 use CGI qw/:standard/;
6226 use CGI::Carp 'fatalsToBrowser';
6227 $CGI::POST_MAX=1024 * 100; # max 100K posts
6228 $CGI::DISABLE_UPLOADS = 1; # no uploads
6230 =item B<2. Globally for all scripts>
6232 Open up CGI.pm, find the definitions for $POST_MAX and
6233 $DISABLE_UPLOADS, and set them to the desired values. You'll
6234 find them towards the top of the file in a subroutine named
6235 initialize_globals().
6239 An attempt to send a POST larger than $POST_MAX bytes will cause
6240 I<param()> to return an empty CGI parameter list. You can test for
6241 this event by checking I<cgi_error()>, either after you create the CGI
6242 object or, if you are using the function-oriented interface, call
6243 <param()> for the first time. If the POST was intercepted, then
6244 cgi_error() will return the message "413 POST too large".
6246 This error message is actually defined by the HTTP protocol, and is
6247 designed to be returned to the browser as the CGI script's status
6250 $uploaded_file = param('upload');
6251 if (!$uploaded_file && cgi_error()) {
6252 print header(-status=>cgi_error());
6256 However it isn't clear that any browser currently knows what to do
6257 with this status code. It might be better just to create an
6258 HTML page that warns the user of the problem.
6260 =head1 COMPATIBILITY WITH CGI-LIB.PL
6262 To make it easier to port existing programs that use cgi-lib.pl the
6263 compatibility routine "ReadParse" is provided. Porting is simple:
6266 require "cgi-lib.pl";
6268 print "The value of the antique is $in{antique}.\n";
6273 print "The value of the antique is $in{antique}.\n";
6275 CGI.pm's ReadParse() routine creates a tied variable named %in,
6276 which can be accessed to obtain the query variables. Like
6277 ReadParse, you can also provide your own variable. Infrequently
6278 used features of ReadParse, such as the creation of @in and $in
6279 variables, are not supported.
6281 Once you use ReadParse, you can retrieve the query object itself
6285 print $q->textfield(-name=>'wow',
6286 -value=>'does this really work?');
6288 This allows you to start using the more interesting features
6289 of CGI.pm without rewriting your old scripts from scratch.
6291 =head1 AUTHOR INFORMATION
6293 Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
6295 This library is free software; you can redistribute it and/or modify
6296 it under the same terms as Perl itself.
6298 Address bug reports and comments to: lstein@cshl.org. When sending
6299 bug reports, please provide the version of CGI.pm, the version of
6300 Perl, the name and version of your Web server, and the name and
6301 version of the operating system you are using. If the problem is even
6302 remotely browser dependent, please provide information about the
6303 affected browers as well.
6307 Thanks very much to:
6311 =item Matt Heffron (heffron@falstaff.css.beckman.com)
6313 =item James Taylor (james.taylor@srs.gov)
6315 =item Scott Anguish <sanguish@digifix.com>
6317 =item Mike Jewell (mlj3u@virginia.edu)
6319 =item Timothy Shimmin (tes@kbs.citri.edu.au)
6321 =item Joergen Haegg (jh@axis.se)
6323 =item Laurent Delfosse (delfosse@delfosse.com)
6325 =item Richard Resnick (applepi1@aol.com)
6327 =item Craig Bishop (csb@barwonwater.vic.gov.au)
6329 =item Tony Curtis (tc@vcpc.univie.ac.at)
6331 =item Tim Bunce (Tim.Bunce@ig.co.uk)
6333 =item Tom Christiansen (tchrist@convex.com)
6335 =item Andreas Koenig (k@franz.ww.TU-Berlin.DE)
6337 =item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au)
6339 =item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu)
6341 =item Stephen Dahmen (joyfire@inxpress.net)
6343 =item Ed Jordan (ed@fidalgo.net)
6345 =item David Alan Pisoni (david@cnation.com)
6347 =item Doug MacEachern (dougm@opengroup.org)
6349 =item Robin Houston (robin@oneworld.org)
6351 =item ...and many many more...
6353 for suggestions and bug fixes.
6357 =head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
6360 #!/usr/local/bin/perl
6366 print $query->header;
6367 print $query->start_html("Example CGI.pm Form");
6368 print "<H1> Example CGI.pm Form</H1>\n";
6369 &print_prompt($query);
6372 print $query->end_html;
6377 print $query->start_form;
6378 print "<EM>What's your name?</EM><BR>";
6379 print $query->textfield('name');
6380 print $query->checkbox('Not my real name');
6382 print "<P><EM>Where can you find English Sparrows?</EM><BR>";
6383 print $query->checkbox_group(
6384 -name=>'Sparrow locations',
6385 -values=>[England,France,Spain,Asia,Hoboken],
6387 -defaults=>[England,Asia]);
6389 print "<P><EM>How far can they fly?</EM><BR>",
6390 $query->radio_group(
6392 -values=>['10 ft','1 mile','10 miles','real far'],
6393 -default=>'1 mile');
6395 print "<P><EM>What's your favorite color?</EM> ";
6396 print $query->popup_menu(-name=>'Color',
6397 -values=>['black','brown','red','yellow'],
6400 print $query->hidden('Reference','Monty Python and the Holy Grail');
6402 print "<P><EM>What have you got there?</EM><BR>";
6403 print $query->scrolling_list(
6404 -name=>'possessions',
6405 -values=>['A Coconut','A Grail','An Icon',
6406 'A Sword','A Ticket'],
6410 print "<P><EM>Any parting comments?</EM><BR>";
6411 print $query->textarea(-name=>'Comments',
6415 print "<P>",$query->reset;
6416 print $query->submit('Action','Shout');
6417 print $query->submit('Action','Scream');
6418 print $query->endform;
6426 print "<H2>Here are the current settings in this form</H2>";
6428 foreach $key ($query->param) {
6429 print "<STRONG>$key</STRONG> -> ";
6430 @values = $query->param($key);
6431 print join(", ",@values),"<BR>\n";
6438 <ADDRESS>Lincoln D. Stein</ADDRESS><BR>
6439 <A HREF="/">Home Page</A>
6445 This module has grown large and monolithic. Furthermore it's doing many
6446 things, such as handling URLs, parsing CGI input, writing HTML, etc., that
6447 are also done in the LWP modules. It should be discarded in favor of
6448 the CGI::* modules, but somehow I continue to work on it.
6450 Note that the code is truly contorted in order to avoid spurious
6451 warnings when programs are run with the B<-w> switch.
6455 L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
6456 L<CGI::Base>, L<CGI::Form>, L<CGI::Push>, L<CGI::Fast>,