version 3.01

markstos · Dec 10, 2003 · 99680a8 · 99680a8
1 parent 383c833
commit 99680a8
Show file tree

Hide file tree

Showing 4 changed files with 53 additions and 21 deletions.
diff --git a/CGI.pm b/CGI.pm
@@ -18,7 +18,7 @@ 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.145 2003-12-10 15:16:08 lstein Exp $';
+$CGI::revision = '$Id: CGI.pm,v 1.146 2003-12-10 17:33:34 lstein Exp $';
 $CGI::VERSION=3.01;
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
@@ -210,9 +210,9 @@ if ($OS eq 'VMS') {
 }
 
 if ($needs_binmode) {
-    $CGI::DefaultClass->binmode(main::STDOUT);
-    $CGI::DefaultClass->binmode(main::STDIN);
-    $CGI::DefaultClass->binmode(main::STDERR);
+    $CGI::DefaultClass->binmode(\*main::STDOUT);
+    $CGI::DefaultClass->binmode(\*main::STDIN);
+    $CGI::DefaultClass->binmode(\*main::STDERR);
 }
 
 %EXPORT_TAGS = (
@@ -564,7 +564,15 @@ sub init {
       # Check the command line and then the standard input for data.
       # We use the shellwords package in order to behave the way that
       # UN*X programmers expect.
-      $query_string = read_from_cmdline() if $DEBUG;
+      if ($DEBUG)
+      {
+          my $cmdline_ret = read_from_cmdline();
+          $query_string = $cmdline_ret->{'query_string'};
+          if (defined($cmdline_ret->{'subpath'}))
+          {
+              $self->path_info($cmdline_ret->{'subpath'});
+          }
+      }
   }
 
 # YL: Begin Change for XML handler 10/19/2001
@@ -691,6 +699,7 @@ sub all_parameters {
 
 # put a filehandle into binary mode (DOS)
 sub binmode {
+    return unless defined($_[1]) && defined fileno($_[1]);
     CORE::binmode($_[1]);
 }
 
@@ -3115,6 +3124,7 @@ END_OF_FUNC
 sub read_from_cmdline {
     my($input,@words);
     my($query_string);
+    my($subpath);
     if ($DEBUG && @ARGV) {
 	@words = @ARGV;
     } elsif ($DEBUG > 1) {
@@ -3134,7 +3144,12 @@ sub read_from_cmdline {
     } else {
 	$query_string = join('+',@words);
     }
-    return $query_string;
+    if ($query_string =~ /^(.*?)\?(.*)$/)
+    {
+        $query_string = $2;
+        $subpath = $1;
+    }
+    return { 'query_string' => $query_string, 'subpath' => $subpath };
 }
 END_OF_FUNC
 
@@ -3209,7 +3224,8 @@ sub read_multipart {
             $seqno += int rand(100);
           }
           die "CGI open of tmpfile: $!\n" unless defined $filehandle;
-	  $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+	  $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode 
+                     && defined fileno($filehandle);
 
 	  # if this is an multipart/mixed attachment, save the header
 	  # together with the body for later parsing with an external
@@ -3397,6 +3413,8 @@ END_OF_AUTOLOAD
 ######################## MultipartBuffer ####################
 package MultipartBuffer;
 
+use constant DEBUG => 0;
+
 # how many bytes to read at a time.  We use
 # a 4K buffer by default.
 $INITIAL_FILLUNIT = 1024 * 4;
@@ -3479,7 +3497,7 @@ sub readHeader {
     my($ok) = 0;
     my($bad) = 0;
 
-    local($CRLF) = "\015\012" if $CGI::OS eq 'VMS' || $EBCDIC;
+    local($CRLF) = "\015\012" if $CGI::OS eq 'VMS' || $CGI::EBCDIC;
 
     do {
 	$self->fillBuffer($FILLUNIT);
@@ -3497,9 +3515,11 @@ sub readHeader {
     substr($self->{BUFFER},0,$end+4) = '';
     my %return;
 
-    warn "untranslated header=$header\n";
-    $header = ascii2ebcdic($header) if $EBCDIC;
-    warn "translated header=$header\n";
+    if ($CGI::EBCDIC) {
+      warn "untranslated header=$header\n" if DEBUG;
+      $header = CGI::Util::ascii2ebcdic($header);
+      warn "translated header=$header\n" if DEBUG;
+    }
 
     # See RFC 2045 Appendix A and RFC 822 sections 3.4.8
     #   (Folding Long Header Fields), 3.4.3 (Comments)
@@ -3529,9 +3549,12 @@ sub readBody {
     while (defined($data = $self->read)) {
 	$returnval .= $data;
     }
-    warn "untranslated body=$returnval\n";
-    $returnval = ascii2ebcdic($returnval) if $EBCDIC;
-    warn "translated body=$returnval\n";
+
+    if ($CGI::EBCDIC) {
+      warn "untranslated body=$returnval\n" if DEBUG;
+      $returnval = CGI::Util::ascii2ebcdic($returnval);
+      warn "translated body=$returnval\n"   if DEBUG;
+    }
     return $returnval;
 }
 END_OF_FUNC
@@ -3550,13 +3573,13 @@ sub read {
     # is never split between reads.
     $self->fillBuffer($bytes);
 
-    my $boundary_start = $EBCDIC ? ebcdic2ascii($self->{BOUNDARY})      : $self->{BOUNDARY};
-    my $boundary_end   = $EBCDIC ? ebcdic2ascii($self->{BOUNDARY}.'--') : $self->{BOUNDARY}.'--';
+    my $boundary_start = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY})      : $self->{BOUNDARY};
+    my $boundary_end   = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY}.'--') : $self->{BOUNDARY}.'--';
 
     # Find the boundary in the buffer (it may not be there).
     my $start = index($self->{BUFFER},$boundary_start);
 
-    print STDERR "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n";
+    warn "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n" if DEBUG;
     # protect against malformed multipart POST operations
     die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
 
@@ -3616,7 +3639,7 @@ sub fillBuffer {
     my $bytesRead = $self->{INTERFACE}->read_from_client(\$self->{BUFFER},
 							 $bytesToRead,
 							 $bufferLength);
-    print STDERR "bytesToRead=$bytesToRead, bufferLength=$bufferLength, buffer=$self->{BUFFER}\n";
+    warn "bytesToRead=$bytesToRead, bufferLength=$bufferLength, buffer=$self->{BUFFER}\n" if DEBUG;
     $self->{BUFFER} = '' unless defined $self->{BUFFER};
 
     # An apparent bug in the Apache server causes the read()
@@ -6625,6 +6648,11 @@ pairs:
 
    your_script.pl "name1='I am a long value'" "name2=two\ words"
 
+Finally, you can set the path info for the script by prefixing the first
+name/value parameter with the path followed by a question mark (?):
+
+    your_script.pl /your/path/here?name1=value1&name2=value2
+
 =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
 
 The Dump() method produces a string consisting of all the query's

diff --git a/CGI/Carp.pm b/CGI/Carp.pm
@@ -493,7 +493,7 @@ END
     }
   } else {
     my $bytes_written = eval{tell STDOUT};
-    if (defined $bytes_written & $bytes_written > 0) {
+    if (defined $bytes_written && $bytes_written > 0) {
         print STDOUT $mess;
     }
     else {

diff --git a/MANIFEST b/MANIFEST
@@ -51,3 +51,4 @@ t/request.t
 t/switch.t
 t/util.t
 t/util-58.t
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/cgi_docs.html b/cgi_docs.html
@@ -7,7 +7,7 @@
 <BODY bgcolor="#FFFFFF">
 <H1><IMG SRC="examples/dna.small.gif" ALT="[logo]">
 CGI.pm - a Perl5 CGI Library</H1>
-Version 3.01, X/XX/2003, L. Stein
+Version 3.01, 12/10/2003, L. Stein
 <p>
 
 <H2>Abstract</H2> This perl 5 library uses objects to create Web
@@ -4854,6 +4854,9 @@ <H2><a name="bugs">Bug Reports</a></H2>
 <H2><A NAME="new">Revision History</A></H2>
 <h3>Version 3.01</h3>
 <ol>
+  <li>No fix yet for upload failures when running on EBCDIC server.
+  <li>Fixed uninitialized glob warnings that appeared when file uploading under perl 5.8.2.
+  <li>Added patch from Schlomi Fish to allow debugging of PATH_INFO from command line.
   <li>Added patch from Steve Hay to correctly unlink tmp files under mod_perl/windows
   <li>Added upload_hook functionality from Jamie LeTaul
   <li>Workarounds for mod_perl 2 IO issues.  Check that file upload and state saving still working.
@@ -5966,6 +5969,6 @@ <H3>Bug fixes</H3>
 <a href="http://www.cshl.org/">Cold Spring Harbor Laboratory</a></ADDRESS>
 <P>
 <!-- hhmts start -->
-Last modified: Thu Nov 13 08:52:38 EST 2003
+Last modified: Wed Dec 10 12:03:06 EST 2003
 <!-- hhmts end -->
 </BODY> </HTML>