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@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,@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 ' ',@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,@other) = 

 	rearrange([METHOD,ACTION,ENCTYPE],@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,@p) = self_or_default(@_);

-    my($name,$checked,$value,$label,$override,$tabindex,@other) = 

-	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX],@p);

+    my($name,$checked,$value,$label,$labelattributes,$override,$tabindex,@other) =

+       rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,LABELATTRIBUTES,

+                   [OVERRIDE,FORCE],TABINDEX],@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,@other) =

-       rearrange([      NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES,

-		        ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],

-			[OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED

-                 ],@_);

+        rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,LABELATTRIBUTES,

+                       ATTRIBUTES,ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],

+                       [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED

+                  ],@_);

+

     my($result,$checked,@elements,@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@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 {