" if @{$colheaders};
foreach (@{$colheaders}) {
- $result .= "
$_
";
+ $result .= "
$_
";
}
for ($row=0;$row<$rows;$row++) {
- $result .= "
";
- $result .= "
$rowheaders->[$row]
" if @$rowheaders;
+ $result .= "
";
+ $result .= "
$rowheaders->[$row]
" if @$rowheaders;
for ($column=0;$column<$columns;$column++) {
- $result .= "
" . $elements[$column*$rows + $row] . "
"
+ $result .= "
" . $elements[$column*$rows + $row] . "
"
if defined($elements[$column*$rows + $row]);
}
- $result .= "
";
+ $result .= "";
}
- $result .= "
";
+ $result .= "
";
return $result;
}
END_OF_FUNC
@@ -1927,16 +2057,23 @@ sub radio_group {
my($other) = @other ? " @other" : '';
foreach (@values) {
- my($checkit) = $checked eq $_ ? ' CHECKED' : '';
- my($break) = $linebreak ? ' ' : '';
+ my($checkit) = $checked eq $_ ? qq/ checked="checked"/ : '';
+ my($break);
+ if ($linebreak) {
+ $break = $XHTML ? " " : " ";
+ }
+ else {
+ $break = '';
+ }
my($label)='';
unless (defined($nolabels) && $nolabels) {
$label = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
- $label = $self->escapeHTML($label);
+ $label = $self->escapeHTML($label,1);
}
$_=$self->escapeHTML($_);
- push(@elements,qq/${label}${break}/);
+ push(@elements,$XHTML ? qq(${label}${break})
+ : qq/${label}${break}/);
}
$self->register_parameter($name);
return wantarray ? @elements : join(' ',@elements)
@@ -1979,17 +2116,17 @@ sub popup_menu {
my(@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
- $result = qq/";
return $result;
}
END_OF_FUNC
@@ -2028,21 +2165,21 @@ sub scrolling_list {
$size = $size || scalar(@values);
my(%selected) = $self->previous_or_default($name,$defaults,$override);
- my($is_multiple) = $multiple ? ' MULTIPLE' : '';
- my($has_size) = $size ? " SIZE=$size" : '';
+ my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
+ my($has_size) = $size ? qq/ size="$size"/: '';
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
- $result = qq/\n/;
+ $result = qq/\n/;
foreach (@values) {
- my($selectit) = $selected{$_} ? 'SELECTED' : '';
+ my($selectit) = $self->_selected($selected{$_});
my($label) = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label=$self->escapeHTML($label);
- my($value)=$self->escapeHTML($_);
- $result .= "\n";
+ my($value)=$self->escapeHTML($_,1);
+ $result .= "\n";
}
- $result .= "\n";
+ $result .= "";
$self->register_parameter($name);
return $result;
}
@@ -2084,8 +2221,9 @@ sub hidden {
$name=$self->escapeHTML($name);
foreach (@value) {
- $_ = defined($_) ? $self->escapeHTML($_) : '';
- push(@result,qq//);
+ $_ = defined($_) ? $self->escapeHTML($_,1) : '';
+ push @result,$XHTML ? qq()
+ : qq();
}
return wantarray ? @result : join('',@result);
}
@@ -2107,10 +2245,11 @@ sub image_button {
my($name,$src,$alignment,@other) =
rearrange([NAME,SRC,ALIGN],@p);
- my($align) = $alignment ? " ALIGN=\U$alignment" : '';
+ my($align) = $alignment ? " align=\U\"$alignment\"" : '';
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
- return qq//;
+ return $XHTML ? qq()
+ : qq//;
}
END_OF_FUNC
@@ -2145,25 +2284,24 @@ END_OF_FUNC
'url' => <<'END_OF_FUNC',
sub url {
my($self,@p) = self_or_default(@_);
- my ($relative,$absolute,$full,$path_info,$query) =
- rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
+ my ($relative,$absolute,$full,$path_info,$query,$base) =
+ rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p);
my $url;
- $full++ if !($relative || $absolute);
+ $full++ if $base || !($relative || $absolute);
my $path = $self->path_info;
- my $script_name;
+ my $script_name = $self->script_name;
+
+ # for compatibility with Apache's MultiViews
if (exists($ENV{REQUEST_URI})) {
my $index;
$script_name = $ENV{REQUEST_URI};
- # strip query string
- substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0;
+ $script_name =~ s/\?.+$//; # strip query string
# and path
if (exists($ENV{PATH_INFO})) {
- my $decoded_path = unescape($ENV{PATH_INFO});
- substr($script_name,$index) = '' if ($index = rindex($script_name,$decoded_path)) >= 0;
+ (my $encoded_path = $ENV{PATH_INFO}) =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
+ $script_name =~ s/$encoded_path$//i;
}
- } else {
- $script_name = $self->script_name;
}
if ($full) {
@@ -2179,16 +2317,18 @@ sub url {
unless (lc($protocol) eq 'http' && $port == 80)
|| (lc($protocol) eq 'https' && $port == 443);
}
+ return $url if $base;
$url .= $script_name;
} elsif ($relative) {
($url) = $script_name =~ m!([^/]+)$!;
} elsif ($absolute) {
$url = $script_name;
}
+
$url .= $path if $path_info and defined $path;
$url .= "?" . $self->query_string if $query and $self->query_string;
$url = '' unless defined $url;
- $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/uc sprintf("%%%02x",ord($1))/eg;
+ $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
return $url;
}
@@ -2229,7 +2369,7 @@ sub cookie {
}
# If we get here, we're creating a new cookie
- return undef unless $name; # this is an error
+ return undef unless defined($name) && $name ne ''; # this is an error
my @param;
push(@param,'-name'=>$name);
@@ -2239,7 +2379,7 @@ sub cookie {
push(@param,'-expires'=>$expires) if $expires;
push(@param,'-secure'=>$secure) if $secure;
- return CGI::Cookie->new(@param);
+ return new CGI::Cookie(@param);
}
END_OF_FUNC
@@ -2338,6 +2478,9 @@ sub query_string {
push(@pairs,"$eparam=$value");
}
}
+ foreach (keys %{$self->{'.fieldnames'}}) {
+ push(@pairs,".cgifields=".escape("$_"));
+ }
return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs);
}
END_OF_FUNC
@@ -2762,7 +2905,7 @@ sub read_multipart {
my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
# Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
+ my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\"]*)"?/;
# add this parameter to our list
$self->add_parameter($param);
@@ -2790,12 +2933,12 @@ sub read_multipart {
# choose a relatively unpredictable tmpfile sequence number
my $seqno = unpack("%16C*",join('',localtime,values %ENV));
for (my $cnt=10;$cnt>0;$cnt--) {
- next unless $tmpfile = new TempFile($seqno);
+ next unless $tmpfile = new CGITempFile($seqno);
$tmp = $tmpfile->as_string;
last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
$seqno += int rand(100);
}
- die "CGI open of tmpfile: $!\n" unless $filehandle;
+ die "CGI open of tmpfile: $!\n" unless defined $filehandle;
$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
my ($data);
@@ -2823,10 +2966,9 @@ END_OF_FUNC
'upload' =><<'END_OF_FUNC',
sub upload {
my($self,$param_name) = self_or_default(@_);
- my $param = $self->param($param_name);
- return unless $param;
- return unless ref($param) && fileno($param);
- return $param;
+ my @param = grep(ref && fileno($_), $self->param($param_name));
+ return unless @param;
+ return wantarray ? @param : $param[0];
}
END_OF_FUNC
@@ -2895,7 +3037,7 @@ sub asString {
my $self = shift;
# get rid of package name
(my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//;
- $i =~ s/\\(.)/$1/g;
+ $i =~ s/%(..)/ chr(hex($1)) /eg;
return $i;
# BEGIN DEAD CODE
# This was an extremely clever patch that allowed "use strict refs".
@@ -2920,12 +3062,12 @@ END_OF_FUNC
sub new {
my($pack,$name,$file,$delete) = @_;
require Fcntl unless defined &Fcntl::O_RDWR;
- my $fv = ('Fh::' . ++$FH . quotemeta($name));
- warn unless *{$fv};
- my $ref = \*{$fv};
+ (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
+ my $fv = ++$FH . $safename;
+ my $ref = \*{"Fh::$fv"};
sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
unlink($file) if $delete;
- CORE::delete $Fh::{$FH};
+ CORE::delete $Fh::{$fv};
return bless $ref,$pack;
}
END_OF_FUNC
@@ -2993,7 +3135,7 @@ sub new {
# BUG: IE 3.01 on the Macintosh uses just the boundary -- not
# the two extra hyphens. We do a special case here on the user-agent!!!!
- $boundary = "--$boundary" unless CGI::user_agent('MSIE\s+3\.0[12];\s*Mac');
+ $boundary = "--$boundary" unless CGI::user_agent('MSIE\s+3\.0[12];\s*Mac|DreamPassport');
} else { # otherwise we find it ourselves
my($old);
@@ -3099,8 +3241,7 @@ sub read {
die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
# If the boundary begins the data, then skip past it
- # and return undef. The +2 here is a fiendish plot to
- # remove the CR/LF pair at the end of the boundary.
+ # and return undef.
if ($start == 0) {
# clear us out completely if we've hit the last boundary.
@@ -3111,7 +3252,8 @@ sub read {
}
# just remove the boundary.
- substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
+ substr($self->{BUFFER},0,length($self->{BOUNDARY}))='';
+ $self->{BUFFER} =~ s/^\012\015?//;
return undef;
}
@@ -3129,7 +3271,8 @@ sub read {
substr($self->{BUFFER},0,$bytesToReturn)='';
# If we hit the boundary, remove the CRLF from the end.
- return ($start > 0) ? substr($returnval,0,-2) : $returnval;
+ return (($start > 0) && ($start <= $bytes))
+ ? substr($returnval,0,-2) : $returnval;
}
END_OF_FUNC
@@ -3186,7 +3329,7 @@ END_OF_AUTOLOAD
####################################################################################
################################## TEMPORARY FILES #################################
####################################################################################
-package TempFile;
+package CGITempFile;
$SL = $CGI::SL;
$MAC = $CGI::OS eq 'MACINTOSH';
@@ -3195,7 +3338,8 @@ unless ($TMPDIRECTORY) {
@TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
"C:${SL}temp","${SL}tmp","${SL}temp",
"${vol}${SL}Temporary Items",
- "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH");
+ "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH",
+ "C:${SL}system${SL}temp");
unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'};
# this feature was supposed to provide per-user tmpfiles, but
@@ -3217,7 +3361,12 @@ $MAXTRIES = 5000;
# cute feature, but overload implementation broke it
# %OVERLOAD = ('""'=>'as_string');
-*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+*CGITempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+
+sub DESTROY {
+ my($self) = @_;
+ unlink $$self; # get rid of the file
+}
###############################################################################
################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
@@ -3234,19 +3383,12 @@ sub new {
last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
}
# untaint the darn thing
- return unless $filename =~ m!^([a-zA-Z0-9_ '":/.\$\\]+)$!;
+ return unless $filename =~ m!^([a-zA-Z0-9_ '":/.\$\\-]+)$!;
$filename = $1;
return bless \$filename;
}
END_OF_FUNC
-'DESTROY' => <<'END_OF_FUNC',
-sub DESTROY {
- my($self) = @_;
- unlink $$self; # get rid of the file
-}
-END_OF_FUNC
-
'as_string' => <<'END_OF_FUNC'
sub as_string {
my($self) = @_;
@@ -3425,10 +3567,10 @@ this:
Code Generated HTML
---- --------------
- h1()
- h1('some','contents');
some contents
- h1({-align=>left});
- h1({-align=>left},'contents');
contents
+ h1()
+ h1('some','contents');
some contents
+ h1({-align=>left});
+ h1({-align=>left},'contents');
contents
HTML tags are described in more detail later.
@@ -3451,12 +3593,18 @@ have several choices:
=over 4
-=item 1. Use another name for the argument, if one is available. For
-example, -value is an alias for -values.
+=item 1.
+
+Use another name for the argument, if one is available.
+For example, -value is an alias for -values.
+
+=item 2.
+
+Change the capitalization, e.g. -Values
-=item 2. Change the capitalization, e.g. -Values
+=item 3.
-=item 3. Put quotes around the argument name, e.g. '-values'
+Put quotes around the argument name, e.g. '-values'
=back
@@ -3678,13 +3826,13 @@ the keys are the names of the CGI parameters, and the values are the
parameters' values. The Vars() method does this. Called in a scalar
context, it returns the parameter list as a tied hash reference.
Changing a key changes the value of the parameter in the underlying
-CGI parameter list. Called in an array context, it returns the
+CGI parameter list. Called in a list context, it returns the
parameter list as an ordinary hash. This allows you to read the
contents of the parameter list, but not to change it.
When using this, the thing you must watch out for are multivalued CGI
parameters. Because a hash cannot distinguish between scalar and
-array context, multivalued parameters will be returned as a packed
+list context, multivalued parameters will be returned as a packed
string, separated by the "\0" (null) character. You must split this
packed string in order to get at the individual values. This is the
convention introduced long ago by Steve Brenner in his cgi-lib.pl
@@ -3811,9 +3959,14 @@ Import all methods that generate HTML 2.0 standard elements.
=item B<:html3>
-Import all methods that generate HTML 3.0 proposed elements (such as
+Import all methods that generate HTML 3.0 elements (such as
, and ).
+=item B<:html4>
+
+Import all methods that generate HTML 4 elements (such as
+, and ).
+
=item B<:netscape>
Import all methods that generate Netscape-specific HTML extensions.
@@ -3825,7 +3978,7 @@ Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
=item B<:standard>
-Import "standard" features, 'html2', 'html3', 'form' and 'cgi'.
+Import "standard" features, 'html2', 'html3', 'html4', 'form' and 'cgi'.
=item B<:all>
@@ -3838,7 +3991,7 @@ If you import a function name that is not part of CGI.pm, the module
will treat it as a new HTML tag and generate the appropriate
subroutine. You can then use it like any other HTML tag. This is to
provide for the rapidly-evolving HTML "standard." For example, say
-Microsoft comes out with a new tag called (which causes the
+Microsoft comes out with a new tag called (which causes the
user's desktop to be flooded with a rotating gradient fill until his
machine reboots). You don't need to wait for a new version of CGI.pm
to start using it immediately:
@@ -3942,6 +4095,17 @@ have the hidden fields appear in the querystring in a GET method.
For example, a search script generated this way will have
a very nice url with search parameters for bookmarking.
+=item -no_undef_params
+
+This keeps CGI.pm from including undef params in the parameter list.
+
+=item -no_xhtml
+
+By default, CGI.pm versions 2.69 and higher emit XHTML
+(http://www.w3.org/TR/xhtml1/). The -no_xhtml pragma disables this
+feature. Thanks to Michalis Kabrianis for this
+feature.
+
=item -nph
This makes CGI.pm produce a header appropriate for an NPH (no
@@ -4041,7 +4205,7 @@ For example:
produces
-
Level 1 Header
+
Level 1 Header
There will be some times when you want to produce the start and end
tags yourself. In this case, you can use the form start_I
@@ -4065,13 +4229,13 @@ the standard ones:
=over 4
-=item 1. start_table() (generates a
tag)
+=item 1. start_table() (generates a
tag)
-=item 2. end_table() (generates a
tag)
+=item 2. end_table() (generates a
tag)
-=item 3. start_ul() (generates a
tag)
+=item 3. start_ul() (generates a
tag)
-=item 4. end_ul() (generates a
tag)
+=item 4. end_ul() (generates a
tag)
=back
@@ -4114,6 +4278,7 @@ pages.
-expires=>'+3d',
-cookie=>$cookie,
-charset=>'utf-7',
+ -attachment=>'foo.gif',
-Cost=>'$2.00');
header() returns the Content-type: header. You can provide your own
@@ -4155,13 +4320,19 @@ such as expiration time. Use the cookie() method to create and retrieve
session cookies.
The B<-nph> parameter, if set to a true value, will issue the correct
-headers to work with a NPH (no-parse-header) script. This is important
+headers to work with an NPH (no-parse-header) script. This is important
to use with certain servers that expect all their scripts to be NPH.
The B<-charset> parameter can be used to control the character set
sent to the browser. If not provided, defaults to ISO-8859-1. As a
side effect, this sets the charset() method as well.
+The B<-attachment> parameter can be used to turn the page into an
+attachment. Instead of displaying the page, some browsers will prompt
+the user to save it to disk. The value of the argument is the
+suggested name for the saved file. In order for this to work, you may
+have to set the B<-type> to "application/octet-stream".
+
=head2 GENERATING A REDIRECTION HEADER
print $query->redirect('http://somewhere.else/in/movie/land');
@@ -4172,9 +4343,7 @@ time of day or the identity of the user.
The redirect() function redirects the browser to a different URL. If
you use redirection like this, you should B print out a header as
-well. As of version 2.0, we produce both the unofficial Location:
-header and the official URI: header. This should satisfy most servers
-and browsers.
+well.
One hint I can offer is that relative links may not work correctly
when you generate a redirection to another document on your site.
@@ -4188,7 +4357,7 @@ You can also use named arguments:
-nph=>1);
The B<-nph> parameter, if set to a true value, will issue the correct
-headers to work with a NPH (no-parse-header) script. This is important
+headers to work with an NPH (no-parse-header) script. This is important
to use with certain servers, such as Microsoft Internet Explorer, which
expect all their scripts to be NPH.
@@ -4208,14 +4377,15 @@ out an HTML document. The start_html() routine creates the top of the
page, along with a lot of optional information that controls the
page's appearance and behavior.
-This method returns a canned HTML header and the opening tag.
+This method returns a canned HTML header and the opening tag.
All parameters are optional. In the named parameter form, recognized
-parameters are -title, -author, -base, -xbase and -target (see below
-for the explanation). Any additional parameters you provide, such as
-the Netscape unofficial BGCOLOR attribute, are added to the
-tag. Additional parameters must be proceeded by a hyphen.
+parameters are -title, -author, -base, -xbase, -dtd, -lang and -target
+(see below for the explanation). Any additional parameters you
+provide, such as the Netscape unofficial BGCOLOR attribute, are added
+to the tag. Additional parameters must be proceeded by a
+hyphen.
-The argument B<-xbase> allows you to provide an HREF for the tag
+The argument B<-xbase> allows you to provide an HREF for the tag
different from the current location, as in
-xbase=>"http://home.mcom.com/"
@@ -4234,29 +4404,35 @@ All relative links will be interpreted relative to this tag.
You add arbitrary meta information to the header with the B<-meta>
argument. This argument expects a reference to an associative array
containing name/value pairs of meta information. These will be turned
-into a series of header tags that look something like this:
+into a series of header tags that look something like this:
+
+
+
-
-
+To create an HTTP-EQUIV type of tag, use B<-head>, described
+below.
-There is no direct support for the HTTP-EQUIV type of tag.
-This is because you can modify the HTTP header directly with the
-B method. For example, if you want to send the Refresh:
-header, do it in the header() method:
+The B<-style> argument is used to incorporate cascading stylesheets
+into your code. See the section on CASCADING STYLESHEETS for more
+information.
- print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
+The B<-lang> argument is used to incorporate a language attribute into
+the tag. The default if not specified is "en-US" for US
+English. For example:
-The B<-style> tag is used to incorporate cascading stylesheets into
-your code. See the section on CASCADING STYLESHEETS for more information.
+ print $q->start_html(-lang=>'fr-CA');
-You can place other arbitrary HTML elements to the section with the
-B<-head> tag. For example, to place the rarely-used element in the
+The B<-encoding> argument can be used to specify the character set for
+XHTML. It defaults to UTF-8 if not specified.
+
+You can place other arbitrary HTML elements to the section with the
+B<-head> tag. For example, to place the rarely-used element in the
head section, use this:
print start_html(-head=>Link({-rel=>'next',
- -href=>'http://www.capricorn.com/s2.html'}));
+ -href=>'http://www.capricorn.com/s2.html'}));
-To incorporate multiple HTML elements into the section, just pass an
+To incorporate multiple HTML elements into the section, just pass an
array reference:
print start_html(-head=>[
@@ -4267,11 +4443,17 @@ array reference:
]
);
+And here's how to create an HTTP-EQUIV tag:
+
+ print start_html(-head=>meta({-http_equiv => 'Content-Type',
+ -content => 'text/html'}))
+
+
JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
to add Netscape JavaScript calls to your pages. B<-script> should
point to a block of text containing JavaScript function definitions.
-This block will be placed within a