Upgrade to PathTools-3.17

[perl5.git] / lib / CGI.pm

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 27ca5bb..4c98bda 100644 (file)
--- 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.193 2005/12/05 13:52:24 lstein Exp $';
-$CGI::VERSION='3.13_01';
+$CGI::revision = '$Id: CGI.pm,v 1.202 2006/02/24 19:03:29 lstein Exp $';
+$CGI::VERSION='3.17_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,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 +1505,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 +1552,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);
@@ -2509,7 +2515,7 @@ sub scrolling_list {
        $label=$self->escapeHTML($label);
        my($value)=$self->escapeHTML($_,1);
         my $attribs = $self->_set_attributes($_, $attributes);
-        $result .= "<option$selectit$attribs value=\"$value\">$label</option>\n";
+        $result .= "<option ${selectit}${attribs}value=\"$value\">$label</option>\n";
     }
     $result .= "</select>";
     $self->register_parameter($name);
@@ -2631,8 +2637,8 @@ sub url {
     undef $path if $rewrite_in_use && $rewrite;  # path not valid when rewriting active
 
     my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
-    $uri            =~ s/\?.+$//         if defined $query_str;
-    $uri            =~ s/$path$//        if defined $path;          # remove path from URI
+    $uri            =~ s/\?.*$//;                                 # remove query string
+    $uri            =~ s/$path$//      if defined $path;          # remove path
 
     if ($full) {
        my $protocol = $self->protocol();
@@ -3308,11 +3314,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/ ) ?
@@ -6679,6 +6685,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.