Fixed binmode

[catagits/HTTP-Request-AsCGI.git] / lib / HTTP / Request / AsCGI.pm

diff --git a/lib/HTTP/Request/AsCGI.pm b/lib/HTTP/Request/AsCGI.pm
index ccae2b4..42822c7 100644 (file)
--- a/lib/HTTP/Request/AsCGI.pm
+++ b/lib/HTTP/Request/AsCGI.pm
@@ -2,12 +2,13 @@ package HTTP::Request::AsCGI;
 
 use strict;
 use warnings;
+use bytes;
 use base 'Class::Accessor::Fast';
 
 use Carp;
 use IO::File;
 
-__PACKAGE__->mk_accessors( qw[ enviroment request stdin stdout stderr ] );
+__PACKAGE__->mk_accessors(qw[ enviroment request stdin stdout stderr ]);
 
 our $VERSION = 0.1;
 
@@ -27,8 +28,9 @@ sub new {
     $self->{enviroment} = {
         GATEWAY_INTERFACE => 'CGI/1.1',
         HTTP_HOST         => $request->uri->host_port,
+        PATH_INFO         => $request->uri->path,
         QUERY_STRING      => $request->uri->query || '',
-        SCRIPT_NAME       => $request->uri->path || '/',
+        SCRIPT_NAME       => '/',
         SERVER_NAME       => $request->uri->host,
         SERVER_PORT       => $request->uri->port,
         SERVER_PROTOCOL   => $request->protocol || 'HTTP/1.1',
@@ -44,7 +46,7 @@ sub new {
     foreach my $field ( $request->headers->header_field_names ) {
 
         my $key = uc($field);
-        $key =~ tr/_/-/;
+        $key =~ tr/-/_/;
         $key = 'HTTP_' . $key unless $field =~ /^Content-(Length|Type)$/;
 
         unless ( exists $self->{enviroment}->{$key} ) {
@@ -58,29 +60,46 @@ sub new {
 sub setup {
     my $self = shift;
 
-    open( my $stdin, '>&', STDIN->fileno )
-      or croak("Can't dup stdin: $!");
+    $self->{restore}->{enviroment} = {%ENV};
 
-    open( my $stdout, '>&', STDOUT->fileno )
-      or croak("Can't dup stdout: $!");
+    open( $self->{restore}->{stdin}, '>&', STDIN->fileno )
+      or croak("Can't dup stdin: $!");
 
-    open( my $stderr, '>&', STDERR->fileno )
-      or croak("Can't dup stderr: $!");
+    open( STDIN, '<&=', $self->stdin->fileno )
+      or croak("Can't open stdin: $!");
 
-    $self->{restore} = {
-        stdin      => $stdin,
-        stdout     => $stdout,
-        stderr     => $stderr,
-        enviroment => {%ENV}
-    };
+    binmode( $self->stdin, ':raw' );
+    binmode( STDIN, ':raw' );
 
     if ( $self->request->content_length ) {
 
         $self->stdin->syswrite( $self->request->content )
-          or croak("Can't write content to stdin: $!");
+          or croak("Can't write request content to stdin handle: $!");
 
         $self->stdin->sysseek( 0, SEEK_SET )
-          or croak("Can't seek stdin: $!");
+          or croak("Can't seek stdin handle: $!");
+    }
+
+    if ( $self->stdout ) {
+        open( $self->{restore}->{stdout}, '>&', STDOUT->fileno )
+          or croak("Can't dup stdout: $!");
+
+        open( STDOUT, '>&=', $self->stdout->fileno )
+          or croak("Can't open stdout: $!");
+
+        binmode( $self->stdout, ':raw' );
+        binmode( STDOUT, ':raw' );
+    }
+
+    if ( $self->stderr ) {
+        open( $self->{restore}->{stderr}, '>&', STDERR->fileno )
+          or croak("Can't dup stderr: $!");
+
+        open( STDERR, '>&=', $self->stderr->fileno )
+          or croak("Can't open stderr: $!");
+
+        binmode( $self->stderr, ':raw' );
+        binmode( STDERR, ':raw' );
     }
 
     {
@@ -88,20 +107,67 @@ sub setup {
         %ENV = %{ $self->enviroment };
     }
 
-    open( STDIN, '<&=', $self->stdin->fileno )
-      or croak("Can't open stdin: $!");
-
-    open( STDOUT, '>&=', $self->stdout->fileno )
-      or croak("Can't open stdout: $!");
-
-    open( STDERR, '>&=', $self->stderr->fileno )
-      or croak("Can't open stderr: $!");
-      
     $self->{setuped}++;
 
     return $self;
 }
 
+sub response {
+    my ( $self, $callback ) = @_;
+
+    return undef unless $self->{setuped};
+    return undef unless $self->{restored};
+    return undef unless $self->{restore}->{stdout};
+
+    require HTTP::Response;
+
+    my $message  = undef;
+    my $position = $self->stdin->tell;
+
+    $self->stdout->sysseek( 0, SEEK_SET )
+      or croak("Can't seek stdin handle: $!");
+
+    while ( my $line = $self->stdout->getline ) {
+        $message .= $line;
+        last if $line =~ /^\x0d?\x0a$/;
+    }
+
+    unless ( $message =~ /^HTTP/ ) {
+        $message = "HTTP/1.1 200\x0d\x0a" . $message;
+    }
+
+    my $response = HTTP::Response->parse($message);
+
+    if ( my $code = $response->header('Status') ) {
+        $response->code($code);
+    }
+
+    $response->protocol( $self->request->protocol );
+    $response->headers->date( time() );
+
+    if ($callback) {
+        $response->content( sub {
+            if ( $self->stdout->read( my $buffer, 4096 ) ) {
+                return $buffer;
+            }
+            return undef;
+        });
+    }
+    else {
+        my $length = 0;
+        while ( $self->stdout->read( my $buffer, 4096 ) ) {
+            $length += length($buffer);
+            $response->add_content($buffer);
+        }
+        $response->content_length($length) unless $response->content_length;
+    }
+
+    $self->stdout->sysseek( $position, SEEK_SET )
+      or croak("Can't seek stdin handle: $!");
+
+    return $response;
+}
+
 sub restore {
     my $self = shift;
 
@@ -110,28 +176,28 @@ sub restore {
     open( STDIN, '>&', $self->{restore}->{stdin} )
       or croak("Can't restore stdin: $!");
 
-    open( STDOUT, '>&', $self->{restore}->{stdout} )
-      or croak("Can't restore stdout: $!");
+    $self->stdin->sysseek( 0, SEEK_SET )
+      or croak("Can't seek stdin: $!");
 
-    open( STDERR, '>&', $self->{restore}->{stderr} )
-      or croak("Can't restore stderr: $!");
+    if ( $self->{restore}->{stdout} ) {
+        open( STDOUT, '>&', $self->{restore}->{stdout} )
+          or croak("Can't restore stdout: $!");
 
-    if ( $self->stdin->fileno != STDIN->fileno ) {
-        $self->stdin->sysseek( 0, SEEK_SET )
-          or croak("Can't seek stdin: $!");
-    }
-
-    if ( $self->stdout->fileno != STDOUT->fileno ) {
         $self->stdout->sysseek( 0, SEEK_SET )
           or croak("Can't seek stdout: $!");
     }
 
-    if ( $self->stderr->fileno != STDERR->fileno ) {
+    if ( $self->{restore}->{stderr} ) {
+        open( STDERR, '>&', $self->{restore}->{stderr} )
+          or croak("Can't restore stderr: $!");
+
         $self->stderr->sysseek( 0, SEEK_SET )
           or croak("Can't seek stderr: $!");
     }
 
     $self->{restored}++;
+
+    return $self;
 }
 
 sub DESTROY {
@@ -190,6 +256,8 @@ HTTP::Request::AsCGI - Setup a CGI enviroment from a HTTP::Request
 
 =item request
 
+=item response
+
 =item stdin
 
 =item stdout