Upgrade to the CGI.pm 2.93.

(Lincoln keeps ripping out the BEGIN/PERL_CORE blocks.  Sigh.)

p4raw-id: //depot/perl@19664

17 files changed, 233 insertions, 204 deletions

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index ce9b40719f..3ae9c5be7d 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -271,7 +271,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 *CORE::GLOBAL::die = \&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.24';
+$CGI::Carp::VERSION = '1.25';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -353,30 +353,37 @@ sub _warn {
     }
 }
 
-sub ineval { 
-  (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m 
-}
-
 
 # The mod_perl package Apache::Registry loads CGI programs by calling
 # eval.  These evals don't count when looking at the stack backtrace.
 sub _longmess {
     my $message = Carp::longmess();
-    my $mod_perl = exists $ENV{MOD_PERL};
-    $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
-    return $message;    
+    $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s
+        if exists $ENV{MOD_PERL};
+    return $message;
+}
+
+sub ineval {
+  (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
 }
 
 sub die {
+  my ($arg) = @_;
   realdie @_ if ineval;
-  my ($message) = @_;
-  my $time = scalar(localtime);
-  my($file,$line,$id) = id(1);
-  $message .= " at $file line $line." unless $message=~/\n$/;
-  &fatalsToBrowser($message) if $WRAP;
-  my $stamp = stamp;
-  $message=~s/^/$stamp/gm;
-  realdie $message;
+  if (!ref($arg)) {
+    $arg = join("", @_);
+    my($file,$line,$id) = id(1);
+    $arg .= " at $file line $line." unless $arg=~/\n$/;
+    &fatalsToBrowser($arg) if $WRAP;
+    if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
+      my $stamp = stamp;
+      $arg=~s/^/$stamp/gm;
+    }
+    if ($arg !~ /\n$/) {
+      $arg .= "\n";
+    }
+  }
+  realdie $arg;
 }
 
 sub set_message {
@@ -408,58 +415,76 @@ sub warningsToBrowser {
 
 # headers
 sub fatalsToBrowser {
-    my($msg) = @_;
-    $msg=~s/&/&/g;
-    $msg=~s/>/>/g;
-    $msg=~s/</&lt;/g;
-    $msg=~s/\"/&quot;/g;
-    my($wm) = $ENV{SERVER_ADMIN} ? 
-	qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
-	"this site's webmaster";
-    my ($outer_message) = <<END;
+  my($msg) = @_;
+  $msg=~s/&/&amp;/g;
+  $msg=~s/>/&gt;/g;
+  $msg=~s/</&lt;/g;
+  $msg=~s/\"/&quot;/g;
+  my($wm) = $ENV{SERVER_ADMIN} ? 
+    qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+      "this site's webmaster";
+  my ($outer_message) = <<END;
 For help, please send mail to $wm, giving this error message 
 and the time and date of the error.
 END
-    ;
-    my $mod_perl = exists $ENV{MOD_PERL};
-    print STDOUT "Content-type: text/html\n\n" 
-	unless $mod_perl;
-
-    warningsToBrowser(1);    # emit warnings before dying
-
-    if ($CUSTOM_MSG) {
-	if (ref($CUSTOM_MSG) eq 'CODE') {
-	    &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
-	    return;
-	} else {
-	    $outer_message = $CUSTOM_MSG;
-	}
+  ;
+  my $mod_perl = exists $ENV{MOD_PERL};
+  print STDOUT "Content-type: text/html\n\n" 
+    unless $mod_perl;
+
+  warningsToBrowser(1);    # emit warnings before dying
+
+  if ($CUSTOM_MSG) {
+    if (ref($CUSTOM_MSG) eq 'CODE') {
+      &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+      return;
+    } else {
+      $outer_message = $CUSTOM_MSG;
     }
+  }
     
-    my $mess = <<END;
+  my $mess = <<END;
 <h1>Software error:</h1>
 <pre>$msg</pre>
 <p>
 $outer_message
 </p>
 END
-    ;
-
-    if ($mod_perl && (my $r = Apache->request)) {
-	# If bytes have already been sent, then
-	# we print the message out directly.
-	# Otherwise we make a custom error
-	# handler to produce the doc for us.
-	if ($r->bytes_sent) {
-	    $r->print($mess);
-	    $r->exit;
-	} else {
-	    $r->status(500);
-	    $r->custom_response(500,$mess);
-	}
+  ;
+  
+  if ($mod_perl) {
+    require mod_perl;
+    if ($mod_perl::VERSION >= 1.99) {
+      $mod_perl = 2;
+      require Apache::RequestRec;
+      require Apache::RequestIO;
+      require Apache::RequestUtil;
+      require APR::Pool;
+      require ModPerl::Util;
+      require Apache::Response;
+    }
+    my $r = Apache->request;
+    # If bytes have already been sent, then
+    # we print the message out directly.
+    # Otherwise we make a custom error
+    # handler to produce the doc for us.
+    if ($r->bytes_sent) {
+      $r->print($mess);
+      $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
     } else {
-	print STDOUT $mess;
+      # MSIE browsers don't show the $mess when sent
+      # a custom 500 response.
+      if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
+	$r->send_http_header('text/html');
+	$r->print($mess);
+	$mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
+      } else {
+	$r->custom_response(500,$mess);
+      }
     }
+  } else {
+    print STDOUT $mess;
+  }
 }
 
 # Cut and paste from CGI.pm so that we don't have the overhead of
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 7c7434c2b8..7060fb4827 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,48 +13,73 @@ 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.21';
+$CGI::Cookie::VERSION='1.24';
 
 use CGI::Util qw(rearrange unescape escape);
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
 
+# Turn on special checking for Doug MacEachern's modperl
+my $MOD_PERL = 0;
+if (exists $ENV{MOD_PERL}) {
+  eval "require mod_perl";
+  if (defined $mod_perl::VERSION) {
+    if ($mod_perl::VERSION >= 1.99) {
+      $MOD_PERL = 2;
+      require Apache::RequestUtil;
+    } else {
+      $MOD_PERL = 1;
+      require Apache;
+    }
+  }
+}
+
 # fetch a list of cookies from the environment and
 # return as a hash.  the cookies are parsed as normal
 # escaped URL data.
 sub fetch {
     my $class = shift;
-    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
-    return () unless $raw_cookie;
+    my $raw_cookie = get_raw_cookie(@_) or return;
     return $class->parse($raw_cookie);
 }
 
-# fetch a list of cookies from the environment and
-# return as a hash.  the cookie values are not unescaped
-# or altered in any way.
-sub raw_fetch {
-    my $class = shift;
-    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
-    return () unless $raw_cookie;
-    my %results;
-    my($key,$value);
-
-    my(@pairs) = split("; ?",$raw_cookie);
-    foreach (@pairs) {
-      s/\s*(.*?)\s*/$1/;
-      if (/^([^=]+)=(.*)/) {
-	$key = $1;
-	$value = $2;
-      }
-      else {
-	$key = $_;
-	$value = '';
-      }
-      $results{$key} = $value;
+# Fetch a list of cookies from the environment or the incoming headers and
+# return as a hash. The cookie values are not unescaped or altered in any way.
+ sub raw_fetch {
+   my $class = shift;
+   my $raw_cookie = get_raw_cookie(@_) or return;
+   my %results;
+   my($key,$value);
+   
+   my(@pairs) = split("; ?",$raw_cookie);
+   foreach (@pairs) {
+     s/\s*(.*?)\s*/$1/;
+     if (/^([^=]+)=(.*)/) {
+       $key = $1;
+       $value = $2;
+     }
+     else {
+       $key = $_;
+       $value = '';
+     }
+     $results{$key} = $value;
+   }
+   return \%results unless wantarray;
+   return %results;
+}
+
+sub get_raw_cookie {
+  my $r = shift;
+  $r ||= eval { Apache->request() } if $MOD_PERL;
+  if ($r) {
+    $raw_cookie = $r->headers_in->{'Cookie'};
+  } else {
+    if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
+      die "Run $r->subprocess_env; before calling fetch()";
     }
-    return \%results unless wantarray;
-    return %results;
+    $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+  }
 }
 
 
@@ -340,8 +365,6 @@ sequence:
   print "Content-Type: text/html\n\n";
 
 To send more than one cookie, create several Set-Cookie: fields.
-Alternatively, you may concatenate the cookies together with "; " and
-send them in one field.
 
 If you are using CGI.pm, you send cookies by providing a -cookie
 argument to the header() method:
@@ -351,7 +374,7 @@ argument to the header() method:
 Mod_perl users can set cookies using the request object's header_out()
 method:
 
-  $r->header_out('Set-Cookie',$c);
+  $r->headers_out->set('Set-Cookie' => $c);
 
 Internally, Cookie overloads the "" operator to call its as_string()
 method when incorporated into the HTTP header.  as_string() turns the
@@ -387,6 +410,11 @@ form using the parse() class method:
        $COOKIES = `cat /usr/tmp/Cookie_stash`;
        %cookies = parse CGI::Cookie($COOKIES);
 
+If you are in a mod_perl environment, you can save some overhead by
+passing the request object to fetch() like this:
+
+   CGI::Cookie->fetch($r);
+
 =head2 Manipulating Cookies
 
 Cookie objects have a series of accessor methods to get and set cookie
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
index f165acfaea..669b38e010 100644
--- a/lib/CGI/Fast.pm
+++ b/lib/CGI/Fast.pm
@@ -31,7 +31,7 @@ sub save_request {
     # no-op
 }
 
-# If ENV{FCGI_SOCKET_PATH} is specified, we maintain an FCGI Request handle
+# If ENV{FCGI_SOCKET_PATH} is specified, we maintain a FCGI Request handle
 # in this package variable.
 use vars qw($Ext_Request);
 BEGIN {
@@ -187,7 +187,7 @@ documentation for C<FCGI::OpenSocket> for more information.)
 =item FCGI_SOCKET_PATH
 
 The address (TCP/IP) or path (UNIX Domain) of the socket the external FastCGI
-script to which bind can listen for incoming connections from the web server.
+script to which bind an listen for incoming connections from the web server.
 
 =item FCGI_LISTEN_QUEUE
 
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index c498db5207..61aff82256 100644
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -147,7 +147,15 @@ sub new {
     my $class = shift;
     my $this = $class->SUPER::new( @_ );
 
-    Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL);
+    if ($CGI::MOD_PERL) {
+        my $r = Apache->request;
+        if ($CGI::MOD_PERL == 1) {
+            $r->register_cleanup(\&CGI::Pretty::_reset_globals);
+        }
+        else {
+            $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
+        }
+    }
     $class->_reset_globals if $CGI::PERLEX;
 
     return bless $this, $class;
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index 72d67546e6..60eeb186fe 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -199,6 +199,8 @@ sub escape {
   shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $toencode = shift;
   return undef unless defined($toencode);
+  # force bytes while preserving backward compatibility -- dankogai
+  $toencode = pack("C*", unpack("C*", $toencode));
     if ($EBCDIC) {
       $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {
diff --git a/lib/CGI/t/apache.t b/lib/CGI/t/apache.t
index 637ac88132..7f92155c3f 100644
--- a/lib/CGI/t/apache.t
+++ b/lib/CGI/t/apache.t
@@ -1,15 +1,10 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 use strict;
 use Test::More tests => 1;
diff --git a/lib/CGI/t/carp.t b/lib/CGI/t/carp.t
index 0de6a101ce..dcdf732410 100644
--- a/lib/CGI/t/carp.t
+++ b/lib/CGI/t/carp.t
@@ -1,18 +1,12 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
-
 use strict;
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 use Test::More tests => 47;
 use IO::Handle;
@@ -199,7 +193,7 @@ untie *STDOUT;
 open(STDOUT, ">&REAL_STDOUT");
 my $fname = $0;
 $fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also
-is( $fake_out, "<!-- warning: There is a problem at $fname line 106. -->\n",
+is( $fake_out, "<!-- warning: There is a problem at $fname line 100. -->\n",
                         'warningsToBrowser() on' );
 
 is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off");
diff --git a/lib/CGI/t/cookie.t b/lib/CGI/t/cookie.t
index c523d7aecd..f02d11302c 100644
--- a/lib/CGI/t/cookie.t
+++ b/lib/CGI/t/cookie.t
@@ -1,17 +1,12 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
+use lib qw(t/lib);
 use strict;
 
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
 use Test::More tests => 86;
 use CGI::Util qw(escape unescape);
 use POSIX qw(strftime);
diff --git a/lib/CGI/t/fast.t b/lib/CGI/t/fast.t
index d8ad97333f..45f8e1271c 100644
--- a/lib/CGI/t/fast.t
+++ b/lib/CGI/t/fast.t
@@ -1,15 +1,10 @@
 #!./perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 my $fcgi;
 BEGIN {
diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
index a6a90a6058..5b26a3d885 100755
--- a/lib/CGI/t/form.t
+++ b/lib/CGI/t/form.t
@@ -1,16 +1,10 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness,
-	        # we must ensure the blib's are in @INC, else we might use
-	        # the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch ../lib );
-	}
-}
+use lib qw(t/lib ./lib ../blib/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 use Test::More tests => 17;
 
diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
index 26fc32af82..1cde4ac5b0 100755
--- a/lib/CGI/t/function.t
+++ b/lib/CGI/t/function.t
@@ -1,15 +1,12 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
+use lib qw(t/lib);
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..28\n"; }
+BEGIN {$| = 1; print "1..31\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI (':standard','keywords');
@@ -41,6 +38,9 @@ if ($^O eq 'VMS') { $CRLF = "\n"; }
 
 if (ord("\t") != 9) { $CRLF = "\r\n"; }
 
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
 if (ord("\t") != 9) { $CRLF = "\r\n"; }
  
 # Set up a CGI environment
@@ -108,3 +108,8 @@ test(26,$h eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}Con
 test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
 
 test(28,escapeHTML('CGI') eq 'CGI','escapeHTML(CGI) failing again');
+
+test(29, charset("UTF-8") && header() eq "Content-Type: text/html; charset=UTF-8${CRLF}${CRLF}", "UTF-8 charset");
+test(30, !charset("") && header() eq "Content-Type: text/html${CRLF}${CRLF}", "Empty charset");
+
+test(31, header(-foo=>'bar') eq "Foo: bar${CRLF}Content-Type: text/html${CRLF}${CRLF}", "Custom header");
diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
index 1af6754b33..b3c462c079 100755
--- a/lib/CGI/t/html.t
+++ b/lib/CGI/t/html.t
@@ -1,30 +1,21 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness,
-	        # we must ensure the blib's are in @INC, else we might use
-	        # the core CGI.pm
-		unshift @INC, qw( ../blib/lib ../blib/arch ../lib );
-	}
-}
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..24\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI (':standard','-no_debug','*h3','start_table');
 $loaded = 1;
 print "ok 1\n";
 
 BEGIN {
-    if ($] >= 5.006) {
-	require utf8;	# we contain Latin-1 in subtest #22,
-	utf8->unimport;	# possible "use utf8" must be undone
-    }
+   $| = 1; print "1..27\n";
+  if( $] > 5.006 ) {
+    # no utf8
+    require utf8; # we contain Latin-1
+    utf8->unimport;
+  }
 }
 
 ######################### End of black magic.
@@ -105,3 +96,9 @@ test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt
 test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
 my $q = new CGI;
 test(24,$q->h1('hi') eq '<h1>hi</h1>');
+
+$q->autoEscape(1);
+test(25,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
+$q->autoEscape(0);
+test(26,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&egrave;">hello &aacute;</p>');
+test(27,p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
diff --git a/lib/CGI/t/push.t b/lib/CGI/t/push.t
index dbe4551cc5..2c48d60ba3 100644
--- a/lib/CGI/t/push.t
+++ b/lib/CGI/t/push.t
@@ -1,15 +1,10 @@
 #!./perl -wT
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib  ../blib/arch lib );
-	}
-}	
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 use Test::More tests => 12; 
 
diff --git a/lib/CGI/t/request.t b/lib/CGI/t/request.t
index 5c79050f49..96775a9279 100755
--- a/lib/CGI/t/request.t
+++ b/lib/CGI/t/request.t
@@ -1,16 +1,8 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
-
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
 
 BEGIN {$| = 1; print "1..33\n"; }
 END {print "not ok 1\n" unless $loaded;}
diff --git a/lib/CGI/t/switch.t b/lib/CGI/t/switch.t
index eda3e8264e..ac58618a7f 100644
--- a/lib/CGI/t/switch.t
+++ b/lib/CGI/t/switch.t
@@ -1,15 +1,10 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-		# ensure the blib's are in @INC, else we might use the core CGI.pm
-		unshift @INC, qw( ../blib/lib  ../blib/arch lib );
-	}
-}
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
 
 use strict;
 use Test::More tests => 1;
diff --git a/lib/CGI/t/util-58.t b/lib/CGI/t/util-58.t
new file mode 100644
index 0000000000..70a618917c
--- /dev/null
+++ b/lib/CGI/t/util-58.t
@@ -0,0 +1,16 @@
+#
+# This tests CGI::Util::escape() when fed with UTF-8-flagged string
+# -- dankogai
+BEGIN {
+    if ($] < 5.008) {
+       print "1..0 # \$] == $] < 5.008\n";
+       exit(0);
+    }
+}
+
+use Test::More tests => 2;
+use_ok("CGI::Util");
+my $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
+is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
+   "# Escape string with UTF-8 flag");
+__END__
diff --git a/lib/CGI/t/util.t b/lib/CGI/t/util.t
index c5ec617a5d..8f9da3ba94 100644
--- a/lib/CGI/t/util.t
+++ b/lib/CGI/t/util.t
@@ -1,17 +1,10 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-	chdir 't' if -d 't';
-	if ($ENV{PERL_CORE}) {
-		@INC = '../lib';
-	} else {
-		unshift @INC, qw( ../blib/lib ../blib/arch lib );
-	}
-}
-
 # Test ability to escape() and unescape() punctuation characters
 # except for qw(- . _).
 ######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
 BEGIN {$| = 1; print "1..59\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;