ANSI-C headers in test snippets to please g++ (and the rest)
[p5sagit/p5-mst-13.2.git] / lib / CGI.pm
index f5ecc2d..3547a78 100644 (file)
@@ -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.185 2005/08/03 21:14:55 lstein Exp $';
-$CGI::VERSION='3.11_01';
+$CGI::revision = '$Id: CGI.pm,v 1.208 2006/04/23 14:25:14 lstein Exp $';
+$CGI::VERSION='3.20';
 
 # 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
@@ -77,6 +78,9 @@ sub initialize_globals {
     #    2) CGI::private_tempfiles(1);
     $PRIVATE_TEMPFILES = 0;
 
+    # Set this to 1 to generate automatic tab indexes
+    $TABINDEX = 0;
+
     # Set this to 1 to cause files uploaded in multipart documents
     # to be closed, instead of caching the file handle
     # or:
@@ -326,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')
          ||
@@ -336,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) {
@@ -367,9 +376,11 @@ sub new {
 # user is still holding any reference to them as well.
 sub DESTROY {
   my $self = shift;
-  foreach my $href (values %{$self->{'.tmpfiles'}}) {
-    $href->{hndl}->DESTROY if defined $href->{hndl};
-    $href->{name}->DESTROY if defined $href->{name};
+  if ($OS eq 'WINDOWS') {
+    foreach my $href (values %{$self->{'.tmpfiles'}}) {
+      $href->{hndl}->DESTROY if defined $href->{hndl};
+      $href->{name}->DESTROY if defined $href->{name};
+    }
   }
 }
 
@@ -381,9 +392,16 @@ sub r {
 }
 
 sub upload_hook {
-  my ($self,$hook,$data) = self_or_default(@_);
+  my $self;
+  if (ref $_[0] eq 'CODE') {
+    $CGI::Q = $self = $CGI::DefaultClass->new(@_);
+  } else {
+    $self = shift;
+  }
+  my ($hook,$data,$use_tempfile) = @_;
   $self->{'.upload_hook'} = $hook;
   $self->{'.upload_data'} = $data;
+  $self->{'use_tempfile'} = $use_tempfile if defined $use_tempfile;
 }
 
 #### Method: param
@@ -416,7 +434,7 @@ sub param {
            }
        }
        # If values is provided, then we set it.
-       if (@values) {
+       if (defined $value) {
            $self->add_parameter($name);
            $self->{$name}=[@values];
        }
@@ -499,16 +517,15 @@ sub init {
       if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
        # quietly read and discard the post
          my $buffer;
-         my $max = $content_length;
-         while ($max > 0 &&
-                (my $bytes = $MOD_PERL
-                  ? $self->r->read($buffer,$max < 10000 ? $max : 10000)
-                  : read(STDIN,$buffer,$max < 10000 ? $max : 10000)
-                 )) {
-           $self->cgi_error("413 Request entity too large");
-           last METHOD;
-         }
-       }
+          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;
+       }
 
       # Process multipart postings, but only if the initializer is
       # not defined.
@@ -821,14 +838,14 @@ sub _selected {
   my $self = shift;
   my $value = shift;
   return '' unless $value;
-  return $XHTML ? qq( selected="selected") : qq( selected);
+  return $XHTML ? qq(selected="selected" ) : qq(selected );
 }
 
 sub _checked {
   my $self = shift;
   my $value = shift;
   return '' unless $value;
-  return $XHTML ? qq( checked="checked") : qq( checked);
+  return $XHTML ? qq(checked="checked" ) : qq(checked );
 }
 
 sub _reset_globals { initialize_globals(); }
@@ -851,6 +868,7 @@ sub _setup_symbols {
        $XHTML=0,                next if /^[:-]no_?xhtml$/;
        $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
        $PRIVATE_TEMPFILES++,    next if /^[:-]private_tempfiles$/;
+       $TABINDEX++,             next if /^[:-]tabindex$/;
        $CLOSE_UPLOAD_FILES++,   next if /^[:-]close_upload_files$/;
        $EXPORT{$_}++,           next if /^[:-]any$/;
        $compile++,              next if /^[:-]compile$/;
@@ -892,7 +910,9 @@ sub element_tab {
   my ($self,$new_value) = self_or_default(@_);
   $self->{'.etab'} ||= 1;
   $self->{'.etab'} = $new_value if defined $new_value;
-  $self->{'.etab'}++;
+  my $tab = $self->{'.etab'}++;
+  return '' unless $TABINDEX or defined $new_value;
+  return qq(tabindex="$tab" );
 }
 
 ###############################################################################
@@ -1405,11 +1425,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.
@@ -1419,8 +1443,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';
@@ -1486,7 +1513,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)); }
@@ -1533,7 +1560,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);
@@ -1769,10 +1796,7 @@ sub startform {
        $action = $self->escapeHTML($action);
     }
     else {
-       $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1));
-       if (exists $ENV{QUERY_STRING} && length($ENV{QUERY_STRING})>0) {
-           $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1);
-       }
+       $action = $self->escapeHTML($self->request_uri);
     }
     $action = qq(action="$action");
     my($other) = @other ? " @other" : '';
@@ -1801,10 +1825,8 @@ END_OF_FUNC
 'start_multipart_form' => <<'END_OF_FUNC',
 sub start_multipart_form {
     my($self,@p) = self_or_default(@_);
-    if (defined($param[0]) && substr($param[0],0,1) eq '-') {
-       my(%p) = @p;
-       $p{'-enctype'}=&MULTIPART;
-       return $self->startform(%p);
+    if (defined($p[0]) && substr($p[0],0,1) eq '-') {
+      return $self->startform(-enctype=>&MULTIPART,@p);
     } else {
        my($method,$action,@other) = 
            rearrange([METHOD,ACTION],@p);
@@ -1818,12 +1840,16 @@ END_OF_FUNC
 # End a form
 'endform' => <<'END_OF_FUNC',
 sub endform {
-    my($self,@p) = self_or_default(@_);    
+    my($self,@p) = self_or_default(@_);
     if ( $NOSTICKY ) {
     return wantarray ? ("</form>") : "\n</form>";
     } else {
-    return wantarray ? ("<div>",$self->get_fields,"</div>","</form>") : 
-                        "<div>".$self->get_fields ."</div>\n</form>";
+      if (my @fields = $self->get_fields) {
+         return wantarray ? ("<div>",@fields,"</div>","</form>")
+                          : "<div>".(join '',@fields)."</div>\n</form>";
+      } else {
+         return "</form>";
+      }
     }
 }
 END_OF_FUNC
@@ -1847,7 +1873,7 @@ sub _textfield {
     # and WebTV -- not sure it won't break stuff
     my($value) = $current ne '' ? qq(value="$current") : '';
     $tabindex = $self->element_tab($tabindex);
-    return $XHTML ? qq(<input type="$tag" name="$name" tabindex="$tabindex" $value$s$m$other />) 
+    return $XHTML ? qq(<input type="$tag" name="$name" $tabindex$value$s$m$other />) 
                   : qq(<input type="$tag" name="$name" $value$s$m$other>);
 }
 END_OF_FUNC
@@ -1929,7 +1955,7 @@ sub textarea {
     my($c) = $cols ? qq/ cols="$cols"/ : '';
     my($other) = @other ? " @other" : '';
     $tabindex = $self->element_tab($tabindex);
-    return qq{<textarea name="$name" tabindex="$tabindex"$r$c$other>$current</textarea>};
+    return qq{<textarea name="$name" $tabindex$r$c$other>$current</textarea>};
 }
 END_OF_FUNC
 
@@ -1963,7 +1989,7 @@ sub button {
     $script = qq/ onclick="$script"/ if $script;
     my($other) = @other ? " @other" : '';
     $tabindex = $self->element_tab($tabindex);
-    return $XHTML ? qq(<input type="button" tabindex="$tabindex"$name$val$script$other />)
+    return $XHTML ? qq(<input type="button" $tabindex$name$val$script$other />)
                   : qq(<input type="button"$name$val$script$other>);
 }
 END_OF_FUNC
@@ -1987,15 +2013,15 @@ sub submit {
     $label=$self->escapeHTML($label);
     $value=$self->escapeHTML($value,1);
 
-    my $name = $NOSTICKY ? '' : ' name=".submit"';
-    $name = qq/ name="$label"/ if defined($label);
+    my $name = $NOSTICKY ? '' : 'name=".submit" ';
+    $name = qq/name="$label" / if defined($label);
     $value = defined($value) ? $value : $label;
     my $val = '';
-    $val = qq/ value="$value"/ if defined($value);
+    $val = qq/value="$value" / if defined($value);
     $tabindex = $self->element_tab($tabindex);
-    my($other) = @other ? " @other" : '';
-    return $XHTML ? qq(<input type="submit" tabindex="$tabindex"$name$val$other />)
-                  : qq(<input type="submit"$name$val$other>);
+    my($other) = @other ? "@other " : '';
+    return $XHTML ? qq(<input type="submit" $tabindex$name$val$other/>)
+                  : qq(<input type="submit" $name$val$other>);
 }
 END_OF_FUNC
 
@@ -2020,7 +2046,7 @@ sub reset {
     $val = qq/ value="$value"/ if defined($value);
     my($other) = @other ? " @other" : '';
     $tabindex = $self->element_tab($tabindex);
-    return $XHTML ? qq(<input type="reset" tabindex="$tabindex"$name$val$other />)
+    return $XHTML ? qq(<input type="reset" $tabindex$name$val$other />)
                   : qq(<input type="reset"$name$val$other>);
 }
 END_OF_FUNC
@@ -2048,7 +2074,7 @@ sub defaults {
     my($value) = qq/ value="$label"/;
     my($other) = @other ? " @other" : '';
     $tabindex = $self->element_tab($tabindex);
-    return $XHTML ? qq(<input type="submit" name=".defaults" tabindex="$tabindex"$value$other />)
+    return $XHTML ? qq(<input type="submit" name=".defaults" $tabindex$value$other />)
                   : qq/<input type="submit" NAME=".defaults"$value$other>/;
 }
 END_OF_FUNC
@@ -2095,10 +2121,10 @@ sub checkbox {
     $name = $self->escapeHTML($name);
     $value = $self->escapeHTML($value,1);
     $the_label = $self->escapeHTML($the_label);
-    my($other) = @other ? " @other" : '';
+    my($other) = @other ? "@other " : '';
     $tabindex = $self->element_tab($tabindex);
     $self->register_parameter($name);
-    return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" tabindex="$tabindex"$checked$other />$the_label})
+    return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
                   : qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
 }
 END_OF_FUNC
@@ -2280,7 +2306,7 @@ sub _box_group {
     $name=$self->escapeHTML($name);
 
     my %tabs = ();
-    if ($tabindex) {
+    if ($TABINDEX && $tabindex) {
       if (!ref $tabindex) {
           $self->element_tab($tabindex);
       } elsif (ref $tabindex eq 'ARRAY') {
@@ -2291,7 +2317,7 @@ sub _box_group {
     }
     %tabs = map {$_=>$self->element_tab} @values unless %tabs;
 
-    my $other = @other ? " @other" : '';
+    my $other = @other ? "@other " : '';
     my $radio_checked;
     foreach (@values) {
         my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++)
@@ -2310,12 +2336,12 @@ sub _box_group {
            $label = $self->escapeHTML($label,1);
        }
         my $attribs = $self->_set_attributes($_, $attributes);
-        my $tab     = qq( tabindex="$tabs{$_}") if exists $tabs{$_};
+        my $tab     = $tabs{$_};
        $_=$self->escapeHTML($_);
         if ($XHTML) {
            push @elements,
               CGI::label(
-                   qq(<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs />$label)).${break};
+                   qq(<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs/>$label)).${break};
         } else {
            push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs>${label}${break}/);
         }
@@ -2362,7 +2388,7 @@ sub popup_menu {
     my(@values);
     @values = $self->_set_values_and_labels($values,\$labels,$name);
     $tabindex = $self->element_tab($tabindex);
-    $result = qq/<select name="$name" tabindex="$tabindex"$other>\n/;
+    $result = qq/<select name="$name" $tabindex$other>\n/;
     foreach (@values) {
         if (/<optgroup/) {
             foreach (split(/\n/)) {
@@ -2372,13 +2398,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";
         }
     }
 
@@ -2487,7 +2513,7 @@ sub scrolling_list {
 
     $name=$self->escapeHTML($name);
     $tabindex = $self->element_tab($tabindex);
-    $result = qq/<select name="$name" tabindex="$tabindex"$has_size$is_multiple$other>\n/;
+    $result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
     foreach (@values) {
        my($selectit) = $self->_selected($selected{$_});
        my($label) = $_;
@@ -2495,7 +2521,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);
@@ -2602,13 +2628,23 @@ END_OF_FUNC
 'url' => <<'END_OF_FUNC',
 sub url {
     my($self,@p) = self_or_default(@_);
-    my ($relative,$absolute,$full,$path_info,$query,$base) = 
-       rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p);
-    my $url;
+    my ($relative,$absolute,$full,$path_info,$query,$base,$rewrite) = 
+       rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE','REWRITE'],@p);
+    my $url  = '';
     $full++      if $base || !($relative || $absolute);
+    $rewrite++   unless defined $rewrite;
 
-    my $path = $self->path_info;
-    my $script_name = $self->script_name;
+    my $path        =  $self->path_info;
+    my $script_name =  $self->script_name;
+    my $request_uri =  unescape($self->request_uri) || '';
+    my $query_str   =  $self->query_string;
+
+    my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
+    undef $path if $rewrite_in_use && $rewrite;  # path not valid when rewriting active
+
+    my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
+    $uri            =~ s/\?.*$//;                                 # remove query string
+    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
 
     if ($full) {
        my $protocol = $self->protocol();
@@ -2624,16 +2660,15 @@ sub url {
                    || (lc($protocol) eq 'https' && $port == 443);
        }
         return $url if $base;
-       $url .= $script_name;
+       $url .= $uri;
     } elsif ($relative) {
-       ($url) = $script_name =~ m!([^/]+)$!;
+       ($url) = $uri =~ m!([^/]+)$!;
     } elsif ($absolute) {
-       $url = $script_name;
+       $url = $uri;
     }
 
-    $url .= $path if $path_info and defined $path;
-    $url .= "?" . $self->query_string if $query and $self->query_string;
-    $url = '' unless defined $url;
+    $url .= $path         if $path_info and defined $path;
+    $url .= "?$query_str" if $query     and $query_str ne '';
     $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
     return $url;
 }
@@ -2729,9 +2764,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'};
 }
@@ -2743,7 +2775,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) || '';
+
+   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;
@@ -2751,10 +2786,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);
@@ -3008,8 +3040,9 @@ END_OF_FUNC
 sub virtual_port {
     my($self) = self_or_default(@_);
     my $vh = $self->http('x_forwarded_host') || $self->http('host');
+    my $protocol = $self->protocol;
     if ($vh) {
-        return ($vh =~ /:(\d+)$/)[0] || '80';
+        return ($vh =~ /:(\d+)$/)[0] || ($protocol eq 'https' ? 443 : 80);
     } else {
         return $self->server_port();
     }
@@ -3280,11 +3313,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/ ) ?
@@ -3350,7 +3383,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
@@ -3365,7 +3398,11 @@ sub read_multipart {
 
          # Save some information about the uploaded file where we can get
          # at it later.
-         $self->{'.tmpfiles'}->{fileno($filehandle)}= {
+         # Use the typeglob as the key, as this is guaranteed to be
+         # unique for each filehandle.  Don't use the file descriptor as
+         # this will be re-used for each filehandle if the
+         # close_upload_files feature is used.
+         $self->{'.tmpfiles'}->{$$filehandle}= {
               hndl => $filehandle,
              name => $tmpfile,
              info => {%header},
@@ -3388,8 +3425,8 @@ END_OF_FUNC
 'tmpFileName' => <<'END_OF_FUNC',
 sub tmpFileName {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ?
-       $self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string
+    return $self->{'.tmpfiles'}->{$$filename}->{name} ?
+       $self->{'.tmpfiles'}->{$$filename}->{name}->as_string
            : '';
 }
 END_OF_FUNC
@@ -3397,7 +3434,7 @@ END_OF_FUNC
 'uploadInfo' => <<'END_OF_FUNC',
 sub uploadInfo {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{fileno($filename)}->{info};
+    return $self->{'.tmpfiles'}->{$$filename}->{info};
 }
 END_OF_FUNC
 
@@ -3781,11 +3818,10 @@ END_OF_AUTOLOAD
 package CGITempFile;
 
 sub find_tempdir {
-  undef $TMPDIRECTORY;
   $SL = $CGI::SL;
   $MAC = $CGI::OS eq 'MACINTOSH';
   my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
-  unless ($TMPDIRECTORY) {
+  unless (defined $TMPDIRECTORY) {
     @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
           "C:${SL}temp","${SL}tmp","${SL}temp",
           "${vol}${SL}Temporary Items",
@@ -4269,6 +4305,21 @@ that all the defaults are taken when you create a fill-out form.
 
 Use Delete_all() instead if you are using the function call interface.
 
+=head2 HANDLING NON-URLENCODED ARGUMENTS
+
+
+If POSTed data is not of type application/x-www-form-urlencoded or
+multipart/form-data, then the POSTed data will not be processed, but
+instead be returned as-is in a parameter named POSTDATA.  To retrieve
+it, use code like this:
+
+   my $data = $query->param('POSTDATA');
+
+(If you don't know what the preceding means, don't worry about it.  It
+only affects people trying to use CGI for XML processing and other
+specialized tasks.)
+
+
 =head2 DIRECT ACCESS TO THE PARAMETER LIST:
 
    $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
@@ -4578,6 +4629,12 @@ Sometimes this isn't what you want.  The B<-nosticky> pragma prevents
 this behavior.  You can also selectively change the sticky behavior in
 each element that you generate.
 
+=item -tabindex
+
+Automatically add tab index attributes to each form field. With this
+option turned off, you can still add tab indexes manually by passing a
+-tabindex option to each field-generating method.
+
 =item -no_undef_params
 
 This keeps CGI.pm from including undef params in the parameter list.
@@ -5169,6 +5226,16 @@ as a synonym.
 
 Generate just the protocol and net location, as in http://www.foo.com:8000
 
+=item B<-rewrite>
+
+If Apache's mod_rewrite is turned on, then the script name and path
+info probably won't match the request that the user sent. Set
+-rewrite=>1 (default) to return URLs that match what the user sent
+(the original request URI). Set -rewrite->0 to return URLs that match
+the URL after mod_rewrite's rules have run. Because the additional
+path information only makes sense in the context of the rewritten URL,
+-rewrite is set to false when you request path info in the URL.
+
 =back
 
 =head2 MIXING POST AND URL PARAMETERS
@@ -5817,8 +5884,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();
- $q->upload_hook(\&hook,$data);
+ $q = CGI->new(\&hook [,$data [,$use_tempfile]]);
 
  sub hook
  {
@@ -5826,10 +5892,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.
@@ -6618,6 +6693,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.
 
@@ -7378,13 +7458,11 @@ To make it easier to port existing programs that use cgi-lib.pl the
 compatibility routine "ReadParse" is provided.  Porting is simple:
 
 OLD VERSION
-
     require "cgi-lib.pl";
     &ReadParse;
     print "The value of the antique is $in{antique}.\n";
 
 NEW VERSION
-
     use CGI;
     CGI::ReadParse();
     print "The value of the antique is $in{antique}.\n";