[Rt-commit] r2489 - in HTTP-Server-Simple: . lib/HTTP/Server

[jesse at bestpractical.com]

Author: jesse
Date: Tue Mar 22 10:33:26 2005
New Revision: 2489

Modified:
   HTTP-Server-Simple/   (props changed)
   HTTP-Server-Simple/Changes
   HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
Log:
 r9557 at hualien:  jesse | 2005-03-22 23:32:22 +0800
 * Patch from SRI to support better reading from STDIN


Modified: HTTP-Server-Simple/Changes
==============================================================================
--- HTTP-Server-Simple/Changes	(original)
+++ HTTP-Server-Simple/Changes	Tue Mar 22 10:33:26 2005
@@ -4,7 +4,7 @@
   but is cleaner and safer.
 - Fixed bugs in ::CGI that broke http header handling
 - Refactored code to be more transparent
-
+- Patch from Sebastian Riedel to do proper parsing of form data from STDIN
 
 0.03_03 Fri Mar 18 15:09:52 EST 2005
 - Finish fixes from http://rt.cpan.org/NoAuth/Bug.html?id=11409

Modified: HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
==============================================================================
--- HTTP-Server-Simple/lib/HTTP/Server/Simple.pm	(original)
+++ HTTP-Server-Simple/lib/HTTP/Server/Simple.pm	Tue Mar 22 10:33:26 2005
@@ -374,9 +374,13 @@
 
 sub parse_request {
     my $self = shift;
-    defined($_ = <STDIN>)
-	or return undef;
-    chomp;
+    my $chunk;
+    while ( sysread( STDIN, my $buff, 1 ) ) {
+        last if $buff eq "\n";
+        $chunk .= $buff;
+    }
+    defined($chunk) or return undef;
+    $_ = $chunk;
 
     m/^(\w+)\s+(\S+)(?:\s+(\S+))?\r?$/;
     my $method = $1;
@@ -403,13 +407,19 @@
 
     my @headers;
 
-    while (<STDIN>) {
-        s/[\r\l\n\s]+$//;
-        if (/^([\w\-]+): (.+)/i) {
-	    push @headers, $1 => $2;
+    my $chunk = '';
+    while ( sysread( STDIN, my $buff, 1 ) ) {
+        if ( $buff eq "\n" ) {
+            $chunk =~ s/[\r\l\n\s]+$//;
+            if ( $chunk =~ /^([\w\-]+): (.+)/i ) {
+                push @headers, $1 => $2;
+            }
+            last if ( $chunk =~ /^$/ );
+            $chunk = '';
         }
-        last if (/^$/);
+        else { $chunk .= $buff }
     }
+
     return(\@headers);
 }