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-1997 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://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
19 # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
21 # Set this to 1 to enable copious autoloader debugging messages
24 # Set this to 1 to enable NPH scripts
28 # 3) print header(-nph=>1)
31 $CGI::revision = '$Id: CGI.pm,v 2.32 1997/3/19 10:10 lstein Exp $';
32 $CGI::VERSION='2.3202';
34 # OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG
41 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
42 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
43 # $TempFile::TMPDIRECTORY = '/usr/tmp';
45 # ------------------ START OF THE LIBRARY ------------
47 # FIGURE OUT THE OS WE'RE RUNNING UNDER
48 # Some systems support the $^O variable. If not
49 # available then require() the Config library
53 $OS = $Config::Config{'osname'};
58 } elsif ($OS=~/vms/i) {
60 } elsif ($OS=~/Mac/i) {
62 } elsif ($OS=~/os2/i) {
68 # Some OS logic. Binary mode enabled on DOS, NT and VMS
69 $needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;
71 # This is the default class for the CGI object to use when all else fails.
72 $DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
73 # This is where to look for autoloaded routines.
74 $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
76 # The path separator is a slash, backslash or semicolon, depending
86 # Turn on NPH scripts by default when running under IIS server!
87 $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
89 # Turn on special checking for Doug MacEachern's modperl
90 if (defined($MOD_PERL = $ENV{'GATEWAY_INTERFACE'}) &&
91 $MOD_PERL =~ /^CGI-Perl/)
98 # This is really "\r\n", but the meaning of \n is different
99 # in MacPerl, so we resort to octal here.
102 if ($needs_binmode) {
103 $CGI::DefaultClass->binmode(main::STDOUT);
104 $CGI::DefaultClass->binmode(main::STDIN);
105 $CGI::DefaultClass->binmode(main::STDERR);
108 # Cute feature, but it broke when the overload mechanism changed...
109 # %OVERLOAD = ('""'=>'as_string');
112 ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em
113 tt i b blockquote pre img a address cite samp dfn html head
114 base body link nextid title meta kbd start_html end_html
115 input Select option/],
116 ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont/],
117 ':netscape'=>[qw/blink frameset frame script font fontsize center/],
118 ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
119 submit reset defaults radio_group popup_menu button autoEscape
120 scrolling_list image_button start_form end_form startform endform
121 start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
122 ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
123 raw_cookie request_method query_string accept user_agent remote_host
124 remote_addr referer server_name server_software server_port server_protocol
125 virtual_host remote_ident auth_type http
126 remote_user user_name header redirect import_names put/],
127 ':ssl' => [qw/https/],
128 ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
129 ':html' => [qw/:html2 :html3 :netscape/],
130 ':standard' => [qw/:html2 :form :cgi/],
131 ':all' => [qw/:html2 :html3 :netscape :form :cgi/]
134 # to import symbols into caller
137 my ($callpack, $callfile, $callline) = caller;
139 $NPH++, next if $_ eq ':nph';
140 foreach (&expand_tags($_)) {
141 tr/a-zA-Z0-9_//cd; # don't allow weird function names
145 # To allow overriding, search through the packages
146 # Till we find one in which the correct subroutine is defined.
147 my @packages = ($self,@{"$self\:\:ISA"});
148 foreach $sym (keys %EXPORT) {
150 my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
151 foreach $pck (@packages) {
152 if (defined(&{"$pck\:\:$sym"})) {
157 *{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
164 return ($tag) unless $EXPORT_TAGS{$tag};
165 foreach (@{$EXPORT_TAGS{$tag}}) {
166 push(@r,&expand_tags($_));
172 # The new routine. This will check the current environment
173 # for an existing query string, and initialize itself, if so.
176 my($class,$initializer) = @_;
178 bless $self,ref $class || $class || $DefaultClass;
179 $CGI::DefaultClass->_reset_globals() if $MOD_PERL;
180 $initializer = to_filehandle($initializer) if $initializer;
181 $self->init($initializer);
185 # We provide a DESTROY method so that the autoloader
186 # doesn't bother trying to find it.
190 # Returns the value(s)of a named parameter.
191 # If invoked in a list context, returns the
192 # entire list. Otherwise returns the first
193 # member of the list.
194 # If name is not provided, return a list of all
195 # the known parameters names available.
196 # If more than one argument is provided, the
197 # second and subsequent arguments are used to
198 # set the value of the parameter.
201 my($self,@p) = self_or_default(@_);
202 return $self->all_parameters unless @p;
203 my($name,$value,@other);
205 # For compatibility between old calling style and use_named_parameters() style,
206 # we have to special case for a single parameter present.
208 ($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
211 if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
212 @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
214 foreach ($value,@other) {
215 push(@values,$_) if defined($_);
218 # If values is provided, then we set it.
220 $self->add_parameter($name);
221 $self->{$name}=[@values];
227 return () unless defined($name) && $self->{$name};
228 return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
232 # Deletes the named parameter entirely.
235 my($self,$name) = self_or_default(@_);
236 delete $self->{$name};
237 delete $self->{'.fieldnames'}->{$name};
238 @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
239 return wantarray ? () : undef;
242 sub self_or_default {
243 return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI');
244 unless (defined($_[0]) &&
246 (ref($_[0]) eq 'CGI' ||
247 eval "\$_[0]->isaCGI()")) { # optimize for the common case
248 $CGI::DefaultClass->_reset_globals()
249 if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request();
250 $Q = $CGI::DefaultClass->new unless defined($Q);
257 return undef unless (defined(Apache->seqno()) or eval { require Apache });
258 if (Apache->seqno() != $SEQNO) {
259 $SEQNO = Apache->seqno();
272 local $^W=0; # prevent a warning
273 if (defined($_[0]) &&
274 (substr(ref($_[0]),0,3) eq 'CGI'
275 || eval "\$_[0]->isaCGI()")) {
278 return ($DefaultClass,@_);
286 #### Method: import_names
287 # Import all parameters into the given namespace.
288 # Assumes namespace 'Q' if not specified
291 my($self,$namespace) = self_or_default(@_);
292 $namespace = 'Q' unless defined($namespace);
293 die "Can't import names into 'main'\n"
294 if $namespace eq 'main';
295 my($param,@value,$var);
296 foreach $param ($self->param) {
297 # protect against silly names
298 ($var = $param)=~tr/a-zA-Z0-9_/_/c;
299 $var = "${namespace}::$var";
300 @value = $self->param($param);
306 #### Method: use_named_parameters
307 # Force CGI.pm to use named parameter-style method calls
308 # rather than positional parameters. The same effect
309 # will happen automatically if the first parameter
311 sub use_named_parameters {
312 my($self,$use_named) = self_or_default(@_);
313 return $self->{'.named'} unless defined ($use_named);
315 # stupidity to avoid annoying warnings
316 return $self->{'.named'}=$use_named;
319 ########################################
320 # THESE METHODS ARE MORE OR LESS PRIVATE
321 # GO TO THE __DATA__ SECTION TO SEE MORE
323 ########################################
325 # Initialize the query object from the environment.
326 # If a parameter list is found, this object will be set
327 # to an associative array in which parameter names are keys
328 # and the values are stored as lists
329 # If a keyword list is found, this method creates a bogus
330 # parameter list with the single parameter 'keywords'.
333 my($self,$initializer) = @_;
334 my($query_string,@lines);
337 # if we get called more than once, we want to initialize
338 # ourselves from the original query (which may be gone
339 # if it was read from STDIN originally.)
340 if (defined(@QUERY_PARAM) && !defined($initializer)) {
342 foreach (@QUERY_PARAM) {
343 $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
348 $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
350 # If initializer is defined, then read parameters
353 if (defined($initializer)) {
355 if (ref($initializer) && ref($initializer) eq 'HASH') {
356 foreach (keys %$initializer) {
357 $self->param('-name'=>$_,'-value'=>$initializer->{$_});
362 $initializer = $$initializer if ref($initializer);
363 if (defined(fileno($initializer))) {
364 while (<$initializer>) {
369 # massage back into standard format
370 if ("@lines" =~ /=/) {
371 $query_string=join("&",@lines);
373 $query_string=join("+",@lines);
377 $query_string = $initializer;
380 # If method is GET or HEAD, fetch the query from
382 if ($meth=~/^(GET|HEAD)$/) {
383 $query_string = $ENV{'QUERY_STRING'};
387 # If the method is POST, fetch the query from standard
389 if ($meth eq 'POST') {
391 if (defined($ENV{'CONTENT_TYPE'})
393 $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) {
394 my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/;
395 $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'});
399 $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0)
400 if $ENV{'CONTENT_LENGTH'} > 0;
403 # Some people want to have their cake and eat it too!
404 # Uncomment this line to have the contents of the query string
405 # APPENDED to the POST data.
406 # $query_string .= ($query_string ? '&' : '') . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'};
410 # If neither is set, assume we're being debugged offline.
411 # Check the command line and then the standard input for data.
412 # We use the shellwords package in order to behave the way that
413 # UN*X programmers expect.
414 $query_string = &read_from_cmdline;
417 # We now have the query string in hand. We do slightly
418 # different things for keyword lists and parameter lists.
420 if ($query_string =~ /=/) {
421 $self->parse_params($query_string);
423 $self->add_parameter('keywords');
424 $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
428 # Special case. Erase everything if there is a field named
430 if ($self->param('.defaults')) {
434 # Associative array containing our defined fieldnames
435 $self->{'.fieldnames'} = {};
436 foreach ($self->param('.cgifields')) {
437 $self->{'.fieldnames'}->{$_}++;
440 # Clear out our default submission button flag if present
441 $self->delete('.submit');
442 $self->delete('.cgifields');
443 $self->save_request unless $initializer;
448 # FUNCTIONS TO OVERRIDE:
450 # Turn a string into a filehandle
453 if ($string && !ref($string)) {
454 my($package) = caller(1);
455 my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string";
456 return $tmp if defined(fileno($tmp));
461 # Create a new multipart buffer
462 sub new_MultipartBuffer {
463 my($self,$boundary,$length,$filehandle) = @_;
464 return MultipartBuffer->new($self,$boundary,$length,$filehandle);
467 # Read data from a file handle
468 sub read_from_client {
469 my($self, $fh, $buff, $len, $offset) = @_;
470 local $^W=0; # prevent a warning
471 return read($fh, $$buff, $len, $offset);
474 # put a filehandle into binary mode (DOS)
479 # send output to the browser
481 my($self,@p) = self_or_default(@_);
485 # print to standard output (for overriding in mod_perl)
491 # unescape URL-encoded data
494 $todecode =~ tr/+/ /; # pluses become spaces
495 $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
502 $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
508 # We're going to play with the package globals now so that if we get called
509 # again, we initialize ourselves in exactly the same way. This allows
510 # us to have several of these objects.
511 @QUERY_PARAM = $self->param; # save list of parameters
512 foreach (@QUERY_PARAM) {
513 $QUERY_PARAM{$_}=$self->{$_};
517 sub parse_keywordlist {
518 my($self,$tosplit) = @_;
519 $tosplit = &unescape($tosplit); # unescape the keywords
520 $tosplit=~tr/+/ /; # pluses to spaces
521 my(@keywords) = split(/\s+/,$tosplit);
526 my($self,$tosplit) = @_;
527 my(@pairs) = split('&',$tosplit);
530 ($param,$value) = split('=');
531 $param = &unescape($param);
532 $value = &unescape($value);
533 $self->add_parameter($param);
534 push (@{$self->{$param}},$value);
540 push (@{$self->{'.parameters'}},$param)
541 unless defined($self->{$param});
546 return () unless defined($self) && $self->{'.parameters'};
547 return () unless @{$self->{'.parameters'}};
548 return @{$self->{'.parameters'}};
553 #### Method as_string
562 print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
563 my($func) = $AUTOLOAD;
564 my($pack,$func_name) = $func=~/(.+)::([^:]+)$/;
565 $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
566 unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
568 my($sub) = \%{"$pack\:\:SUBS"};
570 my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
571 eval "package $pack; $$auto";
574 my($code) = $sub->{$func_name};
576 $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
578 if ($EXPORT{':any'} ||
579 $EXPORT{$func_name} ||
580 (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
581 && $EXPORT_OK{$func_name}) {
582 $code = $sub->{'HTML_FUNC'};
583 $code=~s/func_name/$func_name/mg;
586 die "Undefined subroutine $AUTOLOAD\n" unless $code;
587 eval "package $pack; $code";
592 goto &{"$pack\:\:$func_name"};
596 # Smart rearrangement of parameters to allow named parameter
597 # calling. We do the rearangement if:
598 # 1. The first parameter begins with a -
599 # 2. The use_named_parameters() method returns true
601 my($self,$order,@param) = @_;
602 return () unless @param;
604 return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-')
605 || $self->use_named_parameters;
608 for ($i=0;$i<@param;$i+=2) {
609 $param[$i]=~s/^\-//; # get rid of initial - if present
610 $param[$i]=~tr/a-z/A-Z/; # parameters are upper case
613 my(%param) = @param; # convert into associative array
617 foreach $key (@$order) {
619 # this is an awful hack to fix spurious warnings when the
621 if (ref($key) && ref($key) eq 'ARRAY') {
623 last if defined($value);
628 $value = $param{$key};
631 push(@return_array,$value);
633 push (@return_array,$self->make_attributes(\%param)) if %param;
634 return (@return_array);
637 ###############################################################################
638 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
639 ###############################################################################
640 $AUTOLOADED_ROUTINES = ''; # get rid of -w warning
641 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
645 'URL_ENCODED'=> <<'END_OF_FUNC',
646 sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
649 'MULTIPART' => <<'END_OF_FUNC',
650 sub MULTIPART { 'multipart/form-data'; }
653 'HTML_FUNC' => <<'END_OF_FUNC',
656 # handle various cases in which we're called
657 # most of this bizarre stuff is to avoid -w errors
659 (!ref($_[0]) && $_[0] eq $CGI::DefaultClass) ||
661 (substr(ref($_[0]),0,3) eq 'CGI' ||
662 eval "\$_[0]->isaCGI()"));
665 if (ref($_[0]) && ref($_[0]) eq 'HASH') {
666 my(@attr) = CGI::make_attributes('',shift);
667 $attr = " @attr" if @attr;
669 my($tag,$untag) = ("\U<func_name\E$attr>","\U</func_name>\E");
670 return $tag unless @_;
671 if (ref($_[0]) eq 'ARRAY') {
674 push(@r,"$tag$_$untag");
678 return "$tag@_$untag";
683 #### Method: keywords
684 # Keywords acts a bit differently. Calling it in a list context
685 # returns the list of keywords.
686 # Calling it in a scalar context gives you the size of the list.
688 'keywords' => <<'END_OF_FUNC',
690 my($self,@values) = self_or_default(@_);
691 # If values is provided, then we set it.
692 $self->{'keywords'}=[@values] if @values;
693 my(@result) = @{$self->{'keywords'}};
698 # These are some tie() interfaces for compatibility
699 # with Steve Brenner's cgi-lib.pl routines
700 'ReadParse' => <<'END_OF_FUNC',
713 'PrintHeader' => <<'END_OF_FUNC',
715 my($self) = self_or_default(@_);
716 return $self->header();
720 'HtmlTop' => <<'END_OF_FUNC',
722 my($self,@p) = self_or_default(@_);
723 return $self->start_html(@p);
727 'HtmlBot' => <<'END_OF_FUNC',
729 my($self,@p) = self_or_default(@_);
730 return $self->end_html(@p);
734 'SplitParam' => <<'END_OF_FUNC',
737 my (@params) = split ("\0", $param);
738 return (wantarray ? @params : $params[0]);
742 'MethGet' => <<'END_OF_FUNC',
744 return request_method() eq 'GET';
748 'MethPost' => <<'END_OF_FUNC',
750 return request_method() eq 'POST';
754 'TIEHASH' => <<'END_OF_FUNC',
760 'STORE' => <<'END_OF_FUNC',
762 $_[0]->param($_[1],split("\0",$_[2]));
766 'FETCH' => <<'END_OF_FUNC',
768 return $_[0] if $_[1] eq 'CGI';
769 return undef unless defined $_[0]->param($_[1]);
770 return join("\0",$_[0]->param($_[1]));
774 'FIRSTKEY' => <<'END_OF_FUNC',
776 $_[0]->{'.iterator'}=0;
777 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
781 'NEXTKEY' => <<'END_OF_FUNC',
783 $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
787 'EXISTS' => <<'END_OF_FUNC',
789 exists $_[0]->{$_[1]};
793 'DELETE' => <<'END_OF_FUNC',
795 $_[0]->delete($_[1]);
799 'CLEAR' => <<'END_OF_FUNC',
807 # Append a new value to an existing query
812 my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
813 my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
815 $self->add_parameter($name);
816 push(@{$self->{$name}},@values);
818 return $self->param($name);
822 #### Method: delete_all
823 # Delete all parameters
825 'delete_all' => <<'EOF',
827 my($self) = self_or_default(@_);
832 #### Method: autoescape
833 # If you want to turn off the autoescaping features,
834 # call this method with undef as the argument
835 'autoEscape' => <<'END_OF_FUNC',
837 my($self,$escape) = self_or_default(@_);
838 $self->{'dontescape'}=!$escape;
844 # Return the current version
846 'version' => <<'END_OF_FUNC',
852 'make_attributes' => <<'END_OF_FUNC',
853 sub make_attributes {
854 my($self,$attr) = @_;
855 return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
857 foreach (keys %{$attr}) {
859 $key=~s/^\-//; # get rid of initial - if present
860 $key=~tr/a-z/A-Z/; # parameters are upper case
861 push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/);
868 # Returns a string in which all the known parameter/value
869 # pairs are represented as nested lists, mainly for the purposes
872 'dump' => <<'END_OF_FUNC',
874 my($self) = self_or_default(@_);
875 my($param,$value,@result);
876 return '<UL></UL>' unless $self->param;
877 push(@result,"<UL>");
878 foreach $param ($self->param) {
879 my($name)=$self->escapeHTML($param);
880 push(@result,"<LI><STRONG>$param</STRONG>");
881 push(@result,"<UL>");
882 foreach $value ($self->param($param)) {
883 $value = $self->escapeHTML($value);
884 push(@result,"<LI>$value");
886 push(@result,"</UL>");
888 push(@result,"</UL>\n");
889 return join("\n",@result);
895 # Write values out to a filehandle in such a way that they can
896 # be reinitialized by the filehandle form of the new() method
898 'save' => <<'END_OF_FUNC',
900 my($self,$filehandle) = self_or_default(@_);
902 my($package) = caller;
903 # Check that this still works!
904 # $filehandle = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
905 $filehandle = to_filehandle($filehandle);
906 foreach $param ($self->param) {
907 my($escaped_param) = &escape($param);
909 foreach $value ($self->param($param)) {
910 print $filehandle "$escaped_param=",escape($value),"\n";
913 print $filehandle "=\n"; # end of record
919 # Return a Content-Type: style header
922 'header' => <<'END_OF_FUNC',
924 my($self,@p) = self_or_default(@_);
927 my($type,$status,$cookie,$target,$expires,$nph,@other) =
928 $self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
930 # rearrange() was designed for the HTML portion, so we
931 # need to fix it up a little.
933 next unless my($header,$value) = /([^\s=]+)=(.+)/;
934 substr($header,1,1000)=~tr/A-Z/a-z/;
935 ($value)=$value=~/^"(.*)"$/;
936 $_ = "$header: $value";
939 $type = $type || 'text/html';
941 push(@header,'HTTP/1.0 ' . ($status || '200 OK')) if $nph || $NPH;
942 push(@header,"Status: $status") if $status;
943 push(@header,"Window-target: $target") if $target;
944 # push all the cookies -- there may be several
946 my(@cookie) = ref($cookie) ? @{$cookie} : $cookie;
948 push(@header,"Set-cookie: $_");
951 # if the user indicates an expiration time, then we need
952 # both an Expires and a Date header (so that the browser is
954 push(@header,"Expires: " . &expires($expires)) if $expires;
955 push(@header,"Date: " . &expires(0)) if $expires;
956 push(@header,"Pragma: no-cache") if $self->cache();
957 push(@header,@other);
958 push(@header,"Content-type: $type");
960 my $header = join($CRLF,@header);
961 return $header . "${CRLF}${CRLF}";
967 # Control whether header() will produce the no-cache
970 'cache' => <<'END_OF_FUNC',
972 my($self,$new_value) = self_or_default(@_);
973 $new_value = '' unless $new_value;
974 if ($new_value ne '') {
975 $self->{'cache'} = $new_value;
977 return $self->{'cache'};
982 #### Method: redirect
983 # Return a Location: style header
986 'redirect' => <<'END_OF_FUNC',
988 my($self,@p) = self_or_default(@_);
989 my($url,$target,$cookie,$nph,@other) =
990 $self->rearrange([[URI,URL],TARGET,COOKIE,NPH],@p);
991 $url = $url || $self->self_url;
993 foreach (@other) { push(@o,split("=")); }
994 if ($MOD_PERL or exists $self->{'.req'}) {
995 my $r = $self->{'.req'} || Apache->request;
996 $r->header_out(Location => $url);
997 $r->err_header_out(Location => $url);
1002 '-Status'=>'302 Found',
1005 '-nph'=>($nph||$NPH));
1006 push(@o,'-Target'=>$target) if $target;
1007 push(@o,'-Cookie'=>$cookie) if $cookie;
1008 return $self->header(@o);
1013 #### Method: start_html
1014 # Canned HTML header
1017 # $title -> (optional) The title for this HTML document (-title)
1018 # $author -> (optional) e-mail address of the author (-author)
1019 # $base -> (optional) if set to true, will enter the BASE address of this document
1020 # for resolving relative references (-base)
1021 # $xbase -> (optional) alternative base at some remote location (-xbase)
1022 # $target -> (optional) target window to load all links into (-target)
1023 # $script -> (option) Javascript code (-script)
1024 # $meta -> (optional) Meta information tags
1025 # @other -> (optional) any other named parameters you'd like to incorporate into
1028 'start_html' => <<'END_OF_FUNC',
1030 my($self,@p) = &self_or_default(@_);
1031 my($title,$author,$base,$xbase,$script,$target,$meta,@other) =
1032 $self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,TARGET,META],@p);
1034 # strangely enough, the title needs to be escaped as HTML
1035 # while the author needs to be escaped as a URL
1036 $title = $self->escapeHTML($title || 'Untitled Document');
1037 $author = $self->escapeHTML($author);
1039 push(@result,'<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
1040 push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
1041 push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if $author;
1043 if ($base || $xbase || $target) {
1044 my $href = $xbase || $self->url();
1045 my $t = $target ? qq/ TARGET="$target"/ : '';
1046 push(@result,qq/<BASE HREF="$href"$t>/);
1049 if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
1050 foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
1052 push(@result,<<END) if $script;
1054 <!-- Hide script from HTML-compliant browsers
1056 // End script hiding. -->
1060 my($other) = @other ? " @other" : '';
1061 push(@result,"</HEAD><BODY$other>");
1062 return join("\n",@result);
1067 #### Method: end_html
1068 # End an HTML document.
1069 # Trivial method for completeness. Just returns "</BODY>"
1071 'end_html' => <<'END_OF_FUNC',
1073 return "</BODY></HTML>";
1078 ################################
1079 # METHODS USED IN BUILDING FORMS
1080 ################################
1082 #### Method: isindex
1083 # Just prints out the isindex tag.
1085 # $action -> optional URL of script to run
1087 # A string containing a <ISINDEX> tag
1088 'isindex' => <<'END_OF_FUNC',
1090 my($self,@p) = self_or_default(@_);
1091 my($action,@other) = $self->rearrange([ACTION],@p);
1092 $action = qq/ACTION="$action"/ if $action;
1093 my($other) = @other ? " @other" : '';
1094 return "<ISINDEX $action$other>";
1099 #### Method: startform
1102 # $method -> optional submission method to use (GET or POST)
1103 # $action -> optional URL of script to run
1104 # $enctype ->encoding to use (URL_ENCODED or MULTIPART)
1105 'startform' => <<'END_OF_FUNC',
1107 my($self,@p) = self_or_default(@_);
1109 my($method,$action,$enctype,@other) =
1110 $self->rearrange([METHOD,ACTION,ENCTYPE],@p);
1112 $method = $method || 'POST';
1113 $enctype = $enctype || &URL_ENCODED;
1114 $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
1115 'ACTION="'.$self->script_name.'"' : '';
1116 my($other) = @other ? " @other" : '';
1117 $self->{'.parametersToAdd'}={};
1118 return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
1123 #### Method: start_form
1124 # synonym for startform
1125 'start_form' => <<'END_OF_FUNC',
1132 #### Method: start_multipart_form
1133 # synonym for startform
1134 'start_multipart_form' => <<'END_OF_FUNC',
1135 sub start_multipart_form {
1136 my($self,@p) = self_or_default(@_);
1137 if ($self->use_named_parameters ||
1138 (defined($param[0]) && substr($param[0],0,1) eq '-')) {
1140 $p{'-enctype'}=&MULTIPART;
1141 return $self->startform(%p);
1143 my($method,$action,@other) =
1144 $self->rearrange([METHOD,ACTION],@p);
1145 return $self->startform($method,$action,&MULTIPART,@other);
1151 #### Method: endform
1153 'endform' => <<'END_OF_FUNC',
1155 my($self,@p) = self_or_default(@_);
1156 return ($self->get_fields,"</FORM>");
1161 #### Method: end_form
1162 # synonym for endform
1163 'end_form' => <<'END_OF_FUNC',
1170 #### Method: textfield
1172 # $name -> Name of the text field
1173 # $default -> Optional default value of the field if not
1175 # $size -> Optional width of field in characaters.
1176 # $maxlength -> Optional maximum number of characters.
1178 # A string containing a <INPUT TYPE="text"> field
1180 'textfield' => <<'END_OF_FUNC',
1182 my($self,@p) = self_or_default(@_);
1183 my($name,$default,$size,$maxlength,$override,@other) =
1184 $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
1186 my $current = $override ? $default :
1187 (defined($self->param($name)) ? $self->param($name) : $default);
1189 $current = defined($current) ? $self->escapeHTML($current) : '';
1190 $name = defined($name) ? $self->escapeHTML($name) : '';
1191 my($s) = defined($size) ? qq/ SIZE=$size/ : '';
1192 my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
1193 my($other) = @other ? " @other" : '';
1194 return qq/<INPUT TYPE="text" NAME="$name" VALUE="$current"$s$m$other>/;
1199 #### Method: filefield
1201 # $name -> Name of the file upload field
1202 # $size -> Optional width of field in characaters.
1203 # $maxlength -> Optional maximum number of characters.
1205 # A string containing a <INPUT TYPE="text"> field
1207 'filefield' => <<'END_OF_FUNC',
1209 my($self,@p) = self_or_default(@_);
1211 my($name,$default,$size,$maxlength,$override,@other) =
1212 $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
1214 $current = $override ? $default :
1215 (defined($self->param($name)) ? $self->param($name) : $default);
1217 $name = defined($name) ? $self->escapeHTML($name) : '';
1218 my($s) = defined($size) ? qq/ SIZE=$size/ : '';
1219 my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
1220 $current = defined($current) ? $self->escapeHTML($current) : '';
1221 $other = ' ' . join(" ",@other);
1222 return qq/<INPUT TYPE="file" NAME="$name" VALUE="$current"$s$m$other>/;
1227 #### Method: password
1228 # Create a "secret password" entry field
1230 # $name -> Name of the field
1231 # $default -> Optional default value of the field if not
1233 # $size -> Optional width of field in characters.
1234 # $maxlength -> Optional maximum characters that can be entered.
1236 # A string containing a <INPUT TYPE="password"> field
1238 'password_field' => <<'END_OF_FUNC',
1239 sub password_field {
1240 my ($self,@p) = self_or_default(@_);
1242 my($name,$default,$size,$maxlength,$override,@other) =
1243 $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
1245 my($current) = $override ? $default :
1246 (defined($self->param($name)) ? $self->param($name) : $default);
1248 $name = defined($name) ? $self->escapeHTML($name) : '';
1249 $current = defined($current) ? $self->escapeHTML($current) : '';
1250 my($s) = defined($size) ? qq/ SIZE=$size/ : '';
1251 my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
1252 my($other) = @other ? " @other" : '';
1253 return qq/<INPUT TYPE="password" NAME="$name" VALUE="$current"$s$m$other>/;
1258 #### Method: textarea
1260 # $name -> Name of the text field
1261 # $default -> Optional default value of the field if not
1263 # $rows -> Optional number of rows in text area
1264 # $columns -> Optional number of columns in text area
1266 # A string containing a <TEXTAREA></TEXTAREA> tag
1268 'textarea' => <<'END_OF_FUNC',
1270 my($self,@p) = self_or_default(@_);
1272 my($name,$default,$rows,$cols,$override,@other) =
1273 $self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
1275 my($current)= $override ? $default :
1276 (defined($self->param($name)) ? $self->param($name) : $default);
1278 $name = defined($name) ? $self->escapeHTML($name) : '';
1279 $current = defined($current) ? $self->escapeHTML($current) : '';
1280 my($r) = $rows ? " ROWS=$rows" : '';
1281 my($c) = $cols ? " COLS=$cols" : '';
1282 my($other) = @other ? " @other" : '';
1283 return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
1289 # Create a javascript button.
1291 # $name -> (optional) Name for the button. (-name)
1292 # $value -> (optional) Value of the button when selected (and visible name) (-value)
1293 # $onclick -> (optional) Text of the JavaScript to run when the button is
1296 # A string containing a <INPUT TYPE="button"> tag
1298 'button' => <<'END_OF_FUNC',
1300 my($self,@p) = self_or_default(@_);
1302 my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
1303 [ONCLICK,SCRIPT]],@p);
1305 $label=$self->escapeHTML($label);
1306 $value=$self->escapeHTML($value);
1307 $script=$self->escapeHTML($script);
1310 $name = qq/ NAME="$label"/ if $label;
1311 $value = $value || $label;
1313 $val = qq/ VALUE="$value"/ if $value;
1314 $script = qq/ ONCLICK="$script"/ if $script;
1315 my($other) = @other ? " @other" : '';
1316 return qq/<INPUT TYPE="button"$name$val$script$other>/;
1322 # Create a "submit query" button.
1324 # $name -> (optional) Name for the button.
1325 # $value -> (optional) Value of the button when selected (also doubles as label).
1326 # $label -> (optional) Label printed on the button(also doubles as the value).
1328 # A string containing a <INPUT TYPE="submit"> tag
1330 'submit' => <<'END_OF_FUNC',
1332 my($self,@p) = self_or_default(@_);
1334 my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
1336 $label=$self->escapeHTML($label);
1337 $value=$self->escapeHTML($value);
1339 my($name) = ' NAME=".submit"';
1340 $name = qq/ NAME="$label"/ if $label;
1341 $value = $value || $label;
1343 $val = qq/ VALUE="$value"/ if defined($value);
1344 my($other) = @other ? " @other" : '';
1345 return qq/<INPUT TYPE="submit"$name$val$other>/;
1351 # Create a "reset" button.
1353 # $name -> (optional) Name for the button.
1355 # A string containing a <INPUT TYPE="reset"> tag
1357 'reset' => <<'END_OF_FUNC',
1359 my($self,@p) = self_or_default(@_);
1360 my($label,@other) = $self->rearrange([NAME],@p);
1361 $label=$self->escapeHTML($label);
1362 my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
1363 my($other) = @other ? " @other" : '';
1364 return qq/<INPUT TYPE="reset"$value$other>/;
1369 #### Method: defaults
1370 # Create a "defaults" button.
1372 # $name -> (optional) Name for the button.
1374 # A string containing a <INPUT TYPE="submit" NAME=".defaults"> tag
1376 # Note: this button has a special meaning to the initialization script,
1377 # and tells it to ERASE the current query string so that your defaults
1380 'defaults' => <<'END_OF_FUNC',
1382 my($self,@p) = self_or_default(@_);
1384 my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
1386 $label=$self->escapeHTML($label);
1387 $label = $label || "Defaults";
1388 my($value) = qq/ VALUE="$label"/;
1389 my($other) = @other ? " @other" : '';
1390 return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
1395 #### Method: checkbox
1396 # Create a checkbox that is not logically linked to any others.
1397 # The field value is "on" when the button is checked.
1399 # $name -> Name of the checkbox
1400 # $checked -> (optional) turned on by default if true
1401 # $value -> (optional) value of the checkbox, 'on' by default
1402 # $label -> (optional) a user-readable label printed next to the box.
1403 # Otherwise the checkbox name is used.
1405 # A string containing a <INPUT TYPE="checkbox"> field
1407 'checkbox' => <<'END_OF_FUNC',
1409 my($self,@p) = self_or_default(@_);
1411 my($name,$checked,$value,$label,$override,@other) =
1412 $self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
1414 if (!$override && defined($self->param($name))) {
1415 $value = $self->param($name) unless defined $value;
1416 $checked = $self->param($name) eq $value ? ' CHECKED' : '';
1418 $checked = $checked ? ' CHECKED' : '';
1419 $value = defined $value ? $value : 'on';
1421 my($the_label) = defined $label ? $label : $name;
1422 $name = $self->escapeHTML($name);
1423 $value = $self->escapeHTML($value);
1424 $the_label = $self->escapeHTML($the_label);
1425 my($other) = @other ? " @other" : '';
1426 $self->register_parameter($name);
1428 <INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label
1434 #### Method: checkbox_group
1435 # Create a list of logically-linked checkboxes.
1437 # $name -> Common name for all the check boxes
1438 # $values -> A pointer to a regular array containing the
1439 # values for each checkbox in the group.
1440 # $defaults -> (optional)
1441 # 1. If a pointer to a regular array of checkbox values,
1442 # then this will be used to decide which
1443 # checkboxes to turn on by default.
1444 # 2. If a scalar, will be assumed to hold the
1445 # value of a single checkbox in the group to turn on.
1446 # $linebreak -> (optional) Set to true to place linebreaks
1447 # between the buttons.
1448 # $labels -> (optional)
1449 # A pointer to an associative array of labels to print next to each checkbox
1450 # in the form $label{'value'}="Long explanatory label".
1451 # Otherwise the provided values are used as the labels.
1453 # An ARRAY containing a series of <INPUT TYPE="checkbox"> fields
1455 'checkbox_group' => <<'END_OF_FUNC',
1456 sub checkbox_group {
1457 my($self,@p) = self_or_default(@_);
1459 my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
1460 $rowheaders,$colheaders,$override,$nolabels,@other) =
1461 $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
1462 LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
1463 ROWHEADERS,COLHEADERS,
1464 [OVERRIDE,FORCE],NOLABELS],@p);
1466 my($checked,$break,$result,$label);
1468 my(%checked) = $self->previous_or_default($name,$defaults,$override);
1470 $break = $linebreak ? "<BR>" : '';
1471 $name=$self->escapeHTML($name);
1473 # Create the elements
1475 my(@values) = $values ? @$values : $self->param($name);
1476 my($other) = @other ? " @other" : '';
1478 $checked = $checked{$_} ? ' CHECKED' : '';
1480 unless (defined($nolabels) && $nolabels) {
1482 $label = $labels->{$_} if defined($labels) && $labels->{$_};
1483 $label = $self->escapeHTML($label);
1485 $_ = $self->escapeHTML($_);
1486 push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label} ${break}/);
1488 $self->register_parameter($name);
1489 return wantarray ? @elements : join('',@elements) unless $columns;
1490 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1495 # Escape HTML -- used internally
1496 'escapeHTML' => <<'END_OF_FUNC',
1498 my($self,$toencode) = @_;
1499 return undef unless defined($toencode);
1500 return $toencode if $self->{'dontescape'};
1501 $toencode=~s/&/&/g;
1502 $toencode=~s/\"/"/g;
1503 $toencode=~s/>/>/g;
1504 $toencode=~s/</</g;
1510 # Internal procedure - don't use
1511 '_tableize' => <<'END_OF_FUNC',
1513 my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
1516 $rows = int(0.99 + @elements/$columns) unless $rows;
1517 # rearrange into a pretty table
1518 $result = "<TABLE>";
1520 unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
1521 $result .= "<TR>" if @{$colheaders};
1522 foreach (@{$colheaders}) {
1523 $result .= "<TH>$_</TH>";
1525 for ($row=0;$row<$rows;$row++) {
1527 $result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
1528 for ($column=0;$column<$columns;$column++) {
1529 $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>";
1533 $result .= "</TABLE>";
1539 #### Method: radio_group
1540 # Create a list of logically-linked radio buttons.
1542 # $name -> Common name for all the buttons.
1543 # $values -> A pointer to a regular array containing the
1544 # values for each button in the group.
1545 # $default -> (optional) Value of the button to turn on by default. Pass '-'
1546 # to turn _nothing_ on.
1547 # $linebreak -> (optional) Set to true to place linebreaks
1548 # between the buttons.
1549 # $labels -> (optional)
1550 # A pointer to an associative array of labels to print next to each checkbox
1551 # in the form $label{'value'}="Long explanatory label".
1552 # Otherwise the provided values are used as the labels.
1554 # An ARRAY containing a series of <INPUT TYPE="radio"> fields
1556 'radio_group' => <<'END_OF_FUNC',
1558 my($self,@p) = self_or_default(@_);
1560 my($name,$values,$default,$linebreak,$labels,
1561 $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
1562 $self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
1563 ROWS,[COLUMNS,COLS],
1564 ROWHEADERS,COLHEADERS,
1565 [OVERRIDE,FORCE],NOLABELS],@p);
1566 my($result,$checked);
1568 if (!$override && defined($self->param($name))) {
1569 $checked = $self->param($name);
1571 $checked = $default;
1573 # If no check array is specified, check the first by default
1574 $checked = $values->[0] unless $checked;
1575 $name=$self->escapeHTML($name);
1578 my(@values) = $values ? @$values : $self->param($name);
1579 my($other) = @other ? " @other" : '';
1581 my($checkit) = $checked eq $_ ? ' CHECKED' : '';
1582 my($break) = $linebreak ? '<BR>' : '';
1584 unless (defined($nolabels) && $nolabels) {
1586 $label = $labels->{$_} if defined($labels) && $labels->{$_};
1587 $label = $self->escapeHTML($label);
1589 $_=$self->escapeHTML($_);
1590 push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label} ${break}/);
1592 $self->register_parameter($name);
1593 return wantarray ? @elements : join('',@elements) unless $columns;
1594 return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
1599 #### Method: popup_menu
1600 # Create a popup menu.
1602 # $name -> Name for all the menu
1603 # $values -> A pointer to a regular array containing the
1604 # text of each menu item.
1605 # $default -> (optional) Default item to display
1606 # $labels -> (optional)
1607 # A pointer to an associative array of labels to print next to each checkbox
1608 # in the form $label{'value'}="Long explanatory label".
1609 # Otherwise the provided values are used as the labels.
1611 # A string containing the definition of a popup menu.
1613 'popup_menu' => <<'END_OF_FUNC',
1615 my($self,@p) = self_or_default(@_);
1617 my($name,$values,$default,$labels,$override,@other) =
1618 $self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
1619 my($result,$selected);
1621 if (!$override && defined($self->param($name))) {
1622 $selected = $self->param($name);
1624 $selected = $default;
1626 $name=$self->escapeHTML($name);
1627 my($other) = @other ? " @other" : '';
1629 my(@values) = $values ? @$values : $self->param($name);
1630 $result = qq/<SELECT NAME="$name"$other>\n/;
1632 my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
1634 $label = $labels->{$_} if defined($labels) && $labels->{$_};
1635 my($value) = $self->escapeHTML($_);
1636 $label=$self->escapeHTML($label);
1637 $result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
1640 $result .= "</SELECT>\n";
1646 #### Method: scrolling_list
1647 # Create a scrolling list.
1649 # $name -> name for the list
1650 # $values -> A pointer to a regular array containing the
1651 # values for each option line in the list.
1652 # $defaults -> (optional)
1653 # 1. If a pointer to a regular array of options,
1654 # then this will be used to decide which
1655 # lines to turn on by default.
1656 # 2. Otherwise holds the value of the single line to turn on.
1657 # $size -> (optional) Size of the list.
1658 # $multiple -> (optional) If set, allow multiple selections.
1659 # $labels -> (optional)
1660 # A pointer to an associative array of labels to print next to each checkbox
1661 # in the form $label{'value'}="Long explanatory label".
1662 # Otherwise the provided values are used as the labels.
1664 # A string containing the definition of a scrolling list.
1666 'scrolling_list' => <<'END_OF_FUNC',
1667 sub scrolling_list {
1668 my($self,@p) = self_or_default(@_);
1669 my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
1670 = $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
1671 SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
1674 my(@values) = $values ? @$values : $self->param($name);
1675 $size = $size || scalar(@values);
1677 my(%selected) = $self->previous_or_default($name,$defaults,$override);
1678 my($is_multiple) = $multiple ? ' MULTIPLE' : '';
1679 my($has_size) = $size ? " SIZE=$size" : '';
1680 my($other) = @other ? " @other" : '';
1682 $name=$self->escapeHTML($name);
1683 $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
1685 my($selectit) = $selected{$_} ? 'SELECTED' : '';
1687 $label = $labels->{$_} if defined($labels) && $labels->{$_};
1688 $label=$self->escapeHTML($label);
1689 my($value)=$self->escapeHTML($_);
1690 $result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
1692 $result .= "</SELECT>\n";
1693 $self->register_parameter($name);
1701 # $name -> Name of the hidden field
1702 # @default -> (optional) Initial values of field (may be an array)
1704 # $default->[initial values of field]
1706 # A string containing a <INPUT TYPE="hidden" NAME="name" VALUE="value">
1708 'hidden' => <<'END_OF_FUNC',
1710 my($self,@p) = self_or_default(@_);
1712 # this is the one place where we departed from our standard
1713 # calling scheme, so we have to special-case (darn)
1715 my($name,$default,$override,@other) =
1716 $self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
1718 my $do_override = 0;
1719 if ( substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
1720 @value = ref($default) ? @{$default} : $default;
1721 $do_override = $override;
1723 foreach ($default,$override,@other) {
1724 push(@value,$_) if defined($_);
1728 # use previous values if override is not set
1729 my @prev = $self->param($name);
1730 @value = @prev if !$do_override && @prev;
1732 $name=$self->escapeHTML($name);
1734 $_=$self->escapeHTML($_);
1735 push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
1737 return wantarray ? @result : join('',@result);
1742 #### Method: image_button
1744 # $name -> Name of the button
1745 # $src -> URL of the image source
1746 # $align -> Alignment style (TOP, BOTTOM or MIDDLE)
1748 # A string containing a <INPUT TYPE="image" NAME="name" SRC="url" ALIGN="alignment">
1750 'image_button' => <<'END_OF_FUNC',
1752 my($self,@p) = self_or_default(@_);
1754 my($name,$src,$alignment,@other) =
1755 $self->rearrange([NAME,SRC,ALIGN],@p);
1757 my($align) = $alignment ? " ALIGN=\U$alignment" : '';
1758 my($other) = @other ? " @other" : '';
1759 $name=$self->escapeHTML($name);
1760 return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
1765 #### Method: self_url
1766 # Returns a URL containing the current script and all its
1767 # param/value pairs arranged as a query. You can use this
1768 # to create a link that, when selected, will reinvoke the
1769 # script with all its state information preserved.
1771 'self_url' => <<'END_OF_FUNC',
1773 my($self) = self_or_default(@_);
1774 my($query_string) = $self->query_string;
1775 my $protocol = $self->protocol();
1776 my $name = "$protocol://" . $self->server_name;
1777 $name .= ":" . $self->server_port
1778 unless $self->server_port == 80;
1779 $name .= $self->script_name;
1780 $name .= $self->path_info if $self->path_info;
1781 return $name unless $query_string;
1782 return "$name?$query_string";
1787 # This is provided as a synonym to self_url() for people unfortunate
1788 # enough to have incorporated it into their programs already!
1789 'state' => <<'END_OF_FUNC',
1797 # Like self_url, but doesn't return the query string part of
1800 'url' => <<'END_OF_FUNC',
1802 my($self) = self_or_default(@_);
1803 my $protocol = $self->protocol();
1804 my $name = "$protocol://" . $self->server_name;
1805 $name .= ":" . $self->server_port
1806 unless $self->server_port == 80;
1807 $name .= $self->script_name;
1814 # Set or read a cookie from the specified name.
1815 # Cookie can then be passed to header().
1816 # Usual rules apply to the stickiness of -value.
1818 # -name -> name for this cookie (optional)
1819 # -value -> value of this cookie (scalar, array or hash)
1820 # -path -> paths for which this cookie is valid (optional)
1821 # -domain -> internet domain in which this cookie is valid (optional)
1822 # -secure -> if true, cookie only passed through secure channel (optional)
1823 # -expires -> expiry date in format Wdy, DD-Mon-YY HH:MM:SS GMT (optional)
1825 'cookie' => <<'END_OF_FUNC',
1826 # temporary, for debugging.
1828 my($self,@p) = self_or_default(@_);
1829 my($name,$value,$path,$domain,$secure,$expires) =
1830 $self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
1833 # if no value is supplied, then we retrieve the
1834 # value of the cookie, if any. For efficiency, we cache the parsed
1835 # cookie in our state variables.
1836 unless (defined($value)) {
1837 unless ($self->{'.cookies'}) {
1838 my(@pairs) = split("; ",$self->raw_cookie);
1840 my($key,$value) = split("=");
1841 my(@values) = map unescape($_),split('&',$value);
1842 $self->{'.cookies'}->{unescape($key)} = [@values];
1846 # If no name is supplied, then retrieve the names of all our cookies.
1847 return () unless $self->{'.cookies'};
1848 return wantarray ? @{$self->{'.cookies'}->{$name}} : $self->{'.cookies'}->{$name}->[0]
1849 if defined($name) && $name ne '';
1850 return keys %{$self->{'.cookies'}};
1854 # Pull out our parameters.
1856 if (ref($value) eq 'ARRAY') {
1858 } elsif (ref($value) eq 'HASH') {
1864 @values = map escape($_),@values;
1866 # I.E. requires the path to be present.
1867 ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
1869 my(@constant_values);
1870 push(@constant_values,"domain=$domain") if $domain;
1871 push(@constant_values,"path=$path") if $path;
1872 push(@constant_values,"expires=".&expires($expires)) if $expires;
1873 push(@constant_values,'secure') if $secure;
1875 my($key) = &escape($name);
1876 my($cookie) = join("=",$key,join("&",@values));
1877 return join("; ",$cookie,@constant_values);
1882 # This internal routine creates an expires string exactly some number of
1883 # hours from the current time in GMT. This is the format
1884 # required by Netscape cookies, and I think it works for the HTTP
1885 # Expires: header as well.
1886 'expires' => <<'END_OF_FUNC',
1889 my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
1890 my(@WDAY) = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
1891 my(%mult) = ('s'=>1,
1897 # format for time can be in any of the forms...
1898 # "now" -- expire immediately
1899 # "+180s" -- in 180 seconds
1900 # "+2m" -- in 2 minutes
1901 # "+12h" -- in 12 hours
1903 # "+3M" -- in 3 months
1904 # "+2y" -- in 2 years
1905 # "-3m" -- 3 minutes ago(!)
1906 # If you don't supply one of these forms, we assume you are
1907 # specifying the date yourself
1909 if (!$time || ($time eq 'now')) {
1911 } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) {
1912 $offset = ($mult{$2} || 1)*$1;
1916 my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+$offset);
1917 $year += 1900 unless $year < 100;
1918 return sprintf("%s, %02d-%s-%02d %02d:%02d:%02d GMT",
1919 $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
1924 ###############################################
1925 # OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
1926 ###############################################
1928 #### Method: path_info
1929 # Return the extra virtual path information provided
1930 # after the URL (if any)
1932 'path_info' => <<'END_OF_FUNC',
1934 return $ENV{'PATH_INFO'};
1939 #### Method: request_method
1940 # Returns 'POST', 'GET', 'PUT' or 'HEAD'
1942 'request_method' => <<'END_OF_FUNC',
1943 sub request_method {
1944 return $ENV{'REQUEST_METHOD'};
1948 #### Method: path_translated
1949 # Return the physical path information provided
1950 # by the URL (if any)
1952 'path_translated' => <<'END_OF_FUNC',
1953 sub path_translated {
1954 return $ENV{'PATH_TRANSLATED'};
1959 #### Method: query_string
1960 # Synthesize a query string from our current
1963 'query_string' => <<'END_OF_FUNC',
1965 my($self) = self_or_default(@_);
1966 my($param,$value,@pairs);
1967 foreach $param ($self->param) {
1968 my($eparam) = &escape($param);
1969 foreach $value ($self->param($param)) {
1970 $value = &escape($value);
1971 push(@pairs,"$eparam=$value");
1974 return join("&",@pairs);
1980 # Without parameters, returns an array of the
1981 # MIME types the browser accepts.
1982 # With a single parameter equal to a MIME
1983 # type, will return undef if the browser won't
1984 # accept it, 1 if the browser accepts it but
1985 # doesn't give a preference, or a floating point
1986 # value between 0.0 and 1.0 if the browser
1987 # declares a quantitative score for it.
1988 # This handles MIME type globs correctly.
1990 'accept' => <<'END_OF_FUNC',
1992 my($self,$search) = self_or_CGI(@_);
1993 my(%prefs,$type,$pref,$pat);
1995 my(@accept) = split(',',$self->http('accept'));
1998 ($pref) = /q=(\d\.\d+|\d+)/;
1999 ($type) = m#(\S+/[^;]+)#;
2001 $prefs{$type}=$pref || 1;
2004 return keys %prefs unless $search;
2006 # if a search type is provided, we may need to
2007 # perform a pattern matching operation.
2008 # The MIME types use a glob mechanism, which
2009 # is easily translated into a perl pattern match
2011 # First return the preference for directly supported
2013 return $prefs{$search} if $prefs{$search};
2015 # Didn't get it, so try pattern matching.
2016 foreach (keys %prefs) {
2017 next unless /\*/; # not a pattern match
2018 ($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
2019 $pat =~ s/\*/.*/g; # turn it into a pattern
2020 return $prefs{$_} if $search=~/$pat/;
2026 #### Method: user_agent
2027 # If called with no parameters, returns the user agent.
2028 # If called with one parameter, does a pattern match (case
2029 # insensitive) on the user agent.
2031 'user_agent' => <<'END_OF_FUNC',
2033 my($self,$match)=self_or_CGI(@_);
2034 return $self->http('user_agent') unless $match;
2035 return $self->http('user_agent') =~ /$match/i;
2041 # Returns the magic cookie for the session.
2042 # To set the magic cookie for new transations,
2043 # try print $q->header('-Set-cookie'=>'my cookie')
2045 'raw_cookie' => <<'END_OF_FUNC',
2047 my($self) = self_or_CGI(@_);
2048 return $self->http('cookie') || $ENV{'COOKIE'} || '';
2052 #### Method: virtual_host
2053 # Return the name of the virtual_host, which
2054 # is not always the same as the server
2056 'virtual_host' => <<'END_OF_FUNC',
2058 return http('host') || server_name();
2062 #### Method: remote_host
2063 # Return the name of the remote host, or its IP
2064 # address if unavailable. If this variable isn't
2065 # defined, it returns "localhost" for debugging
2068 'remote_host' => <<'END_OF_FUNC',
2070 return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}
2076 #### Method: remote_addr
2077 # Return the IP addr of the remote host.
2079 'remote_addr' => <<'END_OF_FUNC',
2081 return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
2086 #### Method: script_name
2087 # Return the partial URL to this script for
2088 # self-referencing scripts. Also see
2089 # self_url(), which returns a URL with all state information
2092 'script_name' => <<'END_OF_FUNC',
2094 return $ENV{'SCRIPT_NAME'} if $ENV{'SCRIPT_NAME'};
2095 # These are for debugging
2096 return "/$0" unless $0=~/^\//;
2102 #### Method: referer
2103 # Return the HTTP_REFERER: useful for generating
2106 'referer' => <<'END_OF_FUNC',
2108 my($self) = self_or_CGI(@_);
2109 return $self->http('referer');
2114 #### Method: server_name
2115 # Return the name of the server
2117 'server_name' => <<'END_OF_FUNC',
2119 return $ENV{'SERVER_NAME'} || 'localhost';
2123 #### Method: server_software
2124 # Return the name of the server software
2126 'server_software' => <<'END_OF_FUNC',
2127 sub server_software {
2128 return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
2132 #### Method: server_port
2133 # Return the tcp/ip port the server is running on
2135 'server_port' => <<'END_OF_FUNC',
2137 return $ENV{'SERVER_PORT'} || 80; # for debugging
2141 #### Method: server_protocol
2142 # Return the protocol (usually HTTP/1.0)
2144 'server_protocol' => <<'END_OF_FUNC',
2145 sub server_protocol {
2146 return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging
2151 # Return the value of an HTTP variable, or
2152 # the list of variables if none provided
2154 'http' => <<'END_OF_FUNC',
2156 my ($self,$parameter) = self_or_CGI(@_);
2157 return $ENV{$parameter} if $parameter=~/^HTTP/;
2158 return $ENV{"HTTP_\U$parameter\E"} if $parameter;
2160 foreach (keys %ENV) {
2161 push(@p,$_) if /^HTTP/;
2168 # Return the value of HTTPS
2170 'https' => <<'END_OF_FUNC',
2173 my ($self,$parameter) = self_or_CGI(@_);
2174 return $ENV{HTTPS} unless $parameter;
2175 return $ENV{$parameter} if $parameter=~/^HTTPS/;
2176 return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
2178 foreach (keys %ENV) {
2179 push(@p,$_) if /^HTTPS/;
2185 #### Method: protocol
2186 # Return the protocol (http or https currently)
2188 'protocol' => <<'END_OF_FUNC',
2192 return 'https' if $self->https() eq 'ON';
2193 return 'https' if $self->server_port == 443;
2194 my $prot = $self->server_protocol;
2195 my($protocol,$version) = split('/',$prot);
2196 return "\L$protocol\E";
2200 #### Method: remote_ident
2201 # Return the identity of the remote user
2202 # (but only if his host is running identd)
2204 'remote_ident' => <<'END_OF_FUNC',
2206 return $ENV{'REMOTE_IDENT'};
2211 #### Method: auth_type
2212 # Return the type of use verification/authorization in use, if any.
2214 'auth_type' => <<'END_OF_FUNC',
2216 return $ENV{'AUTH_TYPE'};
2221 #### Method: remote_user
2222 # Return the authorization name used for user
2225 'remote_user' => <<'END_OF_FUNC',
2227 return $ENV{'REMOTE_USER'};
2232 #### Method: user_name
2233 # Try to return the remote user's name by hook or by
2236 'user_name' => <<'END_OF_FUNC',
2238 my ($self) = self_or_CGI(@_);
2239 return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
2244 # Set or return the NPH global flag
2246 'nph' => <<'END_OF_FUNC',
2248 my ($self,$param) = self_or_CGI(@_);
2249 $CGI::nph = $param if defined($param);
2254 # -------------- really private subroutines -----------------
2255 'previous_or_default' => <<'END_OF_FUNC',
2256 sub previous_or_default {
2257 my($self,$name,$defaults,$override) = @_;
2260 if (!$override && ($self->{'.fieldnames'}->{$name} ||
2261 defined($self->param($name)) ) ) {
2262 grep($selected{$_}++,$self->param($name));
2263 } elsif (defined($defaults) && ref($defaults) &&
2264 (ref($defaults) eq 'ARRAY')) {
2265 grep($selected{$_}++,@{$defaults});
2267 $selected{$defaults}++ if defined($defaults);
2274 'register_parameter' => <<'END_OF_FUNC',
2275 sub register_parameter {
2276 my($self,$param) = @_;
2277 $self->{'.parametersToAdd'}->{$param}++;
2281 'get_fields' => <<'END_OF_FUNC',
2284 return $self->hidden('-name'=>'.cgifields',
2285 '-values'=>[keys %{$self->{'.parametersToAdd'}}],
2290 'read_from_cmdline' => <<'END_OF_FUNC',
2291 sub read_from_cmdline {
2292 require "shellwords.pl";
2296 $input = join(" ",@ARGV);
2298 print STDERR "(offline mode: enter name=value pairs on standard input)\n";
2299 chomp(@lines = <>); # remove newlines
2300 $input = join(" ",@lines);
2303 # minimal handling of escape characters
2304 $input=~s/\\=/%3D/g;
2305 $input=~s/\\&/%26/g;
2307 @words = &shellwords($input);
2308 if ("@words"=~/=/) {
2309 $query_string = join('&',@words);
2311 $query_string = join('+',@words);
2313 return $query_string;
2318 # subroutine: read_multipart
2320 # Read multipart data and store it into our parameters.
2321 # An interesting feature is that if any of the parts is a file, we
2322 # create a temporary file and open up a filehandle on it so that the
2323 # caller can read from it if necessary.
2325 'read_multipart' => <<'END_OF_FUNC',
2326 sub read_multipart {
2327 my($self,$boundary,$length) = @_;
2328 my($buffer) = $self->new_MultipartBuffer($boundary,$length);
2329 return unless $buffer;
2331 while (!$buffer->eof) {
2332 %header = $buffer->readHeader;
2334 # In beta1 it was "Content-disposition". In beta2 it's "Content-Disposition"
2336 my($key) = $header{'Content-disposition'} ? 'Content-disposition' : 'Content-Disposition';
2337 my($param)= $header{$key}=~/ name="([^\"]*)"/;
2339 # possible bug: our regular expression expects the filename= part to fall
2340 # at the end of the line. Netscape doesn't escape quotation marks in file names!!!
2341 my($filename) = $header{$key}=~/ filename="(.*)"$/;
2343 # add this parameter to our list
2344 $self->add_parameter($param);
2346 # If no filename specified, then just read the data and assign it
2347 # to our parameter list.
2348 unless ($filename) {
2349 my($value) = $buffer->readBody;
2350 push(@{$self->{$param}},$value);
2354 # If we get here, then we are dealing with a potentially large
2355 # uploaded form. Save the data to a temporary file, then open
2356 # the file for reading.
2357 my($tmpfile) = new TempFile;
2358 my $tmp = $tmpfile->as_string;
2360 open (OUT,">$tmp") || die "CGI open of $tmpfile: $!\n";
2361 $CGI::DefaultClass->binmode(OUT) if $CGI::needs_binmode;
2362 chmod 0666,$tmp; # make sure anyone can delete it.
2364 while ($data = $buffer->read) {
2369 # Now create a new filehandle in the caller's namespace.
2370 # The name of this filehandle just happens to be identical
2371 # to the original filename (NOT the name of the temporary
2372 # file, which is hidden!)
2374 if ($filename=~/^[a-zA-Z_]/) {
2376 do { $cp = caller($frame++); } until !eval("'$cp'->isaCGI()");
2377 $filehandle = "$cp\:\:$filename";
2379 $filehandle = "\:\:$filename";
2382 open($filehandle,$tmp) || die "CGI open of $tmp: $!\n";
2383 $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
2385 push(@{$self->{$param}},$filename);
2387 # Under Unix, it would be safe to let the temporary file
2388 # be deleted immediately. However, I fear that other operating
2389 # systems are not so forgiving. Therefore we save a reference
2390 # to the temporary file in the CGI object so that the file
2391 # isn't unlinked until the CGI object itself goes out of
2392 # scope. This is a bit hacky, but it has the interesting side
2393 # effect that one can access the name of the tmpfile by
2394 # asking for $query->{$query->param('foo')}, where 'foo'
2395 # is the name of the file upload field.
2396 $self->{'.tmpfiles'}->{$filename}= {
2404 'tmpFileName' => <<'END_OF_FUNC',
2406 my($self,$filename) = self_or_default(@_);
2407 return $self->{'.tmpfiles'}->{$filename}->{name}->as_string;
2411 'uploadInfo' => <<'END_OF_FUNC'
2413 my($self,$filename) = self_or_default(@_);
2414 return $self->{'.tmpfiles'}->{$filename}->{info};
2422 # Globals and stubs for other packages that we use
2423 package MultipartBuffer;
2425 # how many bytes to read at a time. We use
2426 # a 5K buffer by default.
2427 $FILLUNIT = 1024 * 5;
2428 $TIMEOUT = 10*60; # 10 minute timeout
2429 $SPIN_LOOP_MAX = 1000; # bug fix for some Netscape servers
2432 #reuse the autoload function
2433 *MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
2435 ###############################################################################
2436 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
2437 ###############################################################################
2438 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2439 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2442 'new' => <<'END_OF_FUNC',
2444 my($package,$interface,$boundary,$length,$filehandle) = @_;
2447 my($package) = caller;
2448 # force into caller's package if necessary
2449 $IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
2451 $IN = "main::STDIN" unless $IN;
2453 $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
2455 # If the user types garbage into the file upload field,
2456 # then Netscape passes NOTHING to the server (not good).
2457 # We may hang on this read in that case. So we implement
2458 # a read timeout. If nothing is ready to read
2459 # by then, we return.
2461 # Netscape seems to be a little bit unreliable
2462 # about providing boundary strings.
2465 # Under the MIME spec, the boundary consists of the
2466 # characters "--" PLUS the Boundary string
2467 $boundary = "--$boundary";
2468 # Read the topmost (boundary) line plus the CRLF
2470 $length -= $interface->read_from_client($IN,\$null,length($boundary)+2,0);
2472 } else { # otherwise we find it ourselves
2474 ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
2475 $boundary = <$IN>; # BUG: This won't work correctly under mod_perl
2476 $length -= length($boundary);
2477 chomp($boundary); # remove the CRLF
2478 $/ = $old; # restore old line separator
2481 my $self = {LENGTH=>$length,
2482 BOUNDARY=>$boundary,
2484 INTERFACE=>$interface,
2488 $FILLUNIT = length($boundary)
2489 if length($boundary) > $FILLUNIT;
2491 return bless $self,ref $package || $package;
2495 'readHeader' => <<'END_OF_FUNC',
2501 $self->fillBuffer($FILLUNIT);
2502 $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
2503 $ok++ if $self->{BUFFER} eq '';
2504 $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT;
2507 my($header) = substr($self->{BUFFER},0,$end+2);
2508 substr($self->{BUFFER},0,$end+4) = '';
2510 while ($header=~/^([\w-]+): (.*)$CRLF/mog) {
2517 # This reads and returns the body as a single scalar value.
2518 'readBody' => <<'END_OF_FUNC',
2523 while (defined($data = $self->read)) {
2524 $returnval .= $data;
2530 # This will read $bytes or until the boundary is hit, whichever happens
2531 # first. After the boundary is hit, we return undef. The next read will
2532 # skip over the boundary and begin reading again;
2533 'read' => <<'END_OF_FUNC',
2535 my($self,$bytes) = @_;
2537 # default number of bytes to read
2538 $bytes = $bytes || $FILLUNIT;
2540 # Fill up our internal buffer in such a way that the boundary
2541 # is never split between reads.
2542 $self->fillBuffer($bytes);
2544 # Find the boundary in the buffer (it may not be there).
2545 my $start = index($self->{BUFFER},$self->{BOUNDARY});
2547 # If the boundary begins the data, then skip past it
2548 # and return undef. The +2 here is a fiendish plot to
2549 # remove the CR/LF pair at the end of the boundary.
2552 # clear us out completely if we've hit the last boundary.
2553 if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
2559 # just remove the boundary.
2560 substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
2565 if ($start > 0) { # read up to the boundary
2566 $bytesToReturn = $start > $bytes ? $bytes : $start;
2567 } else { # read the requested number of bytes
2568 # leave enough bytes in the buffer to allow us to read
2569 # the boundary. Thanks to Kevin Hendrick for finding
2571 $bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
2574 my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
2575 substr($self->{BUFFER},0,$bytesToReturn)='';
2577 # If we hit the boundary, remove the CRLF from the end.
2578 return ($start > 0) ? substr($returnval,0,-2) : $returnval;
2583 # This fills up our internal buffer in such a way that the
2584 # boundary is never split between reads
2585 'fillBuffer' => <<'END_OF_FUNC',
2587 my($self,$bytes) = @_;
2588 return unless $self->{LENGTH};
2590 my($boundaryLength) = length($self->{BOUNDARY});
2591 my($bufferLength) = length($self->{BUFFER});
2592 my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
2593 $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
2595 # Try to read some data. We may hang here if the browser is screwed up.
2596 my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
2601 # An apparent bug in the Netscape Commerce server causes the read()
2602 # to return zero bytes repeatedly without blocking if the
2603 # remote user aborts during a file transfer. I don't know how
2604 # they manage this, but the workaround is to abort if we get
2605 # more than SPIN_LOOP_MAX consecutive zero reads.
2606 if ($bytesRead == 0) {
2607 die "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
2608 if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
2610 $self->{ZERO_LOOP_COUNTER}=0;
2613 $self->{LENGTH} -= $bytesRead;
2618 # Return true when we've finished reading
2619 'eof' => <<'END_OF_FUNC'
2622 return 1 if (length($self->{BUFFER}) == 0)
2623 && ($self->{LENGTH} <= 0);
2631 ####################################################################################
2632 ################################## TEMPORARY FILES #################################
2633 ####################################################################################
2637 unless ($TMPDIRECTORY) {
2638 @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp","${SL}tmp","${SL}temp","${SL}Temporary Items");
2640 do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
2644 $TMPDIRECTORY = "." unless $TMPDIRECTORY;
2645 $SEQUENCE="CGItemp${$}0000";
2647 # cute feature, but overload implementation broke it
2648 # %OVERLOAD = ('""'=>'as_string');
2649 *TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
2651 ###############################################################################
2652 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
2653 ###############################################################################
2654 $AUTOLOADED_ROUTINES = ''; # prevent -w error
2655 $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
2658 'new' => <<'END_OF_FUNC',
2662 my $directory = "${TMPDIRECTORY}${SL}${SEQUENCE}";
2663 return bless \$directory;
2667 'DESTROY' => <<'END_OF_FUNC',
2670 unlink $$self; # get rid of the file
2674 'as_string' => <<'END_OF_FUNC'
2686 # We get a whole bunch of warnings about "possibly uninitialized variables"
2687 # when running with the -w switch. Touch them all once to get rid of the
2688 # warnings. This is ugly and I hate it.
2693 $MultipartBuffer::SPIN_LOOP_MAX;
2694 $MultipartBuffer::CRLF;
2695 $MultipartBuffer::TIMEOUT;
2696 $MultipartBuffer::FILLUNIT;
2697 $TempFile::SEQUENCE;
2708 CGI - Simple Common Gateway Interface Class
2713 # the rest is too complicated for a synopsis; keep reading
2717 This perl library uses perl5 objects to make it easy to create
2718 Web fill-out forms and parse their contents. This package
2719 defines CGI objects, entities that contain the values of the
2720 current query string and other state variables.
2721 Using a CGI object's methods, you can examine keywords and parameters
2722 passed to your script, and create forms whose initial values
2723 are taken from the current query (thereby preserving state
2726 The current version of CGI.pm is available at
2728 http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
2729 ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
2731 =head1 INSTALLATION:
2733 To install this package, just change to the directory in which this
2734 file is found and type the following:
2740 This will copy CGI.pm to your perl library directory for use by all
2741 perl scripts. You probably must be root to do this. Now you can
2742 load the CGI routines in your Perl scripts with the line:
2746 If you don't have sufficient privileges to install CGI.pm in the Perl
2747 library directory, you can put CGI.pm into some convenient spot, such
2748 as your home directory, or in cgi-bin itself and prefix all Perl
2749 scripts that call it with something along the lines of the following
2752 use lib '/home/davis/lib';
2755 If you are using a version of perl earlier than 5.002 (such as NT perl), use
2759 unshift(@INC,'/home/davis/lib');
2763 The CGI distribution also comes with a cute module called L<CGI::Carp>.
2764 It redefines the die(), warn(), confess() and croak() error routines
2765 so that they write nicely formatted error messages into the server's
2766 error log (or to the output stream of your choice). This avoids long
2767 hours of groping through the error and access logs, trying to figure
2768 out which CGI script is generating error messages. If you choose,
2769 you can even have fatal error messages echoed to the browser to avoid
2770 the annoying and uninformative "Server Error" message.
2774 =head2 CREATING A NEW QUERY OBJECT:
2778 This will parse the input (from both POST and GET methods) and store
2779 it into a perl5 object called $query.
2781 =head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
2783 $query = new CGI(INPUTFILE);
2785 If you provide a file handle to the new() method, it
2786 will read parameters from the file (or STDIN, or whatever). The
2787 file can be in any of the forms describing below under debugging
2788 (i.e. a series of newline delimited TAG=VALUE pairs will work).
2789 Conveniently, this type of file is created by the save() method
2790 (see below). Multiple records can be saved and restored.
2792 Perl purists will be pleased to know that this syntax accepts
2793 references to file handles, or even references to filehandle globs,
2794 which is the "official" way to pass a filehandle:
2796 $query = new CGI(\*STDIN);
2798 You can also initialize the query object from an associative array
2801 $query = new CGI( {'dinosaur'=>'barney',
2802 'song'=>'I love you',
2803 'friends'=>[qw/Jessica George Nancy/]}
2806 or from a properly formatted, URL-escaped query string:
2808 $query = new CGI('dinosaur=barney&color=purple');
2810 To create an empty query, initialize it from an empty string or hash:
2812 $empty_query = new CGI("");
2814 $empty_query = new CGI({});
2816 =head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
2818 @keywords = $query->keywords
2820 If the script was invoked as the result of an <ISINDEX> search, the
2821 parsed keywords can be obtained as an array using the keywords() method.
2823 =head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT:
2825 @names = $query->param
2827 If the script was invoked with a parameter list
2828 (e.g. "name1=value1&name2=value2&name3=value3"), the param()
2829 method will return the parameter names as a list. If the
2830 script was invoked as an <ISINDEX> script, there will be a
2831 single parameter named 'keywords'.
2833 NOTE: As of version 1.5, the array of parameter names returned will
2834 be in the same order as they were submitted by the browser.
2835 Usually this order is the same as the order in which the
2836 parameters are defined in the form (however, this isn't part
2837 of the spec, and so isn't guaranteed).
2839 =head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER:
2841 @values = $query->param('foo');
2845 $value = $query->param('foo');
2847 Pass the param() method a single argument to fetch the value of the
2848 named parameter. If the parameter is multivalued (e.g. from multiple
2849 selections in a scrolling list), you can ask to receive an array. Otherwise
2850 the method will return a single value.
2852 =head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
2854 $query->param('foo','an','array','of','values');
2856 This sets the value for the named parameter 'foo' to an array of
2857 values. This is one way to change the value of a field AFTER
2858 the script has been invoked once before. (Another way is with
2859 the -override parameter accepted by all methods that generate
2862 param() also recognizes a named parameter style of calling described
2863 in more detail later:
2865 $query->param(-name=>'foo',-values=>['an','array','of','values']);
2869 $query->param(-name=>'foo',-value=>'the value');
2871 =head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
2873 $query->append(-name=>;'foo',-values=>['yet','more','values']);
2875 This adds a value or list of values to the named parameter. The
2876 values are appended to the end of the parameter if it already exists.
2877 Otherwise the parameter is created. Note that this method only
2878 recognizes the named argument calling syntax.
2880 =head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE:
2882 $query->import_names('R');
2884 This creates a series of variables in the 'R' namespace. For example,
2885 $R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear.
2886 If no namespace is given, this method will assume 'Q'.
2887 WARNING: don't import anything into 'main'; this is a major security
2890 In older versions, this method was called B<import()>. As of version 2.20,
2891 this name has been removed completely to avoid conflict with the built-in
2892 Perl module B<import> operator.
2894 =head2 DELETING A PARAMETER COMPLETELY:
2896 $query->delete('foo');
2898 This completely clears a parameter. It sometimes useful for
2899 resetting parameters that you don't want passed down between
2902 =head2 DELETING ALL PARAMETERS:
2904 $query->delete_all();
2906 This clears the CGI object completely. It might be useful to ensure
2907 that all the defaults are taken when you create a fill-out form.
2909 =head2 SAVING THE STATE OF THE FORM TO A FILE:
2911 $query->save(FILEHANDLE)
2913 This will write the current state of the form to the provided
2914 filehandle. You can read it back in by providing a filehandle
2915 to the new() method. Note that the filehandle can be a file, a pipe,
2918 The format of the saved file is:
2926 Both name and value are URL escaped. Multi-valued CGI parameters are
2927 represented as repeated names. A session record is delimited by a
2928 single = symbol. You can write out multiple records and read them
2929 back in with several calls to B<new>. You can do this across several
2930 sessions by opening the file in append mode, allowing you to create
2931 primitive guest books, or to keep a history of users' queries. Here's
2932 a short example of creating multiple session records:
2936 open (OUT,">>test.out") || die;
2938 foreach (0..$records) {
2940 $q->param(-name=>'counter',-value=>$_);
2945 # reopen for reading
2946 open (IN,"test.out") || die;
2948 my $q = new CGI(IN);
2949 print $q->param('counter'),"\n";
2952 The file format used for save/restore is identical to that used by the
2953 Whitehead Genome Center's data exchange format "Boulderio", and can be
2954 manipulated and even databased using Boulderio utilities. See
2956 http://www.genome.wi.mit.edu/genome_software/other/boulder.html
2958 for further details.
2960 =head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
2962 $myself = $query->self_url;
2963 print "<A HREF=$myself>I'm talking to myself.</A>";
2965 self_url() will return a URL, that, when selected, will reinvoke
2966 this script with all its state information intact. This is most
2967 useful when you want to jump around within the document using
2968 internal anchors but you don't want to disrupt the current contents
2969 of the form(s). Something like this will do the trick.
2971 $myself = $query->self_url;
2972 print "<A HREF=$myself#table1>See table 1</A>";
2973 print "<A HREF=$myself#table2>See table 2</A>";
2974 print "<A HREF=$myself#yourself>See for yourself</A>";
2976 If you don't want to get the whole query string, call
2977 the method url() to return just the URL for the script:
2979 $myself = $query->url;
2980 print "<A HREF=$myself>No query string in this baby!</A>\n";
2982 You can also retrieve the unprocessed query string with query_string():
2984 $the_string = $query->query_string;
2986 =head2 COMPATIBILITY WITH CGI-LIB.PL
2988 To make it easier to port existing programs that use cgi-lib.pl
2989 the compatibility routine "ReadParse" is provided. Porting is
2993 require "cgi-lib.pl";
2995 print "The value of the antique is $in{antique}.\n";
3000 print "The value of the antique is $in{antique}.\n";
3002 CGI.pm's ReadParse() routine creates a tied variable named %in,
3003 which can be accessed to obtain the query variables. Like
3004 ReadParse, you can also provide your own variable. Infrequently
3005 used features of ReadParse, such as the creation of @in and $in
3006 variables, are not supported.
3008 Once you use ReadParse, you can retrieve the query object itself
3012 print $q->textfield(-name=>'wow',
3013 -value=>'does this really work?');
3015 This allows you to start using the more interesting features
3016 of CGI.pm without rewriting your old scripts from scratch.
3018 =head2 CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS
3020 In versions of CGI.pm prior to 2.0, it could get difficult to remember
3021 the proper order of arguments in CGI function calls that accepted five
3022 or six different arguments. As of 2.0, there's a better way to pass
3023 arguments to the various CGI functions. In this style, you pass a
3024 series of name=>argument pairs, like this:
3026 $field = $query->radio_group(-name=>'OS',
3027 -values=>[Unix,Windows,Macintosh],
3030 The advantages of this style are that you don't have to remember the
3031 exact order of the arguments, and if you leave out a parameter, in
3032 most cases it will default to some reasonable value. If you provide
3033 a parameter that the method doesn't recognize, it will usually do
3034 something useful with it, such as incorporating it into the HTML form
3035 tag. For example if Netscape decides next week to add a new
3036 JUSTIFICATION parameter to the text field tags, you can start using
3037 the feature without waiting for a new version of CGI.pm:
3039 $field = $query->textfield(-name=>'State',
3040 -default=>'gaseous',
3041 -justification=>'RIGHT');
3043 This will result in an HTML tag that looks like this:
3045 <INPUT TYPE="textfield" NAME="State" VALUE="gaseous"
3046 JUSTIFICATION="RIGHT">
3048 Parameter names are case insensitive: you can use -name, or -Name or
3049 -NAME. You don't have to use the hyphen if you don't want to. After
3050 creating a CGI object, call the B<use_named_parameters()> method with
3051 a nonzero value. This will tell CGI.pm that you intend to use named
3052 parameters exclusively:
3055 $query->use_named_parameters(1);
3056 $field = $query->radio_group('name'=>'OS',
3057 'values'=>['Unix','Windows','Macintosh'],
3060 Actually, CGI.pm only looks for a hyphen in the first parameter. So
3061 you can leave it off subsequent parameters if you like. Something to
3062 be wary of is the potential that a string constant like "values" will
3063 collide with a keyword (and in fact it does!) While Perl usually
3064 figures out when you're referring to a function and when you're
3065 referring to a string, you probably should put quotation marks around
3066 all string constants just to play it safe.
3068 =head2 CREATING THE HTTP HEADER:
3070 print $query->header;
3074 print $query->header('image/gif');
3078 print $query->header('text/html','204 No response');
3082 print $query->header(-type=>'image/gif',
3084 -status=>'402 Payment required',
3089 header() returns the Content-type: header. You can provide your own
3090 MIME type if you choose, otherwise it defaults to text/html. An
3091 optional second parameter specifies the status code and a human-readable
3092 message. For example, you can specify 204, "No response" to create a
3093 script that tells the browser to do nothing at all. If you want to
3094 add additional fields to the header, just tack them on to the end:
3096 print $query->header('text/html','200 OK','Content-Length: 3002');
3098 The last example shows the named argument style for passing arguments
3099 to the CGI methods using named parameters. Recognized parameters are
3100 B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other
3101 parameters will be stripped of their initial hyphens and turned into
3102 header fields, allowing you to specify any HTTP header you desire.
3104 Most browsers will not cache the output from CGI scripts. Every time
3105 the browser reloads the page, the script is invoked anew. You can
3106 change this behavior with the B<-expires> parameter. When you specify
3107 an absolute or relative expiration interval with this parameter, some
3108 browsers and proxy servers will cache the script's output until the
3109 indicated expiration date. The following forms are all valid for the
3112 +30s 30 seconds from now
3113 +10m ten minutes from now
3114 +1h one hour from now
3115 -1d yesterday (i.e. "ASAP!")
3118 +10y in ten years time
3119 Thursday, 25-Apr-96 00:40:33 GMT at the indicated time & date
3121 (CGI::expires() is the static function call used internally that turns
3122 relative time intervals into HTTP dates. You can call it directly if
3125 The B<-cookie> parameter generates a header that tells the browser to provide
3126 a "magic cookie" during all subsequent transactions with your script.
3127 Netscape cookies have a special format that includes interesting attributes
3128 such as expiration time. Use the cookie() method to create and retrieve
3131 The B<-nph> parameter, if set to a true value, will issue the correct
3132 headers to work with a NPH (no-parse-header) script. This is important
3133 to use with certain servers, such as Microsoft Internet Explorer, which
3134 expect all their scripts to be NPH.
3136 =head2 GENERATING A REDIRECTION INSTRUCTION
3138 print $query->redirect('http://somewhere.else/in/movie/land');
3140 redirects the browser elsewhere. If you use redirection like this,
3141 you should B<not> print out a header as well. As of version 2.0, we
3142 produce both the unofficial Location: header and the official URI:
3143 header. This should satisfy most servers and browsers.
3145 One hint I can offer is that relative links may not work correctly
3146 when you generate a redirection to another document on your site.
3147 This is due to a well-intentioned optimization that some servers use.
3148 The solution to this is to use the full URL (including the http: part)
3149 of the document you are redirecting to.
3151 You can use named parameters:
3153 print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
3156 The B<-nph> parameter, if set to a true value, will issue the correct
3157 headers to work with a NPH (no-parse-header) script. This is important
3158 to use with certain servers, such as Microsoft Internet Explorer, which
3159 expect all their scripts to be NPH.
3162 =head2 CREATING THE HTML HEADER:
3164 print $query->start_html(-title=>'Secrets of the Pyramids',
3165 -author=>'fred@capricorn.org',
3168 -meta=>{'keywords'=>'pharaoh secret mummy',
3169 'copyright'=>'copyright 1996 King Tut'},
3174 print $query->start_html('Secrets of the Pyramids',
3175 'fred@capricorn.org','true',
3178 This will return a canned HTML header and the opening <BODY> tag.
3179 All parameters are optional. In the named parameter form, recognized
3180 parameters are -title, -author, -base, -xbase and -target (see below for the
3181 explanation). Any additional parameters you provide, such as the
3182 Netscape unofficial BGCOLOR attribute, are added to the <BODY> tag.
3184 The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
3185 different from the current location, as in
3187 -xbase=>"http://home.mcom.com/"
3189 All relative links will be interpreted relative to this tag.
3191 The argument B<-target> allows you to provide a default target frame
3192 for all the links and fill-out forms on the page. See the Netscape
3193 documentation on frames for details of how to manipulate this.
3195 -target=>"answer_window"
3197 All relative links will be interpreted relative to this tag.
3198 You add arbitrary meta information to the header with the B<-meta>
3199 argument. This argument expects a reference to an associative array
3200 containing name/value pairs of meta information. These will be turned
3201 into a series of header <META> tags that look something like this:
3203 <META NAME="keywords" CONTENT="pharaoh secret mummy">
3204 <META NAME="description" CONTENT="copyright 1996 King Tut">
3206 There is no support for the HTTP-EQUIV type of <META> tag. This is
3207 because you can modify the HTTP header directly with the B<header()>
3210 JAVASCRIPTING: The B<-script>, B<-onLoad> and B<-onUnload> parameters
3211 are used to add Netscape JavaScript calls to your pages. B<-script>
3212 should point to a block of text containing JavaScript function
3213 definitions. This block will be placed within a <SCRIPT> block inside
3214 the HTML (not HTTP) header. The block is placed in the header in
3215 order to give your page a fighting chance of having all its JavaScript
3216 functions in place even if the user presses the stop button before the
3217 page has loaded completely. CGI.pm attempts to format the script in
3218 such a way that JavaScript-naive browsers will not choke on the code:
3219 unfortunately there are some browsers, such as Chimera for Unix, that
3220 get confused by it nevertheless.
3222 The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
3223 code to execute when the page is respectively opened and closed by the
3224 browser. Usually these parameters are calls to functions defined in the
3228 print $query->header;
3230 // Ask a silly question
3231 function riddle_me_this() {
3232 var r = prompt("What walks on four legs in the morning, " +
3233 "two legs in the afternoon, " +
3234 "and three legs in the evening?");
3237 // Get a silly answer
3238 function response(answer) {
3239 if (answer == "man")
3240 alert("Right you are!");
3242 alert("Wrong! Guess again.");
3245 print $query->start_html(-title=>'The Riddle of the Sphinx',
3250 http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
3252 for more information about JavaScript.
3254 The old-style positional parameters are as follows:
3258 =item B<Parameters:>
3266 The author's e-mail address (will create a <LINK REV="MADE"> tag if present
3270 A 'true' flag if you want to include a <BASE> tag in the header. This
3271 helps resolve relative addresses to absolute ones when the document is moved,
3272 but makes the document hierarchy non-portable. Use with care!
3276 Any other parameters you want to include in the <BODY> tag. This is a good
3277 place to put Netscape extensions, such as colors and wallpaper patterns.
3281 =head2 ENDING THE HTML DOCUMENT:
3283 print $query->end_html
3285 This ends an HTML document by printing the </BODY></HTML> tags.
3287 =head1 CREATING FORMS:
3289 I<General note> The various form-creating methods all return strings
3290 to the caller, containing the tag or tags that will create the requested
3291 form element. You are responsible for actually printing out these strings.
3292 It's set up this way so that you can place formatting tags
3293 around the form elements.
3295 I<Another note> The default values that you specify for the forms are only
3296 used the B<first> time the script is invoked (when there is no query
3297 string). On subsequent invocations of the script (when there is a query
3298 string), the former values are used even if they are blank.
3300 If you want to change the value of a field from its previous value, you have two
3303 (1) call the param() method to set it.
3305 (2) use the -override (alias -force) parameter (a new feature in version 2.15).
3306 This forces the default value to be used, regardless of the previous value:
3308 print $query->textfield(-name=>'field_name',
3309 -default=>'starting value',
3314 I<Yet another note> By default, the text and labels of form elements are
3315 escaped according to HTML rules. This means that you can safely use
3316 "<CLICK ME>" as the label for a button. However, it also interferes with
3317 your ability to incorporate special HTML character sequences, such as Á,
3318 into your fields. If you wish to turn off automatic escaping, call the
3319 autoEscape() method with a false value immediately after creating the CGI object:
3322 $query->autoEscape(undef);
3325 =head2 CREATING AN ISINDEX TAG
3327 print $query->isindex(-action=>$action);
3331 print $query->isindex($action);
3333 Prints out an <ISINDEX> tag. Not very exciting. The parameter
3334 -action specifies the URL of the script to process the query. The
3335 default is to process the query with the current script.
3337 =head2 STARTING AND ENDING A FORM
3339 print $query->startform(-method=>$method,
3341 -encoding=>$encoding);
3342 <... various form stuff ...>
3343 print $query->endform;
3347 print $query->startform($method,$action,$encoding);
3348 <... various form stuff ...>
3349 print $query->endform;
3351 startform() will return a <FORM> tag with the optional method,
3352 action and form encoding that you specify. The defaults are:
3356 encoding: application/x-www-form-urlencoded
3358 endform() returns the closing </FORM> tag.
3360 Startform()'s encoding method tells the browser how to package the various
3361 fields of the form before sending the form to the server. Two
3362 values are possible:
3366 =item B<application/x-www-form-urlencoded>
3368 This is the older type of encoding used by all browsers prior to
3369 Netscape 2.0. It is compatible with many CGI scripts and is
3370 suitable for short fields containing text data. For your
3371 convenience, CGI.pm stores the name of this encoding
3372 type in B<$CGI::URL_ENCODED>.
3374 =item B<multipart/form-data>
3376 This is the newer type of encoding introduced by Netscape 2.0.
3377 It is suitable for forms that contain very large fields or that
3378 are intended for transferring binary data. Most importantly,
3379 it enables the "file upload" feature of Netscape 2.0 forms. For
3380 your convenience, CGI.pm stores the name of this encoding type
3381 in B<$CGI::MULTIPART>
3383 Forms that use this type of encoding are not easily interpreted
3384 by CGI scripts unless they use CGI.pm or another library designed
3389 For compatibility, the startform() method uses the older form of
3390 encoding by default. If you want to use the newer form of encoding
3391 by default, you can call B<start_multipart_form()> instead of
3394 JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
3395 for use with JavaScript. The -name parameter gives the
3396 form a name so that it can be identified and manipulated by
3397 JavaScript functions. -onSubmit should point to a JavaScript
3398 function that will be executed just before the form is submitted to your
3399 server. You can use this opportunity to check the contents of the form
3400 for consistency and completeness. If you find something wrong, you
3401 can put up an alert box or maybe fix things up yourself. You can
3402 abort the submission by returning false from this function.
3404 Usually the bulk of JavaScript functions are defined in a <SCRIPT>
3405 block in the HTML header and -onSubmit points to one of these function
3406 call. See start_html() for details.
3408 =head2 CREATING A TEXT FIELD
3410 print $query->textfield(-name=>'field_name',
3411 -default=>'starting value',
3416 print $query->textfield('field_name','starting value',50,80);
3418 textfield() will return a text input field.
3426 The first parameter is the required name for the field (-name).
3430 The optional second parameter is the default starting value for the field
3431 contents (-default).
3435 The optional third parameter is the size of the field in
3440 The optional fourth parameter is the maximum number of characters the
3441 field will accept (-maxlength).
3445 As with all these methods, the field will be initialized with its
3446 previous contents from earlier invocations of the script.
3447 When the form is processed, the value of the text field can be
3450 $value = $query->param('foo');
3452 If you want to reset it from its initial value after the script has been
3453 called once, you can do so like this:
3455 $query->param('foo',"I'm taking over this value!");
3457 NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
3458 value, you can force its current value by using the -override (alias -force)
3461 print $query->textfield(-name=>'field_name',
3462 -default=>'starting value',
3467 JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>, B<-onBlur>
3468 and B<-onSelect> parameters to register JavaScript event handlers.
3469 The onChange handler will be called whenever the user changes the
3470 contents of the text field. You can do text validation if you like.
3471 onFocus and onBlur are called respectively when the insertion point
3472 moves into and out of the text field. onSelect is called when the
3473 user changes the portion of the text that is selected.
3475 =head2 CREATING A BIG TEXT FIELD
3477 print $query->textarea(-name=>'foo',
3478 -default=>'starting value',
3484 print $query->textarea('foo','starting value',10,50);
3486 textarea() is just like textfield, but it allows you to specify
3487 rows and columns for a multiline text entry box. You can provide
3488 a starting value for the field, which can be long and contain
3491 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
3492 and B<-onSelect> parameters are recognized. See textfield().
3494 =head2 CREATING A PASSWORD FIELD
3496 print $query->password_field(-name=>'secret',
3497 -value=>'starting value',
3502 print $query->password_field('secret','starting value',50,80);
3504 password_field() is identical to textfield(), except that its contents
3505 will be starred out on the web page.
3507 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
3508 and B<-onSelect> parameters are recognized. See textfield().
3510 =head2 CREATING A FILE UPLOAD FIELD
3512 print $query->filefield(-name=>'uploaded_file',
3513 -default=>'starting value',
3518 print $query->filefield('uploaded_file','starting value',50,80);
3520 filefield() will return a file upload field for Netscape 2.0 browsers.
3521 In order to take full advantage of this I<you must use the new
3522 multipart encoding scheme> for the form. You can do this either
3523 by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>,
3524 or by calling the new method B<start_multipart_form()> instead of
3525 vanilla B<startform()>.
3533 The first parameter is the required name for the field (-name).
3537 The optional second parameter is the starting value for the field contents
3538 to be used as the default file name (-default).
3540 The beta2 version of Netscape 2.0 currently doesn't pay any attention
3541 to this field, and so the starting value will always be blank. Worse,
3542 the field loses its "sticky" behavior and forgets its previous
3543 contents. The starting value field is called for in the HTML
3544 specification, however, and possibly later versions of Netscape will
3549 The optional third parameter is the size of the field in
3554 The optional fourth parameter is the maximum number of characters the
3555 field will accept (-maxlength).
3559 When the form is processed, you can retrieve the entered filename
3562 $filename = $query->param('uploaded_file');
3564 In Netscape Gold, the filename that gets returned is the full local filename
3565 on the B<remote user's> machine. If the remote user is on a Unix
3566 machine, the filename will follow Unix conventions:
3570 On an MS-DOS/Windows and OS/2 machines, the filename will follow DOS conventions:
3572 C:\PATH\TO\THE\FILE.MSW
3574 On a Macintosh machine, the filename will follow Mac conventions:
3576 HD 40:Desktop Folder:Sort Through:Reminders
3578 The filename returned is also a file handle. You can read the contents
3579 of the file using standard Perl file reading calls:
3581 # Read a text file and print it out
3582 while (<$filename>) {
3586 # Copy a binary file to somewhere safe
3587 open (OUTFILE,">>/usr/local/web/users/feedback");
3588 while ($bytesread=read($filename,$buffer,1024)) {
3589 print OUTFILE $buffer;
3592 When a file is uploaded the browser usually sends along some
3593 information along with it in the format of headers. The information
3594 usually includes the MIME content type. Future browsers may send
3595 other information as well (such as modification date and size). To
3596 retrieve this information, call uploadInfo(). It returns a reference to
3597 an associative array containing all the document headers.
3599 $filename = $query->param('uploaded_file');
3600 $type = $query->uploadInfo($filename)->{'Content-Type'};
3601 unless ($type eq 'text/html') {
3602 die "HTML FILES ONLY!";
3605 If you are using a machine that recognizes "text" and "binary" data
3606 modes, be sure to understand when and how to use them (see the Camel book).
3607 Otherwise you may find that binary files are corrupted during file uploads.
3609 JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
3610 and B<-onSelect> parameters are recognized. See textfield()
3613 =head2 CREATING A POPUP MENU
3615 print $query->popup_menu('menu_name',
3616 ['eenie','meenie','minie'],
3621 %labels = ('eenie'=>'your first choice',
3622 'meenie'=>'your second choice',
3623 'minie'=>'your third choice');
3624 print $query->popup_menu('menu_name',
3625 ['eenie','meenie','minie'],
3628 -or (named parameter style)-
3630 print $query->popup_menu(-name=>'menu_name',
3631 -values=>['eenie','meenie','minie'],
3635 popup_menu() creates a menu.
3641 The required first argument is the menu's name (-name).
3645 The required second argument (-values) is an array B<reference>
3646 containing the list of menu items in the menu. You can pass the
3647 method an anonymous array, as shown in the example, or a reference to
3648 a named array, such as "\@foo".
3652 The optional third parameter (-default) is the name of the default
3653 menu choice. If not specified, the first item will be the default.
3654 The values of the previous choice will be maintained across queries.
3658 The optional fourth parameter (-labels) is provided for people who
3659 want to use different values for the user-visible label inside the
3660 popup menu nd the value returned to your script. It's a pointer to an
3661 associative array relating menu values to user-visible labels. If you
3662 leave this parameter blank, the menu values will be displayed by
3663 default. (You can also leave a label undefined if you want to).
3667 When the form is processed, the selected value of the popup menu can
3670 $popup_menu_value = $query->param('menu_name');
3672 JAVASCRIPTING: popup_menu() recognizes the following event handlers:
3673 B<-onChange>, B<-onFocus>, and B<-onBlur>. See the textfield()
3674 section for details on when these handlers are called.
3676 =head2 CREATING A SCROLLING LIST
3678 print $query->scrolling_list('list_name',
3679 ['eenie','meenie','minie','moe'],
3680 ['eenie','moe'],5,'true');
3683 print $query->scrolling_list('list_name',
3684 ['eenie','meenie','minie','moe'],
3685 ['eenie','moe'],5,'true',
3690 print $query->scrolling_list(-name=>'list_name',
3691 -values=>['eenie','meenie','minie','moe'],
3692 -default=>['eenie','moe'],
3697 scrolling_list() creates a scrolling list.
3701 =item B<Parameters:>
3705 The first and second arguments are the list name (-name) and values
3706 (-values). As in the popup menu, the second argument should be an
3711 The optional third argument (-default) can be either a reference to a
3712 list containing the values to be selected by default, or can be a
3713 single value to select. If this argument is missing or undefined,
3714 then nothing is selected when the list first appears. In the named
3715 parameter version, you can use the synonym "-defaults" for this
3720 The optional fourth argument is the size of the list (-size).
3724 The optional fifth argument can be set to true to allow multiple
3725 simultaneous selections (-multiple). Otherwise only one selection
3726 will be allowed at a time.
3730 The optional sixth argument is a pointer to an associative array
3731 containing long user-visible labels for the list items (-labels).
3732 If not provided, the values will be displayed.
3734 When this form is processed, all selected list items will be returned as
3735 a list under the parameter name 'list_name'. The values of the
3736 selected items can be retrieved with:
3738 @selected = $query->param('list_name');
3742 JAVASCRIPTING: scrolling_list() recognizes the following event handlers:
3743 B<-onChange>, B<-onFocus>, and B<-onBlur>. See textfield() for
3744 the description of when these handlers are called.
3746 =head2 CREATING A GROUP OF RELATED CHECKBOXES
3748 print $query->checkbox_group(-name=>'group_name',
3749 -values=>['eenie','meenie','minie','moe'],
3750 -default=>['eenie','moe'],
3754 print $query->checkbox_group('group_name',
3755 ['eenie','meenie','minie','moe'],
3756 ['eenie','moe'],'true',\%labels);
3758 HTML3-COMPATIBLE BROWSERS ONLY:
3760 print $query->checkbox_group(-name=>'group_name',
3761 -values=>['eenie','meenie','minie','moe'],
3762 -rows=2,-columns=>2);
3765 checkbox_group() creates a list of checkboxes that are related
3770 =item B<Parameters:>
3774 The first and second arguments are the checkbox name and values,
3775 respectively (-name and -values). As in the popup menu, the second
3776 argument should be an array reference. These values are used for the
3777 user-readable labels printed next to the checkboxes as well as for the
3778 values passed to your script in the query string.
3782 The optional third argument (-default) can be either a reference to a
3783 list containing the values to be checked by default, or can be a
3784 single value to checked. If this argument is missing or undefined,
3785 then nothing is selected when the list first appears.
3789 The optional fourth argument (-linebreak) can be set to true to place
3790 line breaks between the checkboxes so that they appear as a vertical
3791 list. Otherwise, they will be strung together on a horizontal line.
3795 The optional fifth argument is a pointer to an associative array
3796 relating the checkbox values to the user-visible labels that will
3797 be printed next to them (-labels). If not provided, the values will
3798 be used as the default.
3802 B<HTML3-compatible browsers> (such as Netscape) can take advantage
3804 parameters B<-rows>, and B<-columns>. These parameters cause
3805 checkbox_group() to return an HTML3 compatible table containing
3806 the checkbox group formatted with the specified number of rows
3807 and columns. You can provide just the -columns parameter if you
3808 wish; checkbox_group will calculate the correct number of rows
3811 To include row and column headings in the returned table, you
3812 can use the B<-rowheader> and B<-colheader> parameters. Both
3813 of these accept a pointer to an array of headings to use.
3814 The headings are just decorative. They don't reorganize the
3815 interpretation of the checkboxes -- they're still a single named
3820 When the form is processed, all checked boxes will be returned as
3821 a list under the parameter name 'group_name'. The values of the
3822 "on" checkboxes can be retrieved with:
3824 @turned_on = $query->param('group_name');
3826 The value returned by checkbox_group() is actually an array of button
3827 elements. You can capture them and use them within tables, lists,
3828 or in other creative ways:
3830 @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
3831 &use_in_creative_way(@h);
3833 JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
3834 parameter. This specifies a JavaScript code fragment or
3835 function call to be executed every time the user clicks on
3836 any of the buttons in the group. You can retrieve the identity
3837 of the particular button clicked on using the "this" variable.
3839 =head2 CREATING A STANDALONE CHECKBOX
3841 print $query->checkbox(-name=>'checkbox_name',
3842 -checked=>'checked',
3844 -label=>'CLICK ME');
3848 print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
3850 checkbox() is used to create an isolated checkbox that isn't logically
3851 related to any others.
3855 =item B<Parameters:>
3859 The first parameter is the required name for the checkbox (-name). It
3860 will also be used for the user-readable label printed next to the
3865 The optional second parameter (-checked) specifies that the checkbox
3866 is turned on by default. Synonyms are -selected and -on.
3870 The optional third parameter (-value) specifies the value of the
3871 checkbox when it is checked. If not provided, the word "on" is
3876 The optional fourth parameter (-label) is the user-readable label to
3877 be attached to the checkbox. If not provided, the checkbox name is
3882 The value of the checkbox can be retrieved using:
3884 $turned_on = $query->param('checkbox_name');
3886 JAVASCRIPTING: checkbox() recognizes the B<-onClick>
3887 parameter. See checkbox_group() for further details.
3889 =head2 CREATING A RADIO BUTTON GROUP
3891 print $query->radio_group(-name=>'group_name',
3892 -values=>['eenie','meenie','minie'],
3899 print $query->radio_group('group_name',['eenie','meenie','minie'],
3900 'meenie','true',\%labels);
3903 HTML3-COMPATIBLE BROWSERS ONLY:
3905 print $query->radio_group(-name=>'group_name',
3906 -values=>['eenie','meenie','minie','moe'],
3907 -rows=2,-columns=>2);
3909 radio_group() creates a set of logically-related radio buttons
3910 (turning one member of the group on turns the others off)
3914 =item B<Parameters:>
3918 The first argument is the name of the group and is required (-name).
3922 The second argument (-values) is the list of values for the radio
3923 buttons. The values and the labels that appear on the page are
3924 identical. Pass an array I<reference> in the second argument, either
3925 using an anonymous array, as shown, or by referencing a named array as
3930 The optional third parameter (-default) is the name of the default
3931 button to turn on. If not specified, the first item will be the
3932 default. You can provide a nonexistent button name, such as "-" to
3933 start up with no buttons selected.
3937 The optional fourth parameter (-linebreak) can be set to 'true' to put
3938 line breaks between the buttons, creating a vertical list.
3942 The optional fifth parameter (-labels) is a pointer to an associative
3943 array relating the radio button values to user-visible labels to be
3944 used in the display. If not provided, the values themselves are
3949 B<HTML3-compatible browsers> (such as Netscape) can take advantage
3951 parameters B<-rows>, and B<-columns>. These parameters cause
3952 radio_group() to return an HTML3 compatible table containing
3953 the radio group formatted with the specified number of rows
3954 and columns. You can provide just the -columns parameter if you
3955 wish; radio_group will calculate the correct number of rows
3958 To include row and column headings in the returned table, you
3959 can use the B<-rowheader> and B<-colheader> parameters. Both
3960 of these accept a pointer to an array of headings to use.
3961 The headings are just decorative. They don't reorganize the
3962 interpetation of the radio buttons -- they're still a single named
3967 When the form is processed, the selected radio button can
3970 $which_radio_button = $query->param('group_name');
3972 The value returned by radio_group() is actually an array of button
3973 elements. You can capture them and use them within tables, lists,
3974 or in other creative ways:
3976 @h = $query->radio_group(-name=>'group_name',-values=>\@values);
3977 &use_in_creative_way(@h);
3979 =head2 CREATING A SUBMIT BUTTON
3981 print $query->submit(-name=>'button_name',
3986 print $query->submit('button_name','value');
3988 submit() will create the query submission button. Every form
3989 should have one of these.
3993 =item B<Parameters:>
3997 The first argument (-name) is optional. You can give the button a
3998 name if you have several submission buttons in your form and you want
3999 to distinguish between them. The name will also be used as the
4000 user-visible label. Be aware that a few older browsers don't deal with this correctly and
4001 B<never> send back a value from a button.
4005 The second argument (-value) is also optional. This gives the button
4006 a value that will be passed to your script in the query string.
4010 You can figure out which button was pressed by using different
4011 values for each one:
4013 $which_one = $query->param('button_name');
4015 JAVASCRIPTING: radio_group() recognizes the B<-onClick>
4016 parameter. See checkbox_group() for further details.
4018 =head2 CREATING A RESET BUTTON
4022 reset() creates the "reset" button. Note that it restores the
4023 form to its value from the last time the script was called,
4024 NOT necessarily to the defaults.
4026 =head2 CREATING A DEFAULT BUTTON
4028 print $query->defaults('button_label')
4030 defaults() creates a button that, when invoked, will cause the
4031 form to be completely reset to its defaults, wiping out all the
4032 changes the user ever made.
4034 =head2 CREATING A HIDDEN FIELD
4036 print $query->hidden(-name=>'hidden_name',
4037 -default=>['value1','value2'...]);
4041 print $query->hidden('hidden_name','value1','value2'...);
4043 hidden() produces a text field that can't be seen by the user. It
4044 is useful for passing state variable information from one invocation
4045 of the script to the next.
4049 =item B<Parameters:>
4053 The first argument is required and specifies the name of this
4058 The second argument is also required and specifies its value
4059 (-default). In the named parameter style of calling, you can provide
4060 a single value here or a reference to a whole list
4064 Fetch the value of a hidden field this way:
4066 $hidden_value = $query->param('hidden_name');
4068 Note, that just like all the other form elements, the value of a
4069 hidden field is "sticky". If you want to replace a hidden field with
4070 some other values after the script has been called once you'll have to
4073 $query->param('hidden_name','new','values','here');
4075 =head2 CREATING A CLICKABLE IMAGE BUTTON
4077 print $query->image_button(-name=>'button_name',
4078 -src=>'/source/URL',
4083 print $query->image_button('button_name','/source/URL','MIDDLE');
4085 image_button() produces a clickable image. When it's clicked on the
4086 position of the click is returned to your script as "button_name.x"
4087 and "button_name.y", where "button_name" is the name you've assigned
4090 JAVASCRIPTING: image_button() recognizes the B<-onClick>
4091 parameter. See checkbox_group() for further details.
4095 =item B<Parameters:>
4099 The first argument (-name) is required and specifies the name of this
4104 The second argument (-src) is also required and specifies the URL
4107 The third option (-align, optional) is an alignment type, and may be
4108 TOP, BOTTOM or MIDDLE
4112 Fetch the value of the button this way:
4113 $x = $query->param('button_name.x');
4114 $y = $query->param('button_name.y');
4116 =head2 CREATING A JAVASCRIPT ACTION BUTTON
4118 print $query->button(-name=>'button_name',
4119 -value=>'user visible label',
4120 -onClick=>"do_something()");
4124 print $query->button('button_name',"do_something()");
4126 button() produces a button that is compatible with Netscape 2.0's
4127 JavaScript. When it's pressed the fragment of JavaScript code
4128 pointed to by the B<-onClick> parameter will be executed. On
4129 non-Netscape browsers this form element will probably not even
4132 =head1 NETSCAPE COOKIES
4134 Netscape browsers versions 1.1 and higher support a so-called
4135 "cookie" designed to help maintain state within a browser session.
4136 CGI.pm has several methods that support cookies.
4138 A cookie is a name=value pair much like the named parameters in a CGI
4139 query string. CGI scripts create one or more cookies and send
4140 them to the browser in the HTTP header. The browser maintains a list
4141 of cookies that belong to a particular Web server, and returns them
4142 to the CGI script during subsequent interactions.
4144 In addition to the required name=value pair, each cookie has several
4145 optional attributes:
4149 =item 1. an expiration time
4151 This is a time/date string (in a special GMT format) that indicates
4152 when a cookie expires. The cookie will be saved and returned to your
4153 script until this expiration date is reached if the user exits
4154 Netscape and restarts it. If an expiration date isn't specified, the cookie
4155 will remain active until the user quits Netscape.
4159 This is a partial or complete domain name for which the cookie is
4160 valid. The browser will return the cookie to any host that matches
4161 the partial domain name. For example, if you specify a domain name
4162 of ".capricorn.com", then Netscape will return the cookie to
4163 Web servers running on any of the machines "www.capricorn.com",
4164 "www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
4165 must contain at least two periods to prevent attempts to match
4166 on top level domains like ".edu". If no domain is specified, then
4167 the browser will only return the cookie to servers on the host the
4168 cookie originated from.
4172 If you provide a cookie path attribute, the browser will check it
4173 against your script's URL before returning the cookie. For example,
4174 if you specify the path "/cgi-bin", then the cookie will be returned
4175 to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
4176 and "/cgi-bin/customer_service/complain.pl", but not to the script
4177 "/cgi-private/site_admin.pl". By default, path is set to "/", which
4178 causes the cookie to be sent to any CGI script on your site.
4180 =item 4. a "secure" flag
4182 If the "secure" attribute is set, the cookie will only be sent to your
4183 script if the CGI request is occurring on a secure channel, such as SSL.
4187 The interface to Netscape cookies is the B<cookie()> method:
4189 $cookie = $query->cookie(-name=>'sessionID',
4192 -path=>'/cgi-bin/database',
4193 -domain=>'.capricorn.org',
4195 print $query->header(-cookie=>$cookie);
4197 B<cookie()> creates a new cookie. Its parameters include:
4203 The name of the cookie (required). This can be any string at all.
4204 Although Netscape limits its cookie names to non-whitespace
4205 alphanumeric characters, CGI.pm removes this restriction by escaping
4206 and unescaping cookies behind the scenes.
4210 The value of the cookie. This can be any scalar value,
4211 array reference, or even associative array reference. For example,
4212 you can store an entire associative array into a cookie this way:
4214 $cookie=$query->cookie(-name=>'family information',
4215 -value=>\%childrens_ages);
4219 The optional partial path for which this cookie will be valid, as described
4224 The optional partial domain for which this cookie will be valid, as described
4229 The optional expiration date for this cookie. The format is as described
4230 in the section on the B<header()> method:
4232 "+1h" one hour from now
4236 If set to true, this cookie will only be used within a secure
4241 The cookie created by cookie() must be incorporated into the HTTP
4242 header within the string returned by the header() method:
4244 print $query->header(-cookie=>$my_cookie);
4246 To create multiple cookies, give header() an array reference:
4248 $cookie1 = $query->cookie(-name=>'riddle_name',
4249 -value=>"The Sphynx's Question");
4250 $cookie2 = $query->cookie(-name=>'answers',
4252 print $query->header(-cookie=>[$cookie1,$cookie2]);
4254 To retrieve a cookie, request it by name by calling cookie()
4255 method without the B<-value> parameter:
4259 %answers = $query->cookie(-name=>'answers');
4260 # $query->cookie('answers') will work too!
4262 The cookie and CGI namespaces are separate. If you have a parameter
4263 named 'answers' and a cookie named 'answers', the values retrieved by
4264 param() and cookie() are independent of each other. However, it's
4265 simple to turn a CGI parameter into a cookie, and vice-versa:
4267 # turn a CGI parameter into a cookie
4268 $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
4270 $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
4272 See the B<cookie.cgi> example script for some ideas on how to use
4273 cookies effectively.
4275 B<NOTE:> There appear to be some (undocumented) restrictions on
4276 Netscape cookies. In Netscape 2.01, at least, I haven't been able to
4277 set more than three cookies at a time. There may also be limits on
4278 the length of cookies. If you need to store a lot of information,
4279 it's probably better to create a unique session ID, store it in a
4280 cookie, and use the session ID to locate an external file/database
4281 saved on the server's side of the connection.
4283 =head1 WORKING WITH NETSCAPE FRAMES
4285 It's possible for CGI.pm scripts to write into several browser
4286 panels and windows using Netscape's frame mechanism.
4287 There are three techniques for defining new frames programmatically:
4291 =item 1. Create a <Frameset> document
4293 After writing out the HTTP header, instead of creating a standard
4294 HTML document using the start_html() call, create a <FRAMESET>
4295 document that defines the frames on the page. Specify your script(s)
4296 (with appropriate parameters) as the SRC for each of the frames.
4298 There is no specific support for creating <FRAMESET> sections
4299 in CGI.pm, but the HTML is very simple to write. See the frame
4300 documentation in Netscape's home pages for details
4302 http://home.netscape.com/assist/net_sites/frames.html
4304 =item 2. Specify the destination for the document in the HTTP header
4306 You may provide a B<-target> parameter to the header() method:
4308 print $q->header(-target=>'ResultsWindow');
4310 This will tell Netscape to load the output of your script into the
4311 frame named "ResultsWindow". If a frame of that name doesn't
4312 already exist, Netscape will pop up a new window and load your
4313 script's document into that. There are a number of magic names
4314 that you can use for targets. See the frame documents on Netscape's
4315 home pages for details.
4317 =item 3. Specify the destination for the document in the <FORM> tag
4319 You can specify the frame to load in the FORM tag itself. With
4320 CGI.pm it looks like this:
4322 print $q->startform(-target=>'ResultsWindow');
4324 When your script is reinvoked by the form, its output will be loaded
4325 into the frame named "ResultsWindow". If one doesn't already exist
4326 a new window will be created.
4330 The script "frameset.cgi" in the examples directory shows one way to
4331 create pages in which the fill-out form and the response live in
4332 side-by-side frames.
4336 If you are running the script
4337 from the command line or in the perl debugger, you can pass the script
4338 a list of keywords or parameter=value pairs on the command line or
4339 from standard input (you don't have to worry about tricking your
4340 script into reading from environment variables).
4341 You can pass keywords like this:
4343 your_script.pl keyword1 keyword2 keyword3
4347 your_script.pl keyword1+keyword2+keyword3
4351 your_script.pl name1=value1 name2=value2
4355 your_script.pl name1=value1&name2=value2
4357 or even as newline-delimited parameters on standard input.
4359 When debugging, you can use quotes and backslashes to escape
4360 characters in the familiar shell manner, letting you place
4361 spaces and other funny characters in your parameter=value
4364 your_script.pl "name1='I am a long value'" "name2=two\ words"
4366 =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
4368 The dump() method produces a string consisting of all the query's
4369 name/value pairs formatted nicely as a nested list. This is useful
4370 for debugging purposes:
4375 Produces something that looks like:
4389 You can pass a value of 'true' to dump() in order to get it to
4390 print the results out as plain text, suitable for incorporating
4391 into a <PRE> section.
4393 As a shortcut, as of version 1.56 you can interpolate the entire CGI
4394 object into a string and it will be replaced with the a nice HTML dump
4398 print "<H2>Current Values</H2> $query\n";
4400 =head1 FETCHING ENVIRONMENT VARIABLES
4402 Some of the more useful environment variables can be fetched
4403 through this interface. The methods are as follows:
4409 Return a list of MIME types that the remote browser
4410 accepts. If you give this method a single argument
4411 corresponding to a MIME type, as in
4412 $query->accept('text/html'), it will return a
4413 floating point value corresponding to the browser's
4414 preference for this type from 0.0 (don't want) to 1.0.
4415 Glob types (e.g. text/*) in the browser's accept list
4416 are handled correctly.
4418 =item B<raw_cookie()>
4420 Returns the HTTP_COOKIE variable, an HTTP extension
4421 implemented by Netscape browsers version 1.1
4422 and higher. Cookies have a special format, and this
4423 method call just returns the raw form (?cookie dough).
4424 See cookie() for ways of setting and retrieving
4427 =item B<user_agent()>
4429 Returns the HTTP_USER_AGENT variable. If you give
4430 this method a single argument, it will attempt to
4431 pattern match on it, allowing you to do something
4432 like $query->user_agent(netscape);
4434 =item B<path_info()>
4436 Returns additional path information from the script URL.
4437 E.G. fetching /cgi-bin/your_script/additional/stuff will
4438 result in $query->path_info() returning
4441 NOTE: The Microsoft Internet Information Server
4442 is broken with respect to additional path information. If
4443 you use the Perl DLL library, the IIS server will attempt to
4444 execute the additional path information as a Perl script.
4445 If you use the ordinary file associations mapping, the
4446 path information will be present in the environment,
4447 but incorrect. The best thing to do is to avoid using additional
4448 path information in CGI scripts destined for use with IIS.
4450 =item B<path_translated()>
4452 As per path_info() but returns the additional
4453 path information translated into a physical path, e.g.
4454 "/usr/local/etc/httpd/htdocs/additional/stuff".
4456 The Microsoft IIS is broken with respect to the translated
4459 =item B<remote_host()>
4461 Returns either the remote host name or IP address.
4462 if the former is unavailable.
4464 =item B<script_name()>
4465 Return the script name as a partial URL, for self-refering
4470 Return the URL of the page the browser was viewing
4471 prior to fetching your script. Not available for all
4474 =item B<auth_type ()>
4476 Return the authorization/verification method in use for this
4479 =item B<server_name ()>
4481 Returns the name of the server, usually the machine's host
4484 =item B<virtual_host ()>
4486 When using virtual hosts, returns the name of the host that
4487 the browser attempted to contact
4489 =item B<server_software ()>
4491 Returns the server software and version number.
4493 =item B<remote_user ()>
4495 Return the authorization/verification name used for user
4496 verification, if this script is protected.
4498 =item B<user_name ()>
4500 Attempt to obtain the remote user's name, using a variety
4501 of different techniques. This only works with older browsers
4502 such as Mosaic. Netscape does not reliably report the user
4505 =item B<request_method()>
4507 Returns the method used to access your script, usually
4508 one of 'POST', 'GET' or 'HEAD'.
4512 =head1 CREATING HTML ELEMENTS:
4514 In addition to its shortcuts for creating form elements, CGI.pm
4515 defines general HTML shortcut methods as well. HTML shortcuts are
4516 named after a single HTML element and return a fragment of HTML text
4517 that you can then print or manipulate as you like.
4519 This example shows how to use the HTML methods:
4522 print $q->blockquote(
4523 "Many years ago on the island of",
4524 $q->a({href=>"http://crete.org/"},"Crete"),
4525 "there lived a minotaur named",
4526 $q->strong("Fred."),
4530 This results in the following HTML code (extra newlines have been
4531 added for readability):
4534 Many years ago on the island of
4535 <a HREF="http://crete.org/">Crete</a> there lived
4536 a minotaur named <strong>Fred.</strong>
4540 If you find the syntax for calling the HTML shortcuts awkward, you can
4541 import them into your namespace and dispense with the object syntax
4542 completely (see the next section for more details):
4544 use CGI shortcuts; # IMPORT HTML SHORTCUTS
4546 "Many years ago on the island of",
4547 a({href=>"http://crete.org/"},"Crete"),
4548 "there lived a minotaur named",
4553 =head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
4555 The HTML methods will accept zero, one or multiple arguments. If you
4556 provide no arguments, you get a single tag:
4561 If you provide one or more string arguments, they are concatenated
4562 together with spaces and placed between opening and closing tags:
4564 print h1("Chapter","1");
4565 # gives "<h1>Chapter 1</h1>"
4567 If the first argument is an associative array reference, then the keys
4568 and values of the associative array become the HTML tag's attributes:
4570 print a({href=>'fred.html',target=>'_new'},
4571 "Open a new frame");
4572 # gives <a href="fred.html",target="_new">Open a new frame</a>
4574 You are free to use CGI.pm-style dashes in front of the attribute
4575 names if you prefer:
4577 print img {-src=>'fred.gif',-align=>'LEFT'};
4578 # gives <img ALIGN="LEFT" SRC="fred.gif">
4580 =head2 Generating new HTML tags
4582 Since no mere mortal can keep up with Netscape and Microsoft as they
4583 battle it out for control of HTML, the code that generates HTML tags
4584 is general and extensible. You can create new HTML tags freely just
4585 by referring to them on the import line:
4587 use CGI shortcuts,winkin,blinkin,nod;
4589 Now, in addition to the standard CGI shortcuts, you've created HTML
4590 tags named "winkin", "blinkin" and "nod". You can use them like this:
4592 print blinkin {color=>'blue',rate=>'fast'},"Yahoo!";
4593 # <blinkin COLOR="blue" RATE="fast">Yahoo!</blinkin>
4595 =head1 IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE
4597 As a convenience, you can import most of the CGI method calls directly
4598 into your name space. The syntax for doing this is:
4600 use CGI <list of methods>;
4602 The listed methods will be imported into the current package; you can
4603 call them directly without creating a CGI object first. This example
4604 shows how to import the B<param()> and B<header()>
4605 methods, and then use them directly:
4607 use CGI param,header;
4608 print header('text/plain');
4609 $zipcode = param('zipcode');
4611 You can import groups of methods by referring to a number of special
4618 Import all CGI-handling methods, such as B<param()>, B<path_info()>
4623 Import all fill-out form generating methods, such as B<textfield()>.
4627 Import all methods that generate HTML 2.0 standard elements.
4631 Import all methods that generate HTML 3.0 proposed elements (such as
4632 <table>, <super> and <sub>).
4636 Import all methods that generate Netscape-specific HTML extensions.
4640 Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
4645 Import "standard" features, 'html2', 'form' and 'cgi'.
4649 Import all the available methods. For the full list, see the CGI.pm
4650 code, where the variable %TAGS is defined.
4654 Note that in the interests of execution speed CGI.pm does B<not> use
4655 the standard L<Exporter> syntax for specifying load symbols. This may
4656 change in the future.
4658 If you import any of the state-maintaining CGI or form-generating
4659 methods, a default CGI object will be created and initialized
4660 automatically the first time you use any of the methods that require
4661 one to be present. This includes B<param()>, B<textfield()>,
4662 B<submit()> and the like. (If you need direct access to the CGI
4663 object, you can find it in the global variable B<$CGI::Q>). By
4664 importing CGI.pm methods, you can create visually elegant scripts:
4666 use CGI standard,html2;
4669 start_html('Simple Script'),
4670 h1('Simple Script'),
4672 "What's your name? ",textfield('name'),p,
4673 "What's the combination?",
4674 checkbox_group(-name=>'words',
4675 -values=>['eenie','meenie','minie','moe'],
4676 -defaults=>['eenie','moe']),p,
4677 "What's your favorite color?",
4678 popup_menu(-name=>'color',
4679 -values=>['red','green','blue','chartreuse']),p,
4686 "Your name is ",em(param('name')),p,
4687 "The keywords are: ",em(join(", ",param('words'))),p,
4688 "Your favorite color is ",em(param('color')),".\n";
4692 =head1 USING NPH SCRIPTS
4694 NPH, or "no-parsed-header", scripts bypass the server completely by
4695 sending the complete HTTP header directly to the browser. This has
4696 slight performance benefits, but is of most use for taking advantage
4697 of HTTP extensions that are not directly supported by your server,
4698 such as server push and PICS headers.
4700 Servers use a variety of conventions for designating CGI scripts as
4701 NPH. Many Unix servers look at the beginning of the script's name for
4702 the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
4703 Internet Information Server, in contrast, try to decide whether a
4704 program is an NPH script by examining the first line of script output.
4707 CGI.pm supports NPH scripts with a special NPH mode. When in this
4708 mode, CGI.pm will output the necessary extra header information when
4709 the header() and redirect() methods are
4712 The Microsoft Internet Information Server requires NPH mode. As of version
4713 2.30, CGI.pm will automatically detect when the script is running under IIS
4714 and put itself into this mode. You do not need to do this manually, although
4715 it won't hurt anything if you do.
4717 There are a number of ways to put CGI.pm into NPH mode:
4721 =item In the B<use> statement
4722 Simply add ":nph" to the list of symbols to be imported into your script:
4724 use CGI qw(:standard :nph)
4726 =item By calling the B<nph()> method:
4728 Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
4732 =item By using B<-nph> parameters in the B<header()> and B<redirect()> statements:
4734 print $q->header(-nph=>1);
4738 =head1 AUTHOR INFORMATION
4740 Copyright 1995,1996, Lincoln D. Stein. All rights reserved. It may
4741 be used and modified freely, but I do request that this copyright
4742 notice remain attached to the file. You may modify this module as you
4743 wish, but if you redistribute a modified version, please attach a note
4744 listing the modifications you have made.
4746 Address bug reports and comments to:
4747 lstein@genome.wi.mit.edu
4751 Thanks very much to:
4755 =item Matt Heffron (heffron@falstaff.css.beckman.com)
4757 =item James Taylor (james.taylor@srs.gov)
4759 =item Scott Anguish <sanguish@digifix.com>
4761 =item Mike Jewell (mlj3u@virginia.edu)
4763 =item Timothy Shimmin (tes@kbs.citri.edu.au)
4765 =item Joergen Haegg (jh@axis.se)
4767 =item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
4769 =item Richard Resnick (applepi1@aol.com)
4771 =item Craig Bishop (csb@barwonwater.vic.gov.au)
4773 =item Tony Curtis (tc@vcpc.univie.ac.at)
4775 =item Tim Bunce (Tim.Bunce@ig.co.uk)
4777 =item Tom Christiansen (tchrist@convex.com)
4779 =item Andreas Koenig (k@franz.ww.TU-Berlin.DE)
4781 =item Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au)
4783 =item Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu)
4785 =item Stephen Dahmen (joyfire@inxpress.net)
4787 =item Ed Jordan (ed@fidalgo.net)
4789 =item David Alan Pisoni (david@cnation.com)
4791 =item ...and many many more...
4793 for suggestions and bug fixes.
4797 =head1 A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
4800 #!/usr/local/bin/perl
4806 print $query->header;
4807 print $query->start_html("Example CGI.pm Form");
4808 print "<H1> Example CGI.pm Form</H1>\n";
4809 &print_prompt($query);
4812 print $query->end_html;
4817 print $query->startform;
4818 print "<EM>What's your name?</EM><BR>";
4819 print $query->textfield('name');
4820 print $query->checkbox('Not my real name');
4822 print "<P><EM>Where can you find English Sparrows?</EM><BR>";
4823 print $query->checkbox_group(
4824 -name=>'Sparrow locations',
4825 -values=>[England,France,Spain,Asia,Hoboken],
4827 -defaults=>[England,Asia]);
4829 print "<P><EM>How far can they fly?</EM><BR>",
4830 $query->radio_group(
4832 -values=>['10 ft','1 mile','10 miles','real far'],
4833 -default=>'1 mile');
4835 print "<P><EM>What's your favorite color?</EM> ";
4836 print $query->popup_menu(-name=>'Color',
4837 -values=>['black','brown','red','yellow'],
4840 print $query->hidden('Reference','Monty Python and the Holy Grail');
4842 print "<P><EM>What have you got there?</EM><BR>";
4843 print $query->scrolling_list(
4844 -name=>'possessions',
4845 -values=>['A Coconut','A Grail','An Icon',
4846 'A Sword','A Ticket'],
4850 print "<P><EM>Any parting comments?</EM><BR>";
4851 print $query->textarea(-name=>'Comments',
4855 print "<P>",$query->reset;
4856 print $query->submit('Action','Shout');
4857 print $query->submit('Action','Scream');
4858 print $query->endform;
4866 print "<H2>Here are the current settings in this form</H2>";
4868 foreach $key ($query->param) {
4869 print "<STRONG>$key</STRONG> -> ";
4870 @values = $query->param($key);
4871 print join(", ",@values),"<BR>\n";
4878 <ADDRESS>Lincoln D. Stein</ADDRESS><BR>
4879 <A HREF="/">Home Page</A>
4885 This module has grown large and monolithic. Furthermore it's doing many
4886 things, such as handling URLs, parsing CGI input, writing HTML, etc., that
4887 are also done in the LWP modules. It should be discarded in favor of
4888 the CGI::* modules, but somehow I continue to work on it.
4890 Note that the code is truly contorted in order to avoid spurious
4891 warnings when programs are run with the B<-w> switch.
4895 L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
4896 L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>,
4897 L<CGI::Push>, L<CGI::Fast>