X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCGI.pm;h=a53fbb51444b8cb95fd133bd0c5123eb0b23cf1d;hb=fd20da51661b685c54940aeb116a97beabf44d0f;hp=1c9d2d466121ac16dd9129b11fa1fa3c06baed7e;hpb=ba05675547134d242d93611530d62f98d944bc27;p=p5sagit%2Fp5-mst-13.2.git
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 1c9d2d4..a53fbb5 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,22 +18,25 @@ use Carp 'croak';
# 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.62 2002/04/10 19:36:01 lstein Exp $';
+$CGI::VERSION='2.81';
# 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',
- 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd'];
+#use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
+# 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd'];
+
+use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN',
+ 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'];
# >>>>> Here are some globals that you might want to adjust <<<<<<
sub initialize_globals {
# Set this to 1 to enable copious autoloader debugging messages
$AUTOLOAD_DEBUG = 0;
-
+
# Set this to 1 to generate XTML-compatible output
$XHTML = 1;
@@ -82,6 +85,10 @@ sub initialize_globals {
# 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;
@@ -136,8 +143,8 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
# 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
@@ -184,6 +191,9 @@ if ($needs_binmode) {
input Select option comment charset escapeHTML/],
':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
embed basefont style span layer ilayer font frameset frame script small big/],
+ ':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe
+ ins label legend noframes noscript object optgroup Q
+ thead tbody tfoot/],
':netscape'=>[qw/blink fontsize center/],
':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
submit reset defaults radio_group popup_menu button autoEscape
@@ -199,10 +209,10 @@ if ($needs_binmode) {
':ssl' => [qw/https/],
':imagemap' => [qw/Area Map/],
':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/],
- ':html' => [qw/:html2 :html3 :netscape/],
- ':standard' => [qw/:html2 :html3 :form :cgi/],
+ ':html' => [qw/:html2 :html3 :html4 :netscape/],
+ ':standard' => [qw/:html2 :html3 :html4 :form :cgi/],
':push' => [qw/multipart_init multipart_start multipart_end multipart_final/],
- ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
+ ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/]
);
# to import symbols into caller
@@ -210,8 +220,8 @@ sub import {
my $self = shift;
# This causes modules to clash.
-# undef %EXPORT_OK;
-# undef %EXPORT;
+ undef %EXPORT_OK;
+ undef %EXPORT;
$self->_setup_symbols(@_);
my ($callpack, $callfile, $callline) = caller;
@@ -542,6 +552,8 @@ sub parse_params {
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
+ next unless defined $param;
+ next if $NO_UNDEF_PARAMS and not defined $value;
$value = '' unless defined $value;
$param = unescape($param);
$value = unescape($value);
@@ -647,11 +659,29 @@ sub _compile {
return "$pack\:\:$func_name";
}
+sub _selected {
+ my $self = shift;
+ my $value = shift;
+ return '' unless $value;
+ return $XHTML ? qq( selected="selected") : qq( selected);
+}
+
+sub _checked {
+ my $self = shift;
+ my $value = shift;
+ return '' unless $value;
+ return $XHTML ? qq( checked="checked") : qq( checked);
+}
+
sub _reset_globals { initialize_globals(); }
sub _setup_symbols {
my $self = shift;
my $compile = 0;
+
+ # to avoid reexporting unwanted variables
+ undef %EXPORT;
+
foreach (@_) {
$HEADERS_ONCE++, next if /^[:-]unique_headers$/;
$NPH++, next if /^[:-]nph$/;
@@ -665,6 +695,7 @@ sub _setup_symbols {
$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$/) {
@@ -1015,20 +1046,20 @@ END_OF_FUNC
sub Dump {
my($self) = self_or_default(@_);
my($param,$value,@result);
- return '
' unless $self->param;
- push(@result,"");
+ return '' unless $self->param;
+ push(@result,"");
foreach $param ($self->param) {
my($name)=$self->escapeHTML($param);
- push(@result,"- $param");
- push(@result,"
");
+ push(@result,"- $param");
+ push(@result,"
");
foreach $value ($self->param($param)) {
$value = $self->escapeHTML($value);
- $value =~ s/\n/
\n/g;
- push(@result,"- $value");
+ $value =~ s/\n/
\n/g;
+ push(@result," - $value");
}
- push(@result,"
");
+ push(@result,"
");
}
- push(@result,"
\n");
+ push(@result,"
");
return join("\n",@result);
}
END_OF_FUNC
@@ -1197,6 +1228,7 @@ sub header {
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);
@@ -1225,7 +1257,7 @@ sub header {
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}";
@@ -1291,17 +1323,20 @@ END_OF_FUNC
# $script -> (option) Javascript code (-script)
# $no_script -> (option) Javascript