X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCGI.pm;h=9f65f7d02b480357c3282439a13cf61ff3b40227;hb=cc83745da206d409d7227df077f422fd9ecbe680;hp=a30bb9ef0acd87b88c22414455fb36681bc5674f;hpb=1c87da1da4f953d5e3fa74ec3075ddaf999e9d1e;p=p5sagit%2Fp5-mst-13.2.git
diff --git a/lib/CGI.pm b/lib/CGI.pm
index a30bb9e..9f65f7d 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,8 +18,8 @@ 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.125 2003/06/16 18:54:19 lstein Exp $';
-$CGI::VERSION='2.97';
+$CGI::revision = '$Id: CGI.pm,v 1.130 2003/08/01 14:39:17 lstein Exp $ + patches by merlyn';
+$CGI::VERSION='3.00';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1145,7 +1145,7 @@ sub Dump {
push(@result,"
");
foreach $value ($self->param($param)) {
$value = $self->escapeHTML($value);
- $value =~ s/\n/
\n/g;
+ $value =~ s/\n/
\n/g;
push(@result,"- $value
");
}
push(@result,"
");
@@ -1571,17 +1571,21 @@ sub _script {
$comment = '#' if $type=~/perl|tcl/i;
$comment = "'" if $type=~/vbscript/i;
- my $cdata_start = "\n\n";
-
- my(@satts);
- push(@satts,'src'=>$src) if $src;
- push(@satts,'language'=>$language) unless defined $type;
- push(@satts,'type'=>$type);
- $code = "$cdata_start$code$cdata_end" if defined $code;
- push(@result,script({@satts},$code || ''));
+ my ($cdata_start,$cdata_end);
+ if ($XHTML) {
+ $cdata_start = "$comment";
+ } else {
+ $cdata_start = "\n\n";
+ }
+ my(@satts);
+ push(@satts,'src'=>$src) if $src;
+ push(@satts,'language'=>$language) unless defined $type;
+ push(@satts,'type'=>$type);
+ $code = "$cdata_start$code$cdata_end" if defined $code;
+ push(@result,script({@satts},$code || ''));
}
@result;
}
@@ -1635,12 +1639,11 @@ sub startform {
$method = lc($method) || 'post';
$enctype = $enctype || &URL_ENCODED;
unless (defined $action) {
- $action = $self->url(-absolute=>1,-path=>1);
+ $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1));
if (length($ENV{QUERY_STRING})>0) {
- $action .= "?$ENV{QUERY_STRING}";
+ $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1);
}
}
- $action =~ s/\"/%22/g; # fix cross-site scripting bug reported by obscure
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
@@ -3580,10 +3583,12 @@ END_OF_AUTOLOAD
####################################################################################
package CGITempFile;
-$SL = $CGI::SL;
-$MAC = $CGI::OS eq 'MACINTOSH';
-my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
-unless ($TMPDIRECTORY) {
+sub find_tempdir {
+ undef $TMPDIRECTORY;
+ $SL = $CGI::SL;
+ $MAC = $CGI::OS eq 'MACINTOSH';
+ my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
+ unless ($TMPDIRECTORY) {
@TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
"C:${SL}temp","${SL}tmp","${SL}temp",
"${vol}${SL}Temporary Items",
@@ -3601,11 +3606,14 @@ unless ($TMPDIRECTORY) {
# unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
foreach (@TEMP) {
- do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
+ do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
}
+ }
+ $TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY;
}
-$TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY;
+find_tempdir();
+
$MAXTRIES = 5000;
# cute feature, but overload implementation broke it
@@ -3630,6 +3638,7 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
sub new {
my($package,$sequence) = @_;
my $filename;
+ find_tempdir() unless -w $TMPDIRECTORY;
for (my $i = 0; $i < $MAXTRIES; $i++) {
last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
}
@@ -4638,7 +4647,7 @@ You can also use named arguments:
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
-to use with certain servers, such as Microsoft Internet Explorer, which
+to use with certain servers, such as Microsoft IIS, which
expect all their scripts to be NPH.
=head2 CREATING THE HTML DOCUMENT HEADER
@@ -4937,7 +4946,7 @@ Generate just the protocol and net location, as in http://www.foo.com:8000
=head2 MIXING POST AND URL PARAMETERS
- $color = $query->url_param('color');
+ $color = $query->url_param('color');
It is possible for a script to receive CGI parameters in the URL as
well as in the fill-out form by creating a form that POSTs to a URL
@@ -5692,6 +5701,8 @@ a pointer to an associative array relating menu values to another
associative array with the attribute's name as the key and the
attribute's value as the value.
+=back
+
=head2 CREATING A SCROLLING LIST
print $query->scrolling_list('list_name',