rpms/perl/F-9 perl-5.10.0-CGI-3.37.patch, NONE, 1.1 perl.spec, 1.165, 1.166

Marcela Mašláňová (mmaslano) fedora-extras-commits at redhat.com
Mon May 19 12:12:40 UTC 2008


Author: mmaslano

Update of /cvs/pkgs/rpms/perl/F-9
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv26670

Modified Files:
	perl.spec 
Added Files:
	perl-5.10.0-CGI-3.37.patch 
Log Message:
447142 CGI update for bugzilla package.


perl-5.10.0-CGI-3.37.patch:

--- NEW FILE perl-5.10.0-CGI-3.37.patch ---
diff -up perl-5.10.0/lib/CGI/Apache.pm.eee perl-5.10.0/lib/CGI/Apache.pm
diff -up perl-5.10.0/lib/CGI/Carp.pm.eee perl-5.10.0/lib/CGI/Carp.pm
--- perl-5.10.0/lib/CGI/Carp.pm.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Carp.pm	2008-03-27 15:23:36.000000000 +0100
@@ -323,7 +323,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION     = '1.29';
+$CGI::Carp::VERSION     = '1.30_01';
 $CGI::Carp::CUSTOM_MSG  = undef;
 $CGI::Carp::DIE_HANDLER = undef;
 
@@ -575,6 +575,7 @@ END
         print STDOUT $mess;
     }
     else {
+        print STDOUT "Status: 500\n";
         print STDOUT "Content-type: text/html\n\n";
         print STDOUT $mess;
     }
diff -up perl-5.10.0/lib/CGI/Changes.eee perl-5.10.0/lib/CGI/Changes
--- perl-5.10.0/lib/CGI/Changes.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Changes	2008-04-23 15:08:05.000000000 +0200
@@ -1,3 +1,35 @@
+  Version 3.37
+  1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761)
+  2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt
+     who reported and fixed the problem.
+
+  Version 3.36
+  1. Fix CGI::Cookie to support cookies that are separated by "," instead of ";".
+
+  Version 3.35
+  1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in uploaded filenames.
+
+  Version 3.34
+  1. Handle Unicode %uXXXX  escapes properly -- patch from DANKOGAI at cpan.org
+  2. Fix url() method to not choke on path names that contain regex characters.
+
+  Version 3.33
+  1. Remove uninit variable warning when calling url(-relative=>1)
+  2. Fix uninit variable warnings for two lc calls
+  3. Fixed failure of tempfile upload due to sprintf() taint failure in perl 5.10
+
+  Version 3.32
+  1. Patch from Miguel Santinho to prevent sending premature headers under mod_perl 2.0
+
+  Version 3.31
+  1. Patch from Xavier Robin so that CGI::Carp issues a 500 Status code rather than a 200 status code.
+  2. Patch from Alexander Klink to select correct temporary directory in OSX Leopard so that upload works.
+  3. Possibly fixed "wrapped pack" error on 5.10 and higher.
+
+  Version 3.30
+  1. Patch from Mike Barry to handle POSTDATA in the same way as PUT.
+  2. Patch from Rafael Garcia-Suarez to correctly reencode unicode values as byte values.
+
   Version 3.29
   1. The position of file handles is now reset to zero when CGI->new is called.
     (Mark Stosberg)
diff -up perl-5.10.0/lib/CGI/Cookie.pm.eee perl-5.10.0/lib/CGI/Cookie.pm
--- perl-5.10.0/lib/CGI/Cookie.pm.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Cookie.pm	2008-03-28 18:15:51.000000000 +0100
@@ -13,7 +13,7 @@ package CGI::Cookie;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.28';
+$CGI::Cookie::VERSION='1.29';
 
 use CGI::Util qw(rearrange unescape escape);
 use CGI;
@@ -51,7 +51,7 @@ sub fetch {
    my %results;
    my($key,$value);
    
-   my(@pairs) = split("[;,] ?",$raw_cookie);
+   my @pairs = split("[;,] ?",$raw_cookie);
    foreach (@pairs) {
      s/\s*(.*?)\s*/$1/;
      if (/^([^=]+)=(.*)/) {
@@ -88,7 +88,7 @@ sub parse {
   my ($self,$raw_cookie) = @_;
   my %results;
 
-  my(@pairs) = split("; ?",$raw_cookie);
+  my @pairs = split("[;,] ?",$raw_cookie);
   foreach (@pairs) {
     s/\s*(.*?)\s*/$1/;
     my($key,$value) = split("=",$_,2);
diff -up perl-5.10.0/lib/CGI/Fast.pm.eee perl-5.10.0/lib/CGI/Fast.pm
--- perl-5.10.0/lib/CGI/Fast.pm.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Fast.pm	2008-04-14 19:53:12.000000000 +0200
@@ -55,6 +55,7 @@ sub new {
      }
      }
      CGI->_reset_globals;
+     $self->_setup_symbols(@SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
      return $CGI::Q = $self->SUPER::new($initializer, @param);
 }
 
diff -up perl-5.10.0/lib/CGI.pm.eee perl-5.10.0/lib/CGI.pm
--- perl-5.10.0/lib/CGI.pm.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI.pm	2008-04-23 15:08:23.000000000 +0200
@@ -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.234 2007/04/16 16:58:46 lstein Exp $';
-$CGI::VERSION='3.29';
+$CGI::revision = '$Id: CGI.pm,v 1.251 2008/04/23 13:08:23 lstein Exp $';
+$CGI::VERSION='3.37';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -37,7 +37,12 @@ use constant XHTML_DTD => ['-//W3C//DTD 
   $TAINTED = substr("$0$^X",0,0);
 }
 
-$MOD_PERL = 0; # no mod_perl by default
+$MOD_PERL            = 0; # no mod_perl by default
+
+#global settings
+$POST_MAX            = -1; # no limit to uploaded files
+$DISABLE_UPLOADS     = 0;
+
 @SAVED_SYMBOLS = ();
 
 
@@ -91,13 +96,6 @@ sub initialize_globals {
     # it can just be renamed, instead of read and written.
     $CLOSE_UPLOAD_FILES = 0;
 
-    # Set this to a positive value to limit the size of a POSTing
-    # to a certain number of bytes:
-    $POST_MAX = -1;
-
-    # Change this to 1 to disable uploads entirely:
-    $DISABLE_UPLOADS = 0;
-
     # Automatically determined -- don't change
     $EBCDIC = 0;
 
@@ -111,6 +109,9 @@ sub initialize_globals {
     # use CGI qw(-no_undef_params);
     $NO_UNDEF_PARAMS = 0;
 
+    # return everything as utf-8
+    $PARAM_UTF8      = 0;
+
     # Other globals that you shouldn't worry about.
     undef $Q;
     $BEEN_THERE = 0;
@@ -352,6 +353,7 @@ sub new {
       $self->r(Apache->request) unless $self->r;
       my $r = $self->r;
       $r->register_cleanup(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     else {
       # XXX: once we have the new API
@@ -360,6 +362,7 @@ sub new {
       my $r = $self->r;
       $r->subprocess_env unless exists $ENV{REQUEST_METHOD};
       $r->pool->cleanup_register(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     undef $NPH;
   }
@@ -445,15 +448,14 @@ sub param {
 
     return unless defined($name) && $self->{$name};
 
-    my $charset = $self->charset || '';
-    my $utf8    = $charset eq 'utf-8';
-    if ($utf8) {
-      eval "require Encode; 1;" if $utf8 && !Encode->can('decode'); # bring in these functions
-      return wantarray ? map {Encode::decode(utf8=>$_) } @{$self->{$name}} 
-                       : Encode::decode(utf8=>$self->{$name}->[0]);
-    } else {
-      return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+    my @result = @{$self->{$name}};
+
+    if ($PARAM_UTF8) {
+      eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions
+      @result = map {ref $_ ? $_ : Encode::decode(utf8=>$_) } @result;
     }
+
+    return wantarray ?  @result : $result[0];
 }
 
 sub self_or_default {
@@ -641,7 +643,7 @@ sub init {
 	  last METHOD;
       }
 
-      if ($meth eq 'POST') {
+      if ($meth eq 'POST' || $meth eq 'PUT') {
 	  $self->read_from_client(\$query_string,$content_length,0)
 	      if $content_length > 0;
 	  # Some people want to have their cake and eat it too!
@@ -667,11 +669,11 @@ sub init {
   }
 
 # YL: Begin Change for XML handler 10/19/2001
-    if (!$is_xforms && $meth eq 'POST'
+    if (!$is_xforms && ($meth eq 'POST' || $meth eq 'PUT')
         && defined($ENV{'CONTENT_TYPE'})
         && $ENV{'CONTENT_TYPE'} !~ m|^application/x-www-form-urlencoded|
 	&& $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) {
-        my($param) = 'POSTDATA' ;
+        my($param) = $meth . 'DATA' ;
         $self->add_parameter($param) ;
       push (@{$self->{$param}},$query_string);
       undef $query_string ;
@@ -904,6 +906,7 @@ sub _setup_symbols {
 	$DEBUG=0,                next if /^[:-]no_?[Dd]ebug$/;
 	$DEBUG=2,                next if /^[:-][Dd]ebug$/;
 	$USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
+	$PARAM_UTF8++,           next if /^[:-]utf8$/;
 	$XHTML++,                next if /^[:-]xhtml$/;
 	$XHTML=0,                next if /^[:-]no_?xhtml$/;
 	$USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
@@ -1519,7 +1522,7 @@ sub header {
     push(@header,map {ucfirst $_} @other);
     push(@header,"Content-Type: $type") if $type ne '';
     my $header = join($CRLF, at header)."${CRLF}${CRLF}";
-    if ($MOD_PERL and not $nph) {
+    if (($MOD_PERL >= 1) && !$nph) {
         $self->r->send_cgi_header($header);
         return '';
     }
@@ -1699,6 +1702,7 @@ sub _style {
     my $cdata_end   = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
 
     my @s = ref($style) eq 'ARRAY' ? @$style : $style;
+    my $other = '';
 
     for my $s (@s) {
       if (ref($s)) {
@@ -1708,7 +1712,7 @@ sub _style {
                        ref($s) eq 'ARRAY' ? @$s : %$s));
        my $type = defined $stype ? $stype : 'text/css';
        my $rel  = $alternate ? 'alternate stylesheet' : 'stylesheet';
-       my $other = @other ? join ' ', at other : '';
+       $other = "@other" if @other;
 
        if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference
        { # If it is, push a LINK tag for each one
@@ -1831,7 +1835,7 @@ sub startform {
     my($method,$action,$enctype, at other) = 
 	rearrange([METHOD,ACTION,ENCTYPE], at p);
 
-    $method  = $self->escapeHTML(lc($method) || 'post');
+    $method  = $self->escapeHTML(lc($method || 'post'));
     $enctype = $self->escapeHTML($enctype || &URL_ENCODED);
     if (defined $action) {
        $action = $self->escapeHTML($action);
@@ -2147,8 +2151,9 @@ END_OF_FUNC
 sub checkbox {
     my($self, at p) = self_or_default(@_);
 
-    my($name,$checked,$value,$label,$override,$tabindex, at other) = 
-	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX], at p);
+    my($name,$checked,$value,$label,$labelattributes,$override,$tabindex, at other) =
+       rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,LABELATTRIBUTES,
+                   [OVERRIDE,FORCE],TABINDEX], at p);
 
     $value = defined $value ? $value : 'on';
 
@@ -2165,7 +2170,8 @@ sub checkbox {
     my($other) = @other ? "@other " : '';
     $tabindex = $self->element_tab($tabindex);
     $self->register_parameter($name);
-    return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
+    return $XHTML ? CGI::label($labelattributes,
+                    qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
                   : qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
 }
 END_OF_FUNC
@@ -2192,9 +2198,11 @@ sub escapeHTML {
          else {
 	     $toencode =~ s{"}{"}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{'}{'}gso;
                 $toencode =~ s{\x8b}{‹}gso;
                 $toencode =~ s{\x9b}{›}gso;
@@ -2327,13 +2335,14 @@ sub _box_group {
     my $self     = shift;
     my $box_type = shift;
 
-    my($name,$values,$defaults,$linebreak,$labels,$attributes,
-       $rows,$columns,$rowheaders,$colheaders,
+    my($name,$values,$defaults,$linebreak,$labels,$labelattributes,
+       $attributes,$rows,$columns,$rowheaders,$colheaders,
        $override,$nolabels,$tabindex,$disabled, at other) =
-       rearrange([      NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES,
-		        ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],
-			[OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED
-                 ], at _);
+        rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,LABELATTRIBUTES,
+                       ATTRIBUTES,ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],
+                       [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED
+                  ], at _);
+
 
     my($result,$checked, at elements, at values);
 
@@ -2393,7 +2402,7 @@ sub _box_group {
 
         if ($XHTML) {
            push @elements,
-              CGI::label(
+              CGI::label($labelattributes,
                    qq(<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs$disable/>$label)).${break};
         } else {
             push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs$disable>${label}${break}/);
@@ -2560,6 +2569,7 @@ sub scrolling_list {
     $size = $size || scalar(@values);
 
     my(%selected) = $self->previous_or_default($name,$defaults,$override);
+
     my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
@@ -2692,7 +2702,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;
@@ -2723,6 +2733,7 @@ sub url {
 
     $url .= $path         if $path_info and defined $path;
     $url .= "?$query_str" if $query     and $query_str ne '';
+    $url ||= '';
     $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
     return $url;
 }
@@ -3284,10 +3295,10 @@ sub previous_or_default {
 
     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);
     }
@@ -3371,8 +3382,12 @@ sub read_multipart {
 	my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
         $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/ ) ?
@@ -3431,7 +3446,7 @@ sub read_multipart {
 
 	  my ($data);
 	  local($\) = '';
-          my $totalbytes;
+          my $totalbytes = 0;
           while (defined($data = $buffer->read)) {
               if (defined $self->{'.upload_hook'})
                {
@@ -3696,7 +3711,7 @@ sub new {
     (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
     my $fv = ++$FH . $safename;
     my $ref = \*{"Fh::$fv"};
-    $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+    $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$! || return;
     my $safe = $1;
     sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($safe) if $delete;
@@ -3768,7 +3783,7 @@ sub new {
     }
 
     my $self = {LENGTH=>$length,
-		CHUNKED=>!defined $length,
+		CHUNKED=>!$length,
 		BOUNDARY=>$boundary,
 		INTERFACE=>$interface,
 		BUFFER=>'',
@@ -4032,10 +4047,10 @@ sub new {
     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_ \'\":/.\$\\-]+)$!;
+    return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$!;
     # this used to untaint, now it doesn't
     # $filename = $1;
     return bless \$filename;
@@ -4109,6 +4124,8 @@ CGI - Simple Common Gateway Interface Cl
 	     hr;
    }
 
+   print end_html;
+
 =head1 ABSTRACT
 
 This perl library uses perl5 objects to make it easy to create Web
@@ -4477,6 +4494,10 @@ it, use code like this:
 
    my $data = $query->param('POSTDATA');
 
+Likewise if PUTed data can be retrieved with code like this:
+
+   my $data = $query->param('PUTDATA');
+
 (If you don't know what the preceding means, don't worry about it.  It
 only affects people trying to use CGI for XML processing and other
 specialized tasks.)
@@ -4812,6 +4833,16 @@ If start_html()'s -dtd parameter specifi
 XHTML will automatically be disabled without needing to use this 
 pragma.
 
+=item -utf8
+
+This makes CGI.pm treat all parameters as UTF-8 strings. Use this with
+care, as it will interfere with the processing of binary uploads. It
+is better to manually select which fields are expected to return utf-8
+strings and convert them using code like this:
+
+ use Encode;
+ my $arg = decode utf8=>param('foo');
+
 =item -nph
 
 This makes CGI.pm produce a header appropriate for an NPH (no
@@ -5388,7 +5419,7 @@ Generate just the protocol and net locat
 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.
@@ -6389,6 +6420,9 @@ are the tab indexes of each button.  Exa
   -tabindex => ['moe','minie','eenie','meenie']  # tab in this order
   -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
 
+The optional B<-labelattributes> argument will contain attributes
+attached to the <label> element that surrounds each button.
+
 When the form is processed, all checked boxes will be returned as
 a list under the parameter name 'group_name'.  The values of the
 "on" checkboxes can be retrieved with:
@@ -6546,6 +6580,9 @@ an associative array relating menu value
 with the attribute's name as the key and the attribute's value as the
 value.
 
+The optional B<-labelattributes> argument will contain attributes
+attached to the <label> element that surrounds each button.
+
 When the form is processed, the selected radio button can
 be retrieved using:
 
@@ -7658,10 +7695,8 @@ of CGI.pm without rewriting your old scr
 
 =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 at cshl.org.  When sending
 bug reports, please provide the version of CGI.pm, the version of
diff -up perl-5.10.0/lib/CGI/Pretty.pm.eee perl-5.10.0/lib/CGI/Pretty.pm
diff -up perl-5.10.0/lib/CGI/Push.pm.eee perl-5.10.0/lib/CGI/Push.pm
diff -up perl-5.10.0/lib/CGI/Switch.pm.eee perl-5.10.0/lib/CGI/Switch.pm
diff -up perl-5.10.0/lib/CGI/t/apache.t.eee perl-5.10.0/lib/CGI/t/apache.t
diff -up perl-5.10.0/lib/CGI/t/can.t.eee perl-5.10.0/lib/CGI/t/can.t
diff -up perl-5.10.0/lib/CGI/t/carp.t.eee perl-5.10.0/lib/CGI/t/carp.t
diff -up perl-5.10.0/lib/CGI/t/cookie.t.eee perl-5.10.0/lib/CGI/t/cookie.t
diff -up perl-5.10.0/lib/CGI/t/fast.t.eee perl-5.10.0/lib/CGI/t/fast.t
diff -up perl-5.10.0/lib/CGI/t/form.t.eee perl-5.10.0/lib/CGI/t/form.t
diff -up perl-5.10.0/lib/CGI/t/function.t.eee perl-5.10.0/lib/CGI/t/function.t
diff -up perl-5.10.0/lib/CGI/t/html.t.eee perl-5.10.0/lib/CGI/t/html.t
diff -up perl-5.10.0/lib/CGI/t/no_tabindex.t.eee perl-5.10.0/lib/CGI/t/no_tabindex.t
diff -up perl-5.10.0/lib/CGI/t/pretty.t.eee perl-5.10.0/lib/CGI/t/pretty.t
diff -up perl-5.10.0/lib/CGI/t/push.t.eee perl-5.10.0/lib/CGI/t/push.t
diff -up perl-5.10.0/lib/CGI/t/request.t.eee perl-5.10.0/lib/CGI/t/request.t
diff -up perl-5.10.0/lib/CGI/t/start_end_asterisk.t.eee perl-5.10.0/lib/CGI/t/start_end_asterisk.t
diff -up perl-5.10.0/lib/CGI/t/start_end_end.t.eee perl-5.10.0/lib/CGI/t/start_end_end.t
diff -up perl-5.10.0/lib/CGI/t/start_end_start.t.eee perl-5.10.0/lib/CGI/t/start_end_start.t
diff -up perl-5.10.0/lib/CGI/t/switch.t.eee perl-5.10.0/lib/CGI/t/switch.t
diff -up perl-5.10.0/lib/CGI/t/util-58.t.eee perl-5.10.0/lib/CGI/t/util-58.t
--- perl-5.10.0/lib/CGI/t/util-58.t.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/t/util-58.t	2003-04-14 20:32:22.000000000 +0200
@@ -11,11 +11,6 @@ BEGIN {
 use Test::More tests => 2;
 use_ok("CGI::Util");
 my $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
-if (ord('A') == 193) { # EBCDIC.
-    is(CGI::Util::escape($uri), "%FC%C3%A0%EE%F9%E5%E7%F8%20%FC%C3%C7%CA.txt",
-       "# Escape string with UTF-8 (UTF-EBCDIC) flag");
-} else {
-    is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
-       "# Escape string with UTF-8 flag");
-}
+is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
+   "# Escape string with UTF-8 flag");
 __END__
diff -up perl-5.10.0/lib/CGI/t/util.t.eee perl-5.10.0/lib/CGI/t/util.t
diff -up perl-5.10.0/lib/CGI/Util.pm.eee perl-5.10.0/lib/CGI/Util.pm
--- perl-5.10.0/lib/CGI/Util.pm.eee	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Util.pm	2008-03-14 15:25:54.000000000 +0100
@@ -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,8 +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 = pack("C*", unpack("U0C*", $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 {


Index: perl.spec
===================================================================
RCS file: /cvs/pkgs/rpms/perl/F-9/perl.spec,v
retrieving revision 1.165
retrieving revision 1.166
diff -u -r1.165 -r1.166
--- perl.spec	17 May 2008 20:25:51 -0000	1.165
+++ perl.spec	19 May 2008 12:11:55 -0000	1.166
@@ -16,7 +16,7 @@
 
 Name:           perl
 Version:        %{perl_version}
-Release:        21%{?dist}
+Release:        22%{?dist}
 Epoch:          %{perl_epoch}
 Summary:        The Perl programming language
 Group:          Development/Languages
@@ -71,15 +71,15 @@
 # Upgrade Module::CoreList to 2.14
 Patch13:	perl-5.10.0-Module-CoreList2.14.patch
 
+# Upgrade CGI to 3.37 for bugzilla package
+Patch14:	perl-5.10.0-CGI-3.37.patch
+
 BuildRoot:      %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
 BuildRequires:  tcsh, dos2unix, man, groff
 BuildRequires:  gdbm-devel, db4-devel, zlib-devel
 # For tests
 BuildRequires:  procps, rsyslog
 
-# Temporary fix for broken buildroots:
-BuildRequires:  gawk
-
 # The long line of Perl provides.
 
 # These provides are needed by the perl pkg itself with auto-generated perl.req
@@ -790,6 +790,7 @@
 %patch11 -p1
 %patch12 -p1
 %patch13 -p1
+%patch14 -p1
 
 #
 # Candidates for doc recoding (need case by case review):
@@ -1008,6 +1009,7 @@
 perl -x patchlevel.h '32891 fix big slowdown in 5.10 @_ parameter passing'
 perl -x patchlevel.h 'Fedora Patch12: Update Module::Load::Conditional to 0.24'
 perl -x patchlevel.h 'Fedora Patch13: Upgrade Module::CoreList to 2.14'
+perl -x patchlevel.h 'Fedora Patch14: Upgrade CGI to 3.37'
 
 %clean
 rm -rf $RPM_BUILD_ROOT
@@ -1613,6 +1615,9 @@
 
 # Old changelog entries are preserved in CVS.
 %changelog
+* Mon May 19 2008 Marcela Maslanova <mmaslano at redhat.com> 4:5.10.0-22
+- 447142 upgrade CGI to 3.37
+
 * Sat May 17 2008 Tom "spot" Callaway <tcallawa at redhat.com> 4:5.10.0-21
 - sparc64 fails two tests under mysterious circumstances. we need to get the
   rest of the tree moving, so we temporarily disable the tests on that arch.




More information about the fedora-extras-commits mailing list