# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.49 2001/02/04 23:08:39 lstein Exp $';
-$CGI::VERSION='2.752';
+$CGI::revision = '$Id: CGI.pm,v 1.55 2001/09/26 02:15:52 lstein Exp $';
+$CGI::VERSION='2.78';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
-# $TempFile::TMPDIRECTORY = '/usr/tmp';
+# $CGITempFile::TMPDIRECTORY = '/usr/tmp';
use CGI::Util qw(rearrange make_attributes unescape escape expires);
use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
# separate the name=value pairs by semicolons rather than ampersands
$USE_PARAM_SEMICOLONS = 1;
+ # Do not include undefined params parsed from query string
+ # use CGI qw(-no_undef_params);
+ $NO_UNDEF_PARAMS = 0;
+
# Other globals that you shouldn't worry about.
undef $Q;
$BEEN_THERE = 0;
# The path separator is a slash, backslash or semicolon, depending
# on the paltform.
$SL = {
- UNIX=>'/', OS2=>'\\', EPOC=>'/',
- WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
+ UNIX=>'/', OS2=>'\\', EPOC=>'/',
+ WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
}->{$OS};
# This no longer seems to be necessary
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
+ next if $NO_UNDEF_PARAMS and not defined $value;
$value = '' unless defined $value;
$param = unescape($param);
$value = unescape($value);
$PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
$EXPORT{$_}++, next if /^[:-]any$/;
$compile++, next if /^[:-]compile$/;
+ $NO_UNDEF_PARAMS++, next if /^[:-]no_undef_params$/;
# This is probably extremely evil code -- to be deleted some day.
if (/^[-]autoload$/) {
}
push(@result,"</UL>");
}
- push(@result,"</UL>\n");
+ push(@result,"</UL>");
return join("\n",@result);
}
END_OF_FUNC
foreach (@other) {
next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e;
+ $header = ucfirst($header);
}
$type ||= 'text/html' unless defined($type);
push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph;
push(@header,"Pragma: no-cache") if $self->cache();
push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment;
- push(@header,@other);
+ push(@header,map {ucfirst $_} @other);
push(@header,"Content-Type: $type") if $type ne '';
my $header = join($CRLF,@header)."${CRLF}${CRLF}";
'start_html' => <<'END_OF_FUNC',
sub start_html {
my($self,@p) = &self_or_default(@_);
- my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,$lang,@other) =
- rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG],@p);
+ my($title,$author,$base,$xbase,$script,$noscript,
+ $target,$meta,$head,$style,$dtd,$lang,$encoding,@other) =
+ rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG,ENCODING],@p);
+
+ $encoding = 'utf-8' unless defined $encoding;
# strangely enough, the title needs to be escaped as HTML
# while the author needs to be escaped as a URL
$xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
$xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
- push @result,q(<?xml version="1.0" encoding="utf-8"?>) if $xml_dtd;
+ push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd;
if (ref($dtd) && ref($dtd) eq 'ARRAY') {
push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
if (!$override && ($self->{'.fieldnames'}->{$name} ||
defined $self->param($name))) {
- $checked = grep($_ eq $value,$self->param($name)) ? ' checked' : '';
+ $checked = grep($_ eq $value,$self->param($name)) ? ' checked="1"' : '';
} else {
- $checked = $checked ? qq/ checked/ : '';
+ $checked = $checked ? qq/ checked="1"/ : '';
}
my($the_label) = defined $label ? $label : $name;
$name = $self->escapeHTML($name);
my($other) = @other ? " @other" : '';
foreach (@values) {
- $checked = $checked{$_} ? qq/ checked/ : '';
+ $checked = $checked{$_} ? qq/ checked="1"/ : '';
$label = '';
unless (defined($nolabels) && $nolabels) {
$label = $_;
# Escape HTML -- used internally
'escapeHTML' => <<'END_OF_FUNC',
sub escapeHTML {
+ # hack to work around earlier hacks
+ push @_,$_[0] if @_==1 && $_[0] eq 'CGI';
my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
return undef unless defined($toencode);
return $toencode if ref($self) && $self->{'dontescape'};
my($other) = @other ? " @other" : '';
foreach (@values) {
- my($checkit) = $checked eq $_ ? qq/ checked/ : '';
+ my($checkit) = $checked eq $_ ? qq/ checked="1"/ : '';
my($break);
if ($linebreak) {
$break = $XHTML ? "<br />" : "<br>";
$result = qq/<select name="$name"$other>\n/;
foreach (@values) {
- my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected/ : '' ) : '';
+ my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected="1"/ : '' ) : '';
my($label) = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
my($value) = $self->escapeHTML($_);
$result .= "<option $selectit value=\"$value\">$label</option>\n";
}
- $result .= "</select>\n";
+ $result .= "</select>";
return $result;
}
END_OF_FUNC
$size = $size || scalar(@values);
my(%selected) = $self->previous_or_default($name,$defaults,$override);
- my($is_multiple) = $multiple ? qq/ multiple/ : '';
+ my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
my($has_size) = $size ? qq/ size="$size"/: '';
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
$result = qq/<select name="$name"$has_size$is_multiple$other>\n/;
foreach (@values) {
- my($selectit) = $selected{$_} ? qq/selected/ : '';
+ my($selectit) = $selected{$_} ? qq/selected="1"/ : '';
my($label) = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label=$self->escapeHTML($label);
my($value)=$self->escapeHTML($_,1);
$result .= "<option $selectit value=\"$value\">$label</option>\n";
}
- $result .= "</select>\n";
+ $result .= "</select>";
$self->register_parameter($name);
return $result;
}
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 $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other />)
# 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);
'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
# 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);
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
####################################################################################
################################## TEMPORARY FILES #################################
####################################################################################
-package TempFile;
+package CGITempFile;
$SL = $CGI::SL;
$MAC = $CGI::OS eq 'MACINTOSH';
# cute feature, but overload implementation broke it
# %OVERLOAD = ('""'=>'as_string');
-*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+*CGITempFile::AUTOLOAD = \&CGI::AUTOLOAD;
###############################################################################
################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
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
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
-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.
print $q->start_html(-lang=>'fr-CA');
+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 <HEAD> section with the
B<-head> tag. For example, to place the rarely-used <LINK> element in the
head section, use this:
<IMG ALIGN="LEFT" SRC="fred.gif">
Sometimes an HTML tag attribute has no argument. For example, ordered
-lists can be marked as COMPACT. The syntax for this is an argument that
+lists can be marked as COMPACT. The syntax for this is an argument
that points to an undef string:
print ol({compact=>undef},li('one'),li('two'),li('three'));
Prior to CGI.pm version 2.41, providing an empty ('') string as an
attribute argument was the same as providing undef. However, this has
-changed in order to accommodate those who want to create tags of the form
+changed in order to accommodate those who want to create tags of the form
<IMG ALT="">. The difference is shown in these two pieces of code:
CODE RESULT
print;
}
+In an array context, upload() will return an array of filehandles.
+This makes it possible to create forms that use the same name for
+multiple upload fields.
+
This is the recommended idiom.
When a file is uploaded the browser usually sends along some
You are free to create a custom HTML page to complain about the error,
if you wish.
+If you are using CGI.pm on a Windows platform and find that binary
+files get slightly larger when uploaded but that text files remain the
+same, then you have forgotten to activate binary mode on the output
+filehandle. Be sure to call binmode() on any handle that you create
+to write the uploaded file to disk.
+
JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
recognized. See textfield() for details.
=head2 CREATING A STANDALONE CHECKBOX
print $query->checkbox(-name=>'checkbox_name',
- -checked=>'checked',
+ -checked=>1,
-value=>'ON',
-label=>'CLICK ME');
The second argument (-src) is also required and specifies the URL
=item 3.
-
The third option (-align, optional) is an alignment type, and may be
TOP, BOTTOM or MIDDLE
if the former is unavailable.
=item B<script_name()>
-
Return the script name as a partial URL, for self-refering
scripts.
the header() and redirect() methods are
called.
-The Microsoft Internet Information Server requires NPH mode. As of version
-2.30, CGI.pm will automatically detect when the script is running under IIS
-and put itself into this mode. You do not need to do this manually, although
-it won't hurt anything if you do.
-
-There are a number of ways to put CGI.pm into NPH mode:
+The Microsoft Internet Information Server requires NPH mode. As of
+version 2.30, CGI.pm will automatically detect when the script is
+running under IIS and put itself into this mode. You do not need to
+do this manually, although it won't hurt anything if you do. However,
+note that if you have applied Service Pack 6, much of the
+functionality of NPH scripts, including the ability to redirect while
+setting a cookie, b<do not work at all> on IIS without a special patch
+from Microsoft. See
+http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
+Non-Parsed Headers Stripped From CGI Applications That Have nph-
+Prefix in Name.
=over 4
projects / p5sagit/p5-mst-13.2.git / blobdiff