From: Steve Peters <steve@fisharerojo.org>
Date: Thu, 16 Feb 2006 12:54:08 +0000 (+0000)
Subject: Upgrade to CGI-3.16, with version bump on CGI.pm for documentation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=55b5d70095e7b9679db373ca7ac72c1951b35a3c;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to CGI-3.16, with version bump on CGI.pm for documentation
fixes not yet integrated.

p4raw-id: //depot/perl@27202
---

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 4d5742b..e93efc0 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -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.194 2005/12/06 22:12:56 lstein Exp $';
-$CGI::VERSION='3.15_01';
+$CGI::revision = '$Id: CGI.pm,v 1.200 2006/02/08 18:28:54 lstein Exp $';
+$CGI::VERSION='3.16_01';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1418,10 +1418,13 @@ sub header {
                             'ATTACHMENT','P3P'],@p);
 
     $nph     ||= $NPH;
+
+    $type ||= 'text/html' unless defined($type);
+
     if (defined $charset) {
       $self->charset($charset);
     } else {
-      $charset = $self->charset;
+      $charset = $self->charset if $type =~ /^text\//;
     }
 
     # rearrange() was designed for the HTML portion, so we
@@ -1432,8 +1435,7 @@ sub header {
         ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
     }
 
-    $type ||= 'text/html' unless defined($type);
-    $type .= "; charset=$charset" if $type ne '' and $type =~ m!^text/! and $type !~ /\bcharset\b/ and $charset ne '';
+    $type .= "; charset=$charset" if $type ne '' and $type !~ /\bcharset\b/ and $charset ne '';
 
     # Maybe future compatibility.  Maybe not.
     my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
@@ -1499,7 +1501,7 @@ sub redirect {
     my($self,@p) = self_or_default(@_);
     my($url,$target,$status,$cookie,$nph,@other) = 
          rearrange([[LOCATION,URI,URL],TARGET,STATUS,['COOKIE','COOKIES'],NPH],@p);
-    $status = '302 Moved' unless defined $status;
+    $status = '302 Found' unless defined $status;
     $url ||= $self->self_url;
     my(@o);
     foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
@@ -1546,7 +1548,7 @@ sub start_html {
     $self->element_id(0);
     $self->element_tab(0);
 
-    $encoding = 'iso-8859-1' unless defined $encoding;
+    $encoding = lc($self->charset) unless defined $encoding;
 
     # Need to sort out the DTD before it's okay to call escapeHTML().
     my(@result,$xml_dtd);
@@ -6679,6 +6681,11 @@ simple to turn a CGI parameter into a cookie, and vice-versa:
    # vice-versa
    param(-name=>'answers',-value=>[cookie('answers')]);
 
+If you call cookie() without any parameters, it will return a list of
+the names of all cookies passed to your script:
+
+  @cookies = cookie();
+
 See the B<cookie.cgi> example script for some ideas on how to use
 cookies effectively.
 
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 2d1daad..2c5cce0 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 c451d7f..a0e084b 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 789aa25..dfd99e6 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 43b8709..39e7cbb 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 f02d113..4d91d48 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 1cde4ac..2560df4 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 e91ba11..49cc595 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()");