From 5cfba4ecf2707369adc722b2896cc263bed9e0d9 Mon Sep 17 00:00:00 2001
From: Joshua ben Jore <jjore@cpan.org>
Date: Sat, 18 Feb 2006 20:58:10 -0600
Subject: [PATCH] Integrate: [ 27202] Upgrade to CGI-3.16, with version bump on
 CGI.pm for documentation fixes not yet integrated.

[ 27255]
Subject: Patches: B, CGI, ExtUtils::MM_Unix
From: "Joshua ben Jore" <twists@gmail.com>
Message-ID: <dc5c751d0602190058t78d915fv78c6318370307b63@mail.gmail.com>

[ 27354]
Upgrade to CGI.pm-3.17, but continuing the version bump for
unintegrated changes.

[ 27873]
Upgrade to CGI.pm-3.19.

[ 28082]
Upgrade to CGI-3.20

[ 28732]
Fix to problem where CGI can lose the filehandle during an upload.
Patch posted to the Debian bug list by Eric Wong
<eric@petta-tech.com>.

[ 28746]
Upgrade to CGI.pm-3.21

[ 28752]
Upgrade to CGI.pm-3.22.

[ 28930]
Upgrade to CGI.pm-3.25
p4raw-link: @28930 on //depot/perl: 0664a57d8d8db765643a0ef6294bbbd013a00df5
p4raw-link: @28752 on //depot/perl: 9f9736a1d14b921862a1b77740b0ec694b25aac9
p4raw-link: @28746 on //depot/perl: fc786e8b942a45b310ddfa1a762229c42b1bce9f
p4raw-link: @28732 on //depot/perl: c68480ca39f58e0c7bce1d278886ddf251baa5f7
p4raw-link: @28082 on //depot/perl: adb8659329b6b21c13aee996474236c4f2b2a6a3
p4raw-link: @27873 on //depot/perl: cb3b230cdd9075c830cf6359e2716e0d83e2a055
p4raw-link: @27354 on //depot/perl: c29edf6c1436006b2170a2279b529d57b78f0536
p4raw-link: @27255 on //depot/perl: cd755de4750e2191b6465129deed94f5a245ab7e
p4raw-link: @27202 on //depot/perl: 55b5d70095e7b9679db373ca7ac72c1951b35a3c

p4raw-id: //depot/maint-5.8/perl@30131
p4raw-integrated: from //depot/perl@30130 'copy in' lib/CGI/Util.pm
	lib/CGI/t/html.t (@24013..) lib/CGI/t/cookie.t (@27202..)
	lib/CGI.pm (@28752..) 'edit in' lib/CGI/Carp.pm (@27202..)
p4raw-integrated: from //depot/perl@27255 'copy in' AUTHORS (@26994..)
p4raw-integrated: from //depot/perl@27202 'ignore' lib/CGI/t/function.t
	(@19664..) lib/CGI/Fast.pm (@22136..) lib/CGI/Changes
	(@26308..)
p4raw-integrated: from //depot/perl@22258 'edit in' lib/CGI/Cookie.pm
	(@21928..)
---
 AUTHORS              |   1 +
 lib/CGI.pm           | 172 ++++++++++++++++++++++++++++++---------------------
 lib/CGI/Carp.pm      |  22 ++++++-
 lib/CGI/Changes      |  56 +++++++++++++++++
 lib/CGI/Cookie.pm    |  83 ++++++++++++++++++++++---
 lib/CGI/Fast.pm      |  23 +------
 lib/CGI/Util.pm      |   2 +-
 lib/CGI/t/cookie.t   |  50 ++++++++++++++-
 lib/CGI/t/function.t |  12 ++--
 lib/CGI/t/html.t     |   3 +-
 10 files changed, 314 insertions(+), 110 deletions(-)

diff --git a/AUTHORS b/AUTHORS
index 41aef17..d7dcc2d 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -438,6 +438,7 @@ Jos I. Boumans			<kane@dwim.org>
 Jose Auguste-Etienne		<Jose.auguste-etienne@cgss-guyane.fr>
 Joseph N. Hall			<joseph@cscaper.com>
 Joseph S. Myers			<jsm28@hermes.cam.ac.uk>
+Joshua ben Jore			<jjore@cpan.org>
 Joshua E. Rodd			<jrodd@pbs.org>
 Joshua Pritikin			<joshua.pritikin@db.com>
 Joost van Baal			<J.E.vanBaal@uvt.nl>
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 6c9d452..440ef5a 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';
+$CGI::revision = '$Id: CGI.pm,v 1.221 2006/09/28 17:04:10 lstein Exp $';
+$CGI::VERSION='3.25';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -40,6 +40,7 @@ use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN',
 $MOD_PERL = 0; # no mod_perl by default
 @SAVED_SYMBOLS = ();
 
+
 # >>>>> Here are some globals that you might want to adjust <<<<<<
 sub initialize_globals {
     # Set this to 1 to enable copious autoloader debugging messages
@@ -329,6 +330,10 @@ sub new {
   my $self = {};
 
   bless $self,ref $class || $class || $DefaultClass;
+
+  # always use a tempfile
+  $self->{'use_tempfile'} = 1;
+
   if (ref($initializer[0])
       && (UNIVERSAL::isa($initializer[0],'Apache')
 	  ||
@@ -339,6 +344,7 @@ sub new {
  if (ref($initializer[0]) 
      && (UNIVERSAL::isa($initializer[0],'CODE'))) {
     $self->upload_hook(shift @initializer, shift @initializer);
+    $self->{'use_tempfile'} = shift @initializer if (@initializer > 0);
   }
   if ($MOD_PERL) {
     if ($MOD_PERL == 1) {
@@ -392,9 +398,10 @@ sub upload_hook {
   } else {
     $self = shift;
   }
-  my ($hook,$data) = @_;
+  my ($hook,$data,$use_tempfile) = @_;
   $self->{'.upload_hook'} = $hook;
   $self->{'.upload_data'} = $data;
+  $self->{'use_tempfile'} = $use_tempfile if defined $use_tempfile;
 }
 
 #### Method: param
@@ -427,7 +434,7 @@ sub param {
 	    }
 	}
 	# If values is provided, then we set it.
-	if (@values) {
+	if (@values or defined $value) {
 	    $self->add_parameter($name);
 	    $self->{$name}=[@values];
 	}
@@ -436,7 +443,16 @@ sub param {
     }
 
     return unless defined($name) && $self->{$name};
-    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+
+    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];
+    }
 }
 
 sub self_or_default {
@@ -508,17 +524,10 @@ sub init {
 
       # avoid unreasonably large postings
       if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
-	# quietly read and discard the post
-	  my $buffer;
-          my $tmplength = $content_length;
-          while($tmplength > 0) {
-                 my $maxbuffer = ($tmplength < 10000)?$tmplength:10000;
-                 my $bytesread = $MOD_PERL ? $self->r->read($buffer,$maxbuffer) : read(STDIN,$buffer,$maxbuffer);
-                 $tmplength -= $bytesread;
-          }
-          $self->cgi_error("413 Request entity too large");
-          last METHOD;
-       }
+	#discard the post, unread
+	$self->cgi_error("413 Request entity too large");
+	last METHOD;
+      }
 
       # Process multipart postings, but only if the initializer is
       # not defined.
@@ -1418,11 +1427,15 @@ 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\//;
     }
+   $charset ||= '';
 
     # rearrange() was designed for the HTML portion, so we
     # need to fix it up a little.
@@ -1432,8 +1445,11 @@ 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 defined $charset
+         and $charset ne '';
 
     # Maybe future compatibility.  Maybe not.
     my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
@@ -1499,7 +1515,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 +1562,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);
@@ -1637,6 +1653,7 @@ sub _style {
     my ($self,$style) = @_;
     my (@result);
     my $type = 'text/css';
+    my $rel  = 'stylesheet';
 
     my $cdata_start = $XHTML ? "\n<!--/* <![CDATA[ */" : "\n<!-- ";
     my $cdata_end   = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
@@ -1645,25 +1662,26 @@ sub _style {
 
     for my $s (@s) {
       if (ref($s)) {
-       my($src,$code,$verbatim,$stype,$foo,@other) =
-           rearrange([qw(SRC CODE VERBATIM TYPE FOO)],
+       my($src,$code,$verbatim,$stype,$alternate,$foo,@other) =
+           rearrange([qw(SRC CODE VERBATIM TYPE ALTERNATE FOO)],
                       ('-foo'=>'bar',
                        ref($s) eq 'ARRAY' ? @$s : %$s));
        $type  = $stype if $stype;
+       $rel   = 'alternate stylesheet' if $alternate;
        my $other = @other ? join ' ',@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
            foreach $src (@$src)
          {
-           push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
-                             : qq(<link rel="stylesheet" type="$type" href="$src"$other>)) if $src;
+           push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
+                             : qq(<link rel="$rel" type="$type" href="$src"$other>)) if $src;
          }
        }
        else
        { # Otherwise, push the single -src, if it exists.
-         push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
-                             : qq(<link rel="stylesheet" type="$type" href="$src"$other>)
+         push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
+                             : qq(<link rel="$rel" type="$type" href="$src"$other>)
               ) if $src;
         }
      if ($verbatim) {
@@ -1675,8 +1693,8 @@ sub _style {
 
       } else {
            my $src = $s;
-           push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
-                               : qq(<link rel="stylesheet" type="$type" href="$src"$other>));
+           push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
+                               : qq(<link rel="$rel" type="$type" href="$src"$other>));
       }
     }
     @result;
@@ -1782,7 +1800,7 @@ sub startform {
        $action = $self->escapeHTML($action);
     }
     else {
-       $action = $self->escapeHTML($self->request_uri);
+       $action = $self->escapeHTML($self->request_uri || $self->self_url);
     }
     $action = qq(action="$action");
     my($other) = @other ? " @other" : '';
@@ -1812,9 +1830,7 @@ END_OF_FUNC
 sub start_multipart_form {
     my($self,@p) = self_or_default(@_);
     if (defined($p[0]) && substr($p[0],0,1) eq '-') {
-	my(%p) = @p;
-	$p{'-enctype'}=&MULTIPART;
-	return $self->startform(%p);
+      return $self->startform(-enctype=>&MULTIPART,@p);
     } else {
 	my($method,$action,@other) = 
 	    rearrange([METHOD,ACTION],@p);
@@ -2386,13 +2402,13 @@ sub popup_menu {
             }
         }
         else {
-            my $attribs = $self->_set_attributes($_, $attributes);
-	my($selectit) = defined($selected) ? $self->_selected($selected eq $_) : '';
-	my($label) = $_;
-	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-	my($value) = $self->escapeHTML($_);
-	$label=$self->escapeHTML($label,1);
-            $result .= "<option $selectit${attribs}value=\"$value\">$label</option>\n";
+          my $attribs = $self->_set_attributes($_, $attributes);
+	  my($selectit) = defined($selected) ? $self->_selected($selected eq $_) : '';
+	  my($label) = $_;
+	  $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	  my($value) = $self->escapeHTML($_);
+	  $label=$self->escapeHTML($label,1);
+          $result .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
         }
     }
 
@@ -2577,7 +2593,7 @@ sub image_button {
     my($name,$src,$alignment,@other) =
 	rearrange([NAME,SRC,ALIGN],@p);
 
-    my($align) = $alignment ? " align=\U\"$alignment\"" : '';
+    my($align) = $alignment ? " align=\L\"$alignment\"" : '';
     my($other) = @other ? " @other" : '';
     $name=$self->escapeHTML($name);
     return $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other />)
@@ -2624,7 +2640,7 @@ sub url {
 
     my $path        =  $self->path_info;
     my $script_name =  $self->script_name;
-    my $request_uri = $self->request_uri || '';
+    my $request_uri =  unescape($self->request_uri) || '';
     my $query_str   =  $self->query_string;
 
     my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
@@ -2632,7 +2648,7 @@ sub url {
 
     my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
     $uri            =~ s/\?.*$//;                                 # remove query string
-    $uri            =~ s/$path$//      if defined $path;          # remove path
+    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
 
     if ($full) {
 	my $protocol = $self->protocol();
@@ -2650,7 +2666,7 @@ sub url {
         return $url if $base;
 	$url .= $uri;
     } elsif ($relative) {
-	($url) = $script_name =~ m!([^/]+)$!;
+	($url) = $uri =~ m!([^/]+)$!;
     } elsif ($absolute) {
 	$url = $uri;
     }
@@ -2678,8 +2694,8 @@ END_OF_FUNC
 'cookie' => <<'END_OF_FUNC',
 sub cookie {
     my($self,@p) = self_or_default(@_);
-    my($name,$value,$path,$domain,$secure,$expires) =
-	rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
+    my($name,$value,$path,$domain,$secure,$expires,$httponly) =
+	rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@p);
 
     require CGI::Cookie;
 
@@ -2707,6 +2723,7 @@ sub cookie {
     push(@param,'-path'=>$path) if $path;
     push(@param,'-expires'=>$expires) if $expires;
     push(@param,'-secure'=>$secure) if $secure;
+    push(@param,'-httponly'=>$httponly) if $httponly;
 
     return new CGI::Cookie(@param);
 }
@@ -2752,9 +2769,6 @@ sub path_info {
     } elsif (! defined($self->{'.path_info'}) ) {
         my (undef,$path_info) = $self->_name_and_path_from_env;
 	$self->{'.path_info'} = $path_info || '';
-	# hack to fix broken path info in IIS
-	$self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
-
     }
     return $self->{'.path_info'};
 }
@@ -2766,11 +2780,10 @@ sub _name_and_path_from_env {
    my $self = shift;
    my $raw_script_name = $ENV{SCRIPT_NAME} || '';
    my $raw_path_info   = $ENV{PATH_INFO}   || '';
-   my $uri             = $ENV{REQUEST_URI} || '';
+   my $uri             = unescape($self->request_uri) || '';
 
-   if ($raw_script_name =~ m/$raw_path_info$/) {
-     $raw_script_name =~ s/$raw_path_info$//;
-   }
+   my $protected    = quotemeta($raw_path_info);
+   $raw_script_name =~ s/$protected$//;
 
    my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
    my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
@@ -2778,10 +2791,7 @@ sub _name_and_path_from_env {
    my $apache_bug      = @uri_double_slashes != @path_double_slashes;
    return ($raw_script_name,$raw_path_info) unless $apache_bug;
 
-   my $path_info_search = $raw_path_info;
-   # these characters will not (necessarily) be escaped
-   $path_info_search    =~ s/([^a-zA-Z0-9$()':_.,+*\/;?=&-])/uc sprintf("%%%02x",ord($1))/eg;
-   $path_info_search    = quotemeta($path_info_search);
+   my $path_info_search = quotemeta($raw_path_info);
    $path_info_search    =~ s!/!/+!g;
    if ($uri =~ m/^(.+)($path_info_search)/) {
        return ($1,$2);
@@ -3308,11 +3318,11 @@ sub read_multipart {
 	    return;
 	}
 
-	my($param)= $header{'Content-Disposition'}=~/ name="([^;]*)"/;
+	my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
         $param .= $TAINTED;
 
 	# Bug:  Netscape doesn't escape quotation marks in file names!!!
-	my($filename) = $header{'Content-Disposition'}=~/ filename="([^;]*)"/;
+	my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
 	# Test for Opera's multiple upload feature
 	my($multipart) = ( defined( $header{'Content-Type'} ) &&
 		$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -3378,7 +3388,7 @@ sub read_multipart {
                   $totalbytes += length($data);
                    &{$self->{'.upload_hook'}}($filename ,$data, $totalbytes, $self->{'.upload_data'});
               }
-	      print $filehandle $data;
+              print $filehandle $data if ($self->{'use_tempfile'});
           }
 
 	  # back up to beginning of file
@@ -3411,7 +3421,7 @@ END_OF_FUNC
 'upload' =><<'END_OF_FUNC',
 sub upload {
     my($self,$param_name) = self_or_default(@_);
-    my @param = grep(ref && fileno($_), $self->param($param_name));
+    my @param = grep {ref($_) && defined(fileno($_))} $self->param($param_name);
     return unless @param;
     return wantarray ? @param : $param[0];
 }
@@ -5879,7 +5889,7 @@ UPLOAD_HOOK facility available in Apache::Request, with the exception
 that the first argument to the callback is an Apache::Upload object,
 here it's the remote filename.
 
- $q = CGI->new(\&hook,$data);
+ $q = CGI->new(\&hook [,$data [,$use_tempfile]]);
 
  sub hook
  {
@@ -5887,10 +5897,19 @@ here it's the remote filename.
         print  "Read $bytes_read bytes of $filename\n";         
  }
 
+The $data field is optional; it lets you pass configuration
+information (e.g. a database handle) to your hook callback.
+
+The $use_tempfile field is a flag that lets you turn on and off
+CGI.pm's use of a temporary disk-based file during file upload. If you
+set this to a FALSE value (default true) then param('uploaded_file')
+will no longer work, and the only way to get at the uploaded data is
+via the hook you provide.
+
 If using the function-oriented interface, call the CGI::upload_hook()
 method before calling param() or any other CGI functions:
 
-  CGI::upload_hook(\&hook,$data);
+  CGI::upload_hook(\&hook [,$data [,$use_tempfile]]);
 
 This method is not exported by default.  You will have to import it
 explicitly if you wish to use it without the CGI:: prefix.
@@ -6032,7 +6051,7 @@ for each option element within the optgroup.
 =item 5.
 
 An optional fifth parameter (-novals) can be set to a true value and
-indicates to suppress the val attribut in each option element within
+indicates to suppress the val attribute in each option element within
 the optgroup.
 
 See the discussion on optgroup at W3C
@@ -6647,6 +6666,7 @@ SSL session.
 The cookie created by cookie() must be incorporated into the HTTP
 header within the string returned by the header() method:
 
+        use CGI ':standard';
 	print header(-cookie=>$my_cookie);
 
 To create multiple cookies, give header() an array reference:
@@ -6658,12 +6678,13 @@ To create multiple cookies, give header() an array reference:
 	print header(-cookie=>[$cookie1,$cookie2]);
 
 To retrieve a cookie, request it by name by calling cookie() method
-without the B<-value> parameter:
+without the B<-value> parameter. This example uses the object-oriented
+form:
 
 	use CGI;
 	$query = new CGI;
-	$riddle = cookie('riddle_name');
-        %answers = cookie('answers');
+	$riddle = $query->cookie('riddle_name');
+        %answers = $query->cookie('answers');
 
 Cookies created with a single scalar value, such as the "riddle_name"
 cookie, will be returned in that form.  Cookies with array and hash
@@ -6679,6 +6700,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.
 
@@ -6701,7 +6727,7 @@ There is no specific support for creating <frameset> sections
 in CGI.pm, but the HTML is very simple to write.  See the frame
 documentation in Netscape's home pages for details 
 
-  http://home.netscape.com/assist/net_sites/frames.html
+  http://wp.netscape.com/assist/net_sites/frames.html
 
 =item 2. Specify the destination for the document in the HTTP header
 
@@ -6739,7 +6765,7 @@ Netscape versions 2.0 and higher incorporate an interpreted language
 called JavaScript. Internet Explorer, 3.0 and higher, supports a
 closely-related dialect called JScript. JavaScript isn't the same as
 Java, and certainly isn't at all the same as Perl, which is a great
-pity. JavaScript allows you to programatically change the contents of
+pity. JavaScript allows you to programmatically change the contents of
 fill-out forms, create new windows, and pop up dialog box from within
 Netscape itself. From the point of view of CGI scripting, JavaScript
 is quite useful for validating fill-out forms prior to submitting
@@ -6993,6 +7019,14 @@ and pass it to start_html() in the -head argument, as in:
         Link({-rel=>'stylesheet',-type=>'text/css',-src=>'/ss/fred.css',-media=>'paper'}));
   print start_html({-head=>\@h})
 
+To create primary and  "alternate" stylesheet, use the B<-alternate> option:
+
+ start_html(-style=>{-src=>[
+                           {-src=>'/styles/print.css'},
+			   {-src=>'/styles/alt.css',-alternate=>1}
+                           ]
+		    });
+
 =head1 DEBUGGING
 
 If you are running the script from the command line or in the perl
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 3b5784b..40fc42e 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
@@ -204,6 +207,9 @@ non-overridden program name
   
 =head1 CHANGE LOG
 
+1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
+     not behaving correctly in an eval() context.
+
 1.05 carpout() added and minor corrections by Marc Hedlund
      <hedlund@best.com> on 11/26/95.
 
@@ -290,7 +296,6 @@ sub import {
     my $pkg = shift;
     my(%routines);
     my(@name);
-  
     if (@name=grep(/^name=/,@_))
       {
         my($n) = (split(/=/,$name[0]))[1];
@@ -382,7 +387,18 @@ sub ineval {
 
 sub die {
   my ($arg,@rest) = @_;
-  realdie ($arg,@rest) if ineval();
+
+  if ( ineval() )  {
+    if (!ref($arg)) {
+      $arg = join("",($arg,@rest)) || "Died";
+      my($file,$line,$id) = id(1);
+      $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
+      realdie($arg);
+    }
+    else {
+      realdie($arg,@rest);
+    }
+  }
 
   if (!ref($arg)) {
     $arg = join("", ($arg,@rest));
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index c451d7f..23db2a2 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,59 @@
+  Version 3.25
+  1. Fixed the link to the Netscape frames page.
+  2. Added ability to specify an alternate stylesheet.
+
+  Version 3.24
+  1. In startform(), if request_uri() returns undef, then falls back
+  to self_url(). This should rarely happen except when run outside of
+  the CGI environment.
+  2. image button alignment options were mistakenly being capitalized, causing xhtml validation to fail.
+
+  Version 3.23
+  1. Typo in upload() persisted, now fixed for real. Thanks to
+  Emanuele Zeppieri for correct patch and regression test.
+
+  Version 3.22
+  1. Typo in upload() function broke uploads. Now fixed (CPAN bug 21126).
+
+  Version 3.21
+  1. Don't try to read data at all when POST > $POST_MAX.
+  2. Fixed bug that caused $cgi->param('name',undef,'value') to unset param('name') entirely.
+  3. Fixed bug in which upload() sometimes returns empty. (CPAN bug #12694).
+  4. Incorporated patch from BURAK@cpan.org to support HTTPcookies (CPAN bug 21019).
+
+  Version 3.20
+  1. Patch from David Wheeler for CGI::Cookie->bake(). Uses mod_perl headers_out->add()
+	rather than headers_out->set().
+  2. Fixed problem identified by Andrei Voronkov in which start_form() output was screwed
+	up when initial argument begins with a dash and subsequent arguments do not.
+  3. Quashed uninitialized variable warnings coming from script_name(), url() and other
+        functions that require access to the PATH_INFO environment variable.
+
+  Version 3.19
+  1. Added patch from Stephen Frost that allows one to suppress use of the temp file that is
+	created during uploads.
+  2. Fixed problem noted by Martin Foster in which regular expression meta-character terms
+	in the path information were not quoted, causing URL parsing
+	to fail on URLs that contained metacharacters (such as +).
+  3. More fixes to the url() method.
+  4. Removed "hack to fix broken PATH_INFO in MSII".
+
+  Version 3.18
+  1.  Doc typo fixes.
+  2.  Patch from Steve Peters to default the document type to match the charset.
+  3.  Fixed param() so that param(-name=>'foo',-values=>[]) sets the parameter to empty list.
+
+  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..38c2e76 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,9 +13,10 @@ 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.26';
+$CGI::Cookie::VERSION='1.27';
 
 use CGI::Util qw(rearrange unescape escape);
+use CGI;
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
@@ -112,8 +113,11 @@ sub parse {
 sub new {
   my $class = shift;
   $class = ref($class) if ref($class);
-  my($name,$value,$path,$domain,$secure,$expires) =
-    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+  # 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,$httponly) =
+    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
   
   # Pull out our parameters.
   my @values;
@@ -142,6 +146,7 @@ sub new {
   $self->domain($domain) if defined $domain;
   $self->secure($secure) if defined $secure;
   $self->expires($expires) if defined $expires;
+  $self->httponly($httponly) if defined $httponly;
 #  $self->max_age($expires) if defined $expires;
   return $self;
 }
@@ -150,16 +155,17 @@ sub as_string {
     my $self = shift;
     return "" unless $self->name;
 
-    my(@constant_values,$domain,$path,$expires,$max_age,$secure);
+    my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly);
 
     push(@constant_values,"domain=$domain")   if $domain = $self->domain;
     push(@constant_values,"path=$path")       if $path = $self->path;
     push(@constant_values,"expires=$expires") if $expires = $self->expires;
     push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
     push(@constant_values,"secure") if $secure = $self->secure;
+    push(@constant_values,"HttpOnly") if $httponly = $self->httponly;
 
     my($key) = escape($self->name);
-    my($cookie) = join("=",($key||''),join("&",map escape($_||''),$self->value));
+    my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
     return join("; ",$cookie,@constant_values);
 }
 
@@ -169,6 +175,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->add('Set-Cookie' => $self->as_string);
+  } else {
+      print CGI::header(-cookie => $self);
+  }
+
+}
+
 # accessors
 sub name {
     my $self = shift;
@@ -231,6 +253,14 @@ sub path {
     return $self->{'path'};
 }
 
+
+sub httponly { # HttpOnly
+    my $self     = shift;
+    my $httponly = shift;
+    $self->{'httponly'} = $httponly if defined $httponly;
+    return $self->{'httponly'};
+}
+
 1;
 
 =head1 NAME
@@ -317,11 +347,24 @@ that all scripts at your site will receive the cookie.
 If the "secure" attribute is set, the cookie will only be sent to your
 script if the CGI request is occurring on a secure channel, such as SSL.
 
+=item B<4. httponly flag>
+
+If the "httponly" attribute is set, the cookie will only be accessible
+through HTTP Requests. This cookie will be inaccessible via JavaScript
+(to prevent XSS attacks).
+
+But, currently this feature only used and recognised by 
+MS Internet Explorer 6 Service Pack 1 and later.
+
+See this URL for more information:
+
+L<http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp>
+
 =back
 
 =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 +394,31 @@ 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.
 
+B<-httponly> if set to a true value, the cookie will not be accessible
+via JavaScript.
+
+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'],
@@ -407,7 +470,7 @@ same semantics as fetch(), but performs no unescaping.
 You may also retrieve cookies that were stored in some external
 form using the parse() class method:
 
-       $COOKIES = `cat /usr/tmp/Cookie_stash`;
+       $COOKIES = `cat /some/path/Cookie_stash`;
        %cookies = parse CGI::Cookie($COOKIES);
 
 If you are in a mod_perl environment, you can save some overhead by
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
index 43b8709..85fc158 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.07';
 
 use CGI;
 use FCGI;
@@ -57,6 +54,7 @@ sub new {
          return undef unless FCGI::accept() >= 0;
      }
      }
+     CGI->_reset_globals;
      return $CGI::Q = $self->SUPER::new($initializer, @param);
 }
 
@@ -94,22 +92,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/Util.pm b/lib/CGI/Util.pm
index 523007c..b934916 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -261,7 +261,7 @@ sub expire_calc {
         $offset = 0;
     } elsif ($time=~/^\d+/) {
         return $time;
-    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
+    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy])/) {
         $offset = ($mult{$2} || 1)*$1;
     } else {
         return $time;
diff --git a/lib/CGI/t/cookie.t b/lib/CGI/t/cookie.t
index f02d113..539ac7a 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 add { shift->{check} = \@_; }
+
+package Apache2::Faker;
+sub new { bless {}, shift }
+sub isa {
+    my ($self, $pkg) = @_;
+    return $pkg eq 'Apache2::RequestReq';
+}
+sub headers_out { shift }
+sub add { shift->{check} = \@_; }
diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
index 1cde4ac..4ff67d5 100755
--- a/lib/CGI/t/function.t
+++ b/lib/CGI/t/function.t
@@ -4,9 +4,9 @@ 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';
+use lib '.','..','../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..31\n"; }
+BEGIN {$| = 1; print "1..32\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI (':standard','keywords');
@@ -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');
 
@@ -113,3 +113,5 @@ test(29, charset("UTF-8") && header() eq "Content-Type: text/html; charset=UTF-8
 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");
+
+test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form method="post" action="one" enctype="multipart/form-data" onsubmit="three" name="two">\n), "initial dash followed by undashed arguments");
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()");
-- 
1.8.3.1