Upgrade to CGI.pm-3.34. There are still a few differences, so adding

a version bump.

p4raw-id: //depot/perl@33564

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 11b10a7..fc29d67 100644 (file)
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,10 +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.240 2007/11/30 18:58:27 lstein Exp $';
-$CGI::VERSION='3.33_03';
-$CGI::VERSION=eval $CGI::VERSION;
-
+$CGI::revision = '$Id: CGI.pm,v 1.247 2008/03/14 14:29:36 lstein Exp $';
+$CGI::VERSION='3.34_01';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1837,7 +1835,7 @@ sub startform {
     my($method,$action,$enctype,@other) = 
        rearrange([METHOD,ACTION,ENCTYPE],@p);
 
-    $method  = $self->escapeHTML(($method) ? lc($method) : 'post');
+    $method  = $self->escapeHTML(lc($method || 'post'));
     $enctype = $self->escapeHTML($enctype || &URL_ENCODED);
     if (defined $action) {
        $action = $self->escapeHTML($action);
@@ -2703,7 +2701,7 @@ sub url {
     my $request_uri =  unescape($self->request_uri) || '';
     my $query_str   =  $self->query_string;
 
-    my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
+    my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/;
     undef $path if $rewrite_in_use && $rewrite;  # path not valid when rewriting active
 
     my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
@@ -4048,7 +4046,7 @@ sub new {
     my $filename;
     find_tempdir() unless -w $TMPDIRECTORY;
     for (my $i = 0; $i < $MAXTRIES; $i++) {
-       last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d",$TMPDIRECTORY,$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_\+ \'\":/.\$\\-]+)$!;
@@ -7696,10 +7694,8 @@ of CGI.pm without rewriting your old scripts from scratch.
 
 =head1 AUTHOR INFORMATION
 
-Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+The GD.pm interface is copyright 1995-2007, Lincoln D. Stein.  It is
+distributed under GPL and the Artistic License 2.0.
 
 Address bug reports and comments to: lstein@cshl.org.  When sending
 bug reports, please provide the version of CGI.pm, the version of

diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index bdf84a5..9230eb9 100644 (file)
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT_OK = qw(rearrange make_attributes unescape escape 
                expires ebcdic2ascii ascii2ebcdic);
 
-$VERSION = '1.5';
+$VERSION = '1.5_01';
 
 $EBCDIC = "\t" ne "\011";
 # (ord('^') == 95) for codepage 1047 as on os390, vmesa
@@ -141,8 +141,12 @@ sub simple_escape {
 
 sub utf8_chr {
         my $c = shift(@_);
-       return chr($c) if $] >= 5.006;
-
+       if ($] >= 5.006){
+           require utf8;
+           my $u = chr($c);
+           utf8::encode($u); # drop utf8 flag
+           return $u;
+       }
         if ($c < 0x80) {
                 return sprintf("%c", $c);
         } elsif ($c < 0x800) {
@@ -189,6 +193,17 @@ sub unescape {
     if ($EBCDIC) {
       $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
     } else {
+       # handle surrogate pairs first -- dankogai
+       $todecode =~ s{
+                       %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
+                       %u([Dd][c-fC-F][0-9a-fA-F]{2})   # lo
+                     }{
+                         utf8_chr(
+                                  0x10000 
+                                  + (hex($1) - 0xD800) * 0x400 
+                                  + (hex($2) - 0xDC00)
+                                 )
+                     }gex;
       $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
        defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
     }
@@ -200,9 +215,12 @@ sub escape {
   shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $toencode = shift;
   return undef unless defined($toencode);
+  $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
+
   # force bytes while preserving backward compatibility -- dankogai
-#  $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
-  $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
+  # but commented out because it was breaking CGI::Compress -- lstein
+  # $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
+
     if ($EBCDIC) {
       $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {