[P5P] [PATCH] Fix uc/lc warnings in CGI.pm

Thanks, applied as change #33094 to bleadperl.

Applied to version 3.33

Lincoln

I see the appended differences between release 3.33 and blead.

I don't understand why there are the differences on $CGI::revision

Next two hunks are this uc/lc change.

Next hunk is

http://public.activestate.com/cgi-bin/perlbrowse/p/32883

Silence new warning grep in void context warning in various modules and test files, also silence a warning that came from a previous 'dev' version number bump.

except that we took that warning out again, so should blead revert that
change, or is it a useful piece of refactoring? Or does CGI.pm need to work
on 5.004_04 and earlier, so that for statement modifier has to go?
IIRC map in void context is optimised to throw the results away, but is grep?

Next hunk is ancient!

http://public.activestate.com/cgi-bin/perlbrowse/p/32683

Subject: [perl #37607] CGI file upload file name parsing errors
From: aspa@merlot.kronodoc.fi (Marko Asplund)
Date: Fri, 4 Nov 2005 13:40:05 +0200 (EET)
Message-ID: <5.8.7_13518_1131102897@merlot.kronodoc.fi>


Could that get into 3.34?

Next hunk is

http://public.activestate.com/cgi-bin/perlbrowse/p/33143

Subject: Re: [perl #50322] CGITempFile causes "Insecure dependency in sprintf" in perl 5.10.0
From: "Steffen Mueller via RT" <perlbug-followup@perl.org>
Date: Mon, 28 Jan 2008 05:16:19 -0800
Message-ID: <rt-3.6.HEAD-4355-1201526176-323.50322-94-0@perl.org>

Fixes [perl #50322]

Last two hunks are from

http://public.activestate.com/cgi-bin/perlbrowse/p/33129

Assorted POD nits from the Debian bug list.


Would it be possible to get CGI.pm and blead back in sync soon? Are all our
changes acceptable to you?

Nicholas Clark


--- CGI.pm-3.33/CGI.pm Thu Jan 3 15:01:27 2008
+++ perl/lib/CGI.pm Thu Jan 31 09:12:50 2008
@@ -18,8 +18,10 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/

-$CGI::revision = '$Id: CGI.pm,v 1.241 2007/12/27 18:37:43 lstein Exp $';
-$CGI::VERSION='3.33';
+$CGI::revision = '$Id: CGI.pm,v 1.240 2007/11/30 18:58:27 lstein Exp $';
+$CGI::VERSION='3.33_03';
+$CGI::VERSION=eval $CGI::VERSION;
+

# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1835,7 +1837,7 @@
my($method,$action,$enctype,@other) =
rearrange([METHOD,ACTION,ENCTYPE],@p);

- $method = $self->escapeHTML(lc($method) || 'post');
+ $method = $self->escapeHTML(($method) ? lc($method) : 'post');
$enctype = $self->escapeHTML($enctype || &URL_ENCODED);
if (defined $action) {
$action = $self->escapeHTML($action);
@@ -2198,9 +2200,11 @@
else {
$toencode =~ s{"}{&quot;}gso;
}
- my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' ||
- uc $self->{'.charset'} eq 'WINDOWS-1252';
- if ($latin) { # bug in some browsers
+ # Handle bug in some browsers with Latin charsets
+ if ($self->{'.charset'} &&
+ (uc($self->{'.charset'}) eq 'ISO-8859-1' ||
+ uc($self->{'.charset'}) eq 'WINDOWS-1252'))
+ {
$toencode =~ s{'}{&#39;}gso;
$toencode =~ s{\x8b}{&#8249;}gso;
$toencode =~ s{\x9b}{&#8250;}gso;
@@ -3292,10 +3296,10 @@

if (!$override && ($self->{'.fieldnames'}->{$name} ||
defined($self->param($name)) ) ) {
- grep($selected{$_}++,$self->param($name));
+ $selected{$_}++ for $self->param($name);
} elsif (defined($defaults) && ref($defaults) &&
(ref($defaults) eq 'ARRAY')) {
- grep($selected{$_}++,@{$defaults});
+ $selected{$_}++ for @{$defaults};
} else {
$selected{$defaults}++ if defined($defaults);
}
@@ -3380,7 +3384,11 @@
$param .= $TAINTED;

# Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
+ # See RFC 1867, 2183, 2045
+ # NB: File content will be loaded into memory should
+ # content-disposition parsing fail.
+ my ($filename) = $header{'Content-Disposition'}=~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+ $filename =~ s/^"([^"]*)"$/$1/;
# Test for Opera's multiple upload feature
my($multipart) = ( defined( $header{'Content-Type'} ) &&
$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -4040,7 +4048,7 @@
my $filename;
find_tempdir() unless -w $TMPDIRECTORY;
for (my $i = 0; $i < $MAXTRIES; $i++) {
- last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
+ last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d",$TMPDIRECTORY,$sequence++));
}
# check that it is a more-or-less valid filename
return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$!;
@@ -4117,6 +4125,8 @@
hr;
}

+ print end_html;
+
=head1 ABSTRACT

This perl library uses perl5 objects to make it easy to create Web
@@ -5410,7 +5420,7 @@
If Apache's mod_rewrite is turned on, then the script name and path
info probably won't match the request that the user sent. Set
-rewrite=>1 (default) to return URLs that match what the user sent
-(the original request URI). Set -rewrite->0 to return URLs that match
+(the original request URI). Set -rewrite=>0 to return URLs that match
the URL after mod_rewrite's rules have run. Because the additional
path information only makes sense in the context of the rewritten URL,
-rewrite is set to false when you request path info in the URL.