From: Christian Hansen <chansen@cpan.org>
Date: Thu, 9 Nov 2006 04:32:03 +0000 (+0000)
Subject: More tweaks to H::R::AsCGI, should now be possible to use pipes/sockets as std handles.
X-Git-Tag: v1.0~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTTP-Request-AsCGI.git;a=commitdiff_plain;h=5889d784168d4659fa919c8deb3ff7a04e498caf

More tweaks to H::R::AsCGI, should now be possible to use pipes/sockets as std handles.
---

diff --git a/lib/HTTP/Request/AsCGI.pm b/lib/HTTP/Request/AsCGI.pm
index 5088f0c..d6b3de2 100644
--- a/lib/HTTP/Request/AsCGI.pm
+++ b/lib/HTTP/Request/AsCGI.pm
@@ -8,10 +8,23 @@ use base 'Class::Accessor::Fast';
 use Carp            qw[croak];
 use HTTP::Response  qw[];
 use IO::Handle      qw[];
-use IO::File        qw[SEEK_SET SEEK_END];
+use IO::File        qw[SEEK_SET];
 use Symbol          qw[];
 
-__PACKAGE__->mk_accessors(qw[environment request is_restored is_setuped is_prepared should_dup should_restore should_rewind stdin stdout stderr]);
+__PACKAGE__->mk_accessors( qw[ is_setuped
+                               is_prepared
+                               is_restored
+
+                               should_dup
+                               should_restore
+                               should_rewind
+                               should_setup_content
+
+                               environment
+                               request
+                               stdin
+                               stdout
+                               stderr ] );
 
 our $VERSION = 0.6_01;
 
@@ -85,6 +98,13 @@ sub initialize {
         $self->should_rewind(1);
     }
 
+    if ( exists $params->{content} ) {
+        $self->should_setup_content( $params->{content} ? 1 : 0 );
+    }
+    else {
+        $self->should_setup_content(1);
+    }
+
     $self->prepare;
 
     return $self;
@@ -159,6 +179,7 @@ sub prepare {
 sub setup {
     my $self = shift;
 
+    $self->setup_content;
     $self->setup_stdin;
     $self->setup_stdout;
     $self->setup_stderr;
@@ -173,33 +194,40 @@ sub setup {
     return $self;
 }
 
-sub setup_environment {
+sub setup_content {
     my $self = shift;
 
-    no warnings 'uninitialized';
-
-    if ( $self->should_restore ) {
-        $self->{restore}->{environment} = { %ENV };
-    }
+    if ( $self->should_setup_content && $self->has_stdin ) {
 
-    %ENV = %{ $self->environment };
-}
+        if ( $self->request->content_length ) {
 
-sub setup_stdin {
-    my $self = shift;
+            my $content = $self->request->content_ref;
 
-    if ( $self->has_stdin ) {
+            if ( ref $content eq 'SCALAR' ) {
 
-        binmode( $self->stdin );
+                if ( defined $$content && length $$content ) {
 
-        if ( $self->request->content_length ) {
+                    print( { $self->stdin } $$content )
+                      or croak("Couldn't write request content to stdin handle: '$!'");
 
-            syswrite( $self->stdin, $self->request->content )
-              or croak("Couldn't write request content to stdin handle: '$!'");
+                    if ( $self->should_rewind ) {
 
-            sysseek( $self->stdin, 0, SEEK_SET )
-              or croak("Couldn't seek stdin handle: '$!'");
+                        seek( $self->stdin, 0, SEEK_SET )
+                          or croak("Couldn't seek stdin handle: '$!'");
+                    }
+                }
+            }
+            else {
+                croak("Can't handle request content of '$content'");
+            }
         }
+    }
+}
+
+sub setup_stdin {
+    my $self = shift;
+
+    if ( $self->has_stdin ) {
 
         if ( $self->should_dup ) {
 
@@ -224,9 +252,10 @@ sub setup_stdin {
                 $self->{restore}->{stdin_ref} = \*$stdin;
             }
 
-            *{ $stdin } = $self->stdin;
+            *$stdin = $self->stdin;
         }
 
+        binmode( $self->stdin );
         binmode( STDIN );
     }
 }
@@ -259,7 +288,7 @@ sub setup_stdout {
                 $self->{restore}->{stdout_ref} = \*$stdout;
             }
 
-            *{ $stdout } = $self->stdout;
+            *$stdout = $self->stdout;
         }
 
         binmode( $self->stdout );
@@ -295,7 +324,7 @@ sub setup_stderr {
                 $self->{restore}->{stderr_ref} = \*$stderr;
             }
 
-            *{ $stderr } = $self->stderr;
+            *$stderr = $self->stderr;
         }
 
         binmode( $self->stderr );
@@ -303,14 +332,29 @@ sub setup_stderr {
     }
 }
 
+sub setup_environment {
+    my $self = shift;
+
+    no warnings 'uninitialized';
+
+    if ( $self->should_restore ) {
+        $self->{restore}->{environment} = { %ENV };
+    }
+
+    %ENV = %{ $self->environment };
+}
+
 sub response {
     my $self   = shift;
     my %params = ( headers_only => 0, sync => 0, @_ );
 
     return undef unless $self->has_stdout;
 
-    seek( $self->stdout, 0, SEEK_SET )
-      or croak("Couldn't seek stdout handle: '$!'");
+    if ( $self->should_rewind ) {
+
+        seek( $self->stdout, 0, SEEK_SET )
+          or croak("Couldn't seek stdout handle: '$!'");
+    }
 
     my $message  = undef;
     my $response = HTTP::Response->new( 200, 'OK' );
@@ -451,8 +495,7 @@ sub restore_stdin {
         else {
 
             my $stdin_ref = $self->{restore}->{stdin_ref};
-
-            *{ $stdin_ref } = $stdin;
+              *$stdin_ref = $stdin;
         }
 
         if ( $self->should_rewind ) {
@@ -481,8 +524,7 @@ sub restore_stdout {
         else {
 
             my $stdout_ref = $self->{restore}->{stdout_ref};
-
-            *{ $stdout_ref } = $stdout;
+              *$stdout_ref = $stdout;
         }
 
         if ( $self->should_rewind ) {
@@ -511,8 +553,7 @@ sub restore_stderr {
         else {
 
             my $stderr_ref = $self->{restore}->{stderr_ref};
-
-            *{ $stderr_ref } = $stderr;
+              *$stderr_ref = $stderr;
         }
 
         if ( $self->should_rewind ) {