Upgrade to CGI-3.16, with version bump on CGI.pm for documentation

fixes not yet integrated.

p4raw-id: //depot/perl@27202

7 files changed, 112 insertions, 31 deletions

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 2d1daad2fa..2c5cce0abe 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -102,7 +102,7 @@ CGI::Carp methods is called to prevent the performance hit.
 
 =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
 
-If you want to send fatal (die, confess) errors to the browser, ask to 
+If you want to send fatal (die, confess) errors to the browser, ask to
 import the special "fatalsToBrowser" subroutine:
 
     use CGI::Carp qw(fatalsToBrowser);
@@ -114,6 +114,9 @@ occur in the early compile phase will be seen.
 Nonfatal errors will still be directed to the log file only (unless redirected
 with carpout).
 
+Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
+and higher.
+
 =head2 Changing the default message
 
 By default, the software error message is followed by a note to
@@ -290,7 +293,6 @@ sub import {
     my $pkg = shift;
     my(%routines);
     my(@name);
-  
     if (@name=grep(/^name=/,@_))
       {
         my($n) = (split(/=/,$name[0]))[1];
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index c451d7fa48..a0e084bae8 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,14 @@
+  Version 3.16 Wed Feb  8 13:29:11 EST 2006
+   1. header() -charset option now works even when the MIME type is not "text".
+   2. Fixed documentation for cookie() function and fastCGI.
+   3. Upload filehandles now only closed automatically on Windows systems.
+   4. Apache::Cookie compatibility fix from David Wheeler
+   5. CGI::Carp->fatalsToBrowser() does not work correctly with
+	mod_perl 2. No workaround is known.
+   6. Fixed text status code associated with 302 redirects. Should be "Found"
+	but was "Moved".
+   7. Fixed charset in start_html() and header() to be in synch.
+
   Version 3.15 Wed Dec  7 15:13:22 EST 2005
    1. Remove extraneous "?" from self_url() when URI contains a ? but no query string.
 
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 789aa25d1a..dfd99e6d8b 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -16,6 +16,7 @@ package CGI::Cookie;
 $CGI::Cookie::VERSION='1.26';
 
 use CGI::Util qw(rearrange unescape escape);
+use CGI;
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
@@ -112,6 +113,9 @@ sub parse {
 sub new {
   my $class = shift;
   $class = ref($class) if ref($class);
+  # Ignore mod_perl request object--compatability with Apache::Cookie.
+  shift if ref $_[0]
+        && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
   my($name,$value,$path,$domain,$secure,$expires) =
     rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
   
@@ -169,6 +173,22 @@ sub compare {
     return "$self" cmp $value;
 }
 
+sub bake {
+  my ($self, $r) = @_;
+
+  $r ||= eval {
+      $MOD_PERL == 2
+          ? Apache2::RequestUtil->request()
+          : Apache->request
+  } if $MOD_PERL;
+  if ($r) {
+      $r->headers_out->set('Set-Cookie' => $self->as_string);
+  } else {
+      print CGI::header(-cookie => $self);
+  }
+
+}
+
 # accessors
 sub name {
     my $self = shift;
@@ -321,7 +341,7 @@ script if the CGI request is occurring on a secure channel, such as SSL.
 
 =head2 Creating New Cookies
 
-	$c = new CGI::Cookie(-name    =>  'foo',
+	my $c = new CGI::Cookie(-name    =>  'foo',
                              -value   =>  'bar',
                              -expires =>  '+3M',
                              -domain  =>  '.capricorn.com',
@@ -351,11 +371,28 @@ pages at your site.
 B<-secure> if set to a true value instructs the browser to return the
 cookie only when a cryptographic protocol is in use.
 
+For compatibility with Apache::Cookie, you may optionally pass in
+a mod_perl request object as the first argument to C<new()>. It will
+simply be ignored:
+
+  my $c = new CGI::Cookie($r,
+                          -name    =>  'foo',
+                          -value   =>  ['bar','baz']);
+
 =head2 Sending the Cookie to the Browser
 
-Within a CGI script you can send a cookie to the browser by creating
-one or more Set-Cookie: fields in the HTTP header.  Here is a typical
-sequence:
+The simplest way to send a cookie to the browser is by calling the bake()
+method:
+
+  $c->bake;
+
+Under mod_perl, pass in an Apache request object:
+
+  $c->bake($r);
+
+If you want to set the cookie yourself, Within a CGI script you can send
+a cookie to the browser by creating one or more Set-Cookie: fields in the
+HTTP header.  Here is a typical sequence:
 
   my $c = new CGI::Cookie(-name    =>  'foo',
                           -value   =>  ['bar','baz'],
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
index 43b8709a16..39e7cbb3ce 100644
--- a/lib/CGI/Fast.pm
+++ b/lib/CGI/Fast.pm
@@ -13,10 +13,7 @@ package CGI::Fast;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-# The most recent version and complete docs are available at:
-#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.05';
+$CGI::Fast::VERSION='1.06';
 
 use CGI;
 use FCGI;
@@ -94,22 +91,7 @@ will see large performance improvements.
 =head1 OTHER PIECES OF THE PUZZLE
 
 In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server.  Open Market's server is FastCGI-savvy.  There are also
-freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
-FastCGI-enabling modules for Microsoft Internet Information Server and
-Netscape Communications Server have been announced.
-
-In addition, you'll need a version of the Perl interpreter that has
-been linked with the FastCGI I/O library.  Precompiled binaries are
-available for several platforms, including DEC Alpha, HP-UX and 
-SPARC/Solaris, or you can rebuild Perl from source with patches
-provided in the FastCGI developer's kit.  The FastCGI Perl interpreter
-can be used in place of your normal Perl without ill consequences.
-
-You can find FastCGI modules for Apache and NCSA httpd, precompiled
-Perl interpreters, and the FastCGI developer's kit all at URL:
-
-  http://www.fastcgi.com/
+server. See http://www.fastcgi.com/ for details.
 
 =head1 WRITING FASTCGI PERL SCRIPTS
 
diff --git a/lib/CGI/t/cookie.t b/lib/CGI/t/cookie.t
index f02d11302c..4d91d481dd 100644
--- a/lib/CGI/t/cookie.t
+++ b/lib/CGI/t/cookie.t
@@ -7,7 +7,7 @@ use strict;
 # 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 Test::More tests => 96;
 use CGI::Util qw(escape unescape);
 use POSIX qw(strftime);
 
@@ -325,3 +325,51 @@ my @test_cookie = (
   ok(!$c->secure(0), 'secure attribute is cleared');
   ok(!$c->secure,    'secure attribute is cleared');
 }
+
+#-----------------------------------------------------------------------------
+# Apache2?::Cookie compatibility.
+#-----------------------------------------------------------------------------
+APACHEREQ: {
+    my $r = Apache::Faker->new;
+    isa_ok $r, 'Apache';
+    ok my $c = CGI::Cookie->new(
+        $r,
+        -name  => 'Foo',
+        -value => 'Bar',
+    ), 'Pass an Apache object to the CGI::Cookie constructor';
+    isa_ok $c, 'CGI::Cookie';
+    ok $c->bake($r), 'Bake the cookie';
+    ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+        'bake() should call headers_out->set()';
+
+    $r = Apache2::Faker->new;
+    isa_ok $r, 'Apache2::RequestReq';
+    ok $c = CGI::Cookie->new(
+        $r,
+        -name  => 'Foo',
+        -value => 'Bar',
+    ), 'Pass an Apache::RequestReq object to the CGI::Cookie constructor';
+    isa_ok $c, 'CGI::Cookie';
+    ok $c->bake($r), 'Bake the cookie';
+    ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+        'bake() should call headers_out->set()';
+}
+
+
+package Apache::Faker;
+sub new { bless {}, shift }
+sub isa {
+    my ($self, $pkg) = @_;
+    return $pkg eq 'Apache';
+}
+sub headers_out { shift }
+sub set { shift->{check} = \@_; }
+
+package Apache2::Faker;
+sub new { bless {}, shift }
+sub isa {
+    my ($self, $pkg) = @_;
+    return $pkg eq 'Apache2::RequestReq';
+}
+sub headers_out { shift }
+sub set { shift->{check} = \@_; }
diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
index 1cde4ac5b0..2560df4c42 100755
--- a/lib/CGI/t/function.t
+++ b/lib/CGI/t/function.t
@@ -102,10 +102,10 @@ if ($Config{d_fork}) {
   print "ok 23 # Skip\n";
   print "ok 24 # Skip\n";
 }
-test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+test(25,redirect('http://somewhere.else') eq "Status: 302 Found${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
 my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
-test(26,$h eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
-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(26,$h eq "Status: 302 Found${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Found${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');
 
diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
index e91ba113f6..49cc595950 100755
--- a/lib/CGI/t/html.t
+++ b/lib/CGI/t/html.t
@@ -10,7 +10,7 @@ $loaded = 1;
 print "ok 1\n";
 
 BEGIN {
-   $| = 1; print "1..27\n";
+   $| = 1; print "1..28\n";
   if( $] > 5.006 ) {
     # no utf8
     require utf8; # we contain Latin-1
@@ -110,3 +110,4 @@ test(25,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hel
 $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>');
+test(28,header(-type=>'image/gif',-charset=>'UTF-8') eq "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}","header()");