Upgrade to CGI.pm 3.06

p4raw-id: //depot/perl@24013

5 files changed, 50 insertions, 48 deletions

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index e25cd7f055..4c4bc706fc 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -281,7 +281,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION    = '1.28';
+$CGI::Carp::VERSION    = '1.29';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 
@@ -371,7 +371,7 @@ sub _warn {
 # eval.  These evals don't count when looking at the stack backtrace.
 sub _longmess {
     my $message = Carp::longmess();
-    $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s
+    $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
         if exists $ENV{MOD_PERL};
     return $message;
 }
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 27a93c55b0..3afeae22dd 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -25,9 +25,12 @@ my $MOD_PERL = 0;
 if (exists $ENV{MOD_PERL}) {
   eval "require mod_perl";
   if (defined $mod_perl::VERSION) {
-    if ($mod_perl::VERSION >= 1.99) {
+    my $float = $mod_perl::VERSION;
+    $float = ~ s/^.+?([\d.]+).+$/$1/;
+    if ($float >= 1.99) {
       $MOD_PERL = 2;
       require Apache::RequestUtil;
+      eval "require APR::Table";  # Changing APIs? I hope not.
     } else {
       $MOD_PERL = 1;
       require Apache;
@@ -199,7 +202,7 @@ sub value {
 sub domain {
     my $self = shift;
     my $domain = shift;
-    $self->{'domain'} = $domain if defined $domain;
+    $self->{'domain'} = lc $domain if defined $domain;
     return $self->{'domain'};
 }
 
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index 6af42de415..523007c5ef 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -103,14 +103,14 @@ sub rearrange {
 	}
     }
 
-    push (@result,make_attributes(\%leftover,1)) if %leftover;
+    push (@result,make_attributes(\%leftover,defined $CGI::Q ? $CGI::Q->{escape} : 1)) if %leftover;
     @result;
 }
 
 sub make_attributes {
     my $attr = shift;
     return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
-    my $escape = shift || 0;
+    my $escape =  shift || 0;
     my(@att);
     foreach (keys %{$attr}) {
 	my($key) = $_;
@@ -141,6 +141,7 @@ sub simple_escape {
 
 sub utf8_chr {
         my $c = shift(@_);
+	return chr($c) if $] >= 5.006;
 
         if ($c < 0x80) {
                 return sprintf("%c", $c);
@@ -180,7 +181,7 @@ sub utf8_chr {
 
 # unescape URL-encoded data
 sub unescape {
-  shift() if @_ > 1 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
+  shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $todecode = shift;
   return undef unless defined($todecode);
   $todecode =~ tr/+/ /;       # pluses become spaces
diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
index 5b26a3d885..61b6b62ed1 100755
--- a/lib/CGI/t/form.t
+++ b/lib/CGI/t/form.t
@@ -1,10 +1,8 @@
 #!/usr/local/bin/perl -w
 
-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 lib qw(. ./blib/lib ./blib/arch);
 
 use Test::More tests => 17;
 
@@ -31,47 +29,47 @@ $ENV{SERVER_PORT}     = 8080;
 $ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
 
 is(start_form(-action=>'foobar',-method=>'get'),
-   qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
+   qq(<form method="get" action="foobar" enctype="multipart/form-data">\n),
    "start_form()");
 
 is(submit(),
-   qq(<input type="submit" name=".submit" />),
+   qq(<input type="submit" tabindex="0" name=".submit" />),
    "submit()");
 
 is(submit(-name  => 'foo',
 	  -value => 'bar'),
-   qq(<input type="submit" name="foo" value="bar" />),
+   qq(<input type="submit" tabindex="1" name="foo" value="bar" />),
    "submit(-name,-value)");
 
 is(submit({-name  => 'foo',
 	   -value => 'bar'}),
-   qq(<input type="submit" name="foo" value="bar" />),
+   qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
    "submit({-name,-value})");
 
 is(textfield(-name => 'weather'),
-   qq(<input type="text" name="weather" value="dull" />),
+   qq(<input type="text" name="weather" tabindex="3" value="dull" />),
    "textfield({-name})");
 
 is(textfield(-name  => 'weather',
 	     -value => 'nice'),
-   qq(<input type="text" name="weather" value="dull" />),
+   qq(<input type="text" name="weather" tabindex="4" value="dull" />),
    "textfield({-name,-value})");
 
 is(textfield(-name     => 'weather',
 	     -value    => 'nice',
 	     -override => 1),
-   qq(<input type="text" name="weather" value="nice" />),
+   qq(<input type="text" name="weather" tabindex="5" value="nice" />),
    "textfield({-name,-value,-override})");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'nice'),
-   qq(<input type="checkbox" name="weather" value="nice" />weather),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="6" />weather</label>),
    "checkbox()");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'nice',
 	    -label => 'forecast'),
-   qq(<input type="checkbox" name="weather" value="nice" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />forecast</label>),
    "checkbox()");
 
 is(checkbox(-name     => 'weather',
@@ -79,50 +77,43 @@ is(checkbox(-name     => 'weather',
 	    -label    => 'forecast',
 	    -checked  => 1,
 	    -override => 1),
-   qq(<input type="checkbox" name="weather" value="nice" checked="checked" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" checked="checked" />forecast</label>),
    "checkbox()");
 
 is(checkbox(-name  => 'weather',
 	    -value => 'dull',
 	    -label => 'forecast'),
-   qq(<input type="checkbox" name="weather" value="dull" checked="checked" />forecast),
+   qq(<label><input type="checkbox" name="weather" value="dull" tabindex="9" checked="checked" />forecast</label>),
    "checkbox()");
 
 is(radio_group(-name => 'game'),
-   qq(<input type="radio" name="game" value="chess" checked="checked" />chess ).
-   qq(<input type="radio" name="game" value="checkers" />checkers),
+   qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="10" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="11" />checkers</label>),
    'radio_group()');
 
 is(radio_group(-name   => 'game',
 	       -labels => {'chess' => 'ping pong'}),
-   qq(<input type="radio" name="game" value="chess" checked="checked" />ping pong ).
-   qq(<input type="radio" name="game" value="checkers" />checkers),
+   qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="12" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="13" />checkers</label>),
    'radio_group()');
 
 is(checkbox_group(-name   => 'game',
 		  -Values => [qw/checkers chess cribbage/]),
-   qq(<input type="checkbox" name="game" value="checkers" checked="checked" />checkers ).
-   qq(<input type="checkbox" name="game" value="chess" checked="checked" />chess ).
-   qq(<input type="checkbox" name="game" value="cribbage" />cribbage),
+   qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="14" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="15" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="16" />cribbage</label>),
    'checkbox_group()');
 
 is(checkbox_group(-name       => 'game',
 		  '-values'   => [qw/checkers chess cribbage/],
-		  '-defaults' => ['cribbage'],-override=>1),
-   qq(<input type="checkbox" name="game" value="checkers" />checkers ).
-   qq(<input type="checkbox" name="game" value="chess" />chess ).
-   qq(<input type="checkbox" name="game" value="cribbage" checked="checked" />cribbage),
+		  '-defaults' => ['cribbage'],
+		  -override=>1),
+   qq(<label><input type="checkbox" name="game" value="checkers" tabindex="17" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="18" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="19" />cribbage</label>),
    'checkbox_group()');
 
 is(popup_menu(-name     => 'game',
 	      '-values' => [qw/checkers chess cribbage/],
 	      -default  => 'cribbage',
-	      -override => 1)."\n",
-   <<END, 'checkbox_group()');
-<select name="game">
+	      -override => 1),
+   '<select name="game" tabindex="20">
 <option value="checkers">checkers</option>
 <option value="chess">chess</option>
 <option selected="selected" value="cribbage">cribbage</option>
-</select>
-END
-
+</select>',
+   'popup_menu()');
diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
index dbab2fcdfd..e91ba113f6 100755
--- a/lib/CGI/t/html.t
+++ b/lib/CGI/t/html.t
@@ -53,30 +53,37 @@ test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","
 test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
 test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
 test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
-test(13,start_html() ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="iso-8859-1"?>
+test(13,start_html() eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 	 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"><head><title>Untitled Document</title>
-</head><body>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>Untitled Document</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
 END
     ;
-test(14,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="iso-8859-1"?>
+test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 	 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"><head><title>The world of foo</title>
-</head><body>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>The world of foo</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
 END
     ;
 # Note that this test will turn off XHTML until we make a new CGI object.
-test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') ."\n" eq <<END,"start_html()");
+test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') eq <<END,"start_html()");
 <!DOCTYPE html
 	PUBLIC "-//IETF//DTD HTML 3.2//FR">
 <html lang="fr"><head><title>Untitled Document</title>
-</head><body>
+</head>
+<body>
 END
     ;
 test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");