added two examples

[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 4f65de3..ccae2b4 100644 (file)
--- a/lib/HTTP/Request/AsCGI.pm
+++ b/lib/HTTP/Request/AsCGI.pm
@@ -18,6 +18,7 @@ sub new {
     my $self = {
         request  => $request,
         restored => 0,
+        setuped  => 0,
         stdin    => IO::File->new_tmpfile,
         stdout   => IO::File->new_tmpfile,
         stderr   => IO::File->new_tmpfile
@@ -75,14 +76,17 @@ sub setup {
 
     if ( $self->request->content_length ) {
 
-        $self->stdin->write( $self->request->content )
-          or croak("Can't write content: $!");
+        $self->stdin->syswrite( $self->request->content )
+          or croak("Can't write content to stdin: $!");
 
-        seek( $self->stdin, 0, 0 )
+        $self->stdin->sysseek( 0, SEEK_SET )
           or croak("Can't seek stdin: $!");
     }
 
-    %ENV = %{ $self->enviroment };
+    {
+        no warnings 'uninitialized';
+        %ENV = %{ $self->enviroment };
+    }
 
     open( STDIN, '<&=', $self->stdin->fileno )
       or croak("Can't open stdin: $!");
@@ -92,6 +96,8 @@ sub setup {
 
     open( STDERR, '>&=', $self->stderr->fileno )
       or croak("Can't open stderr: $!");
+      
+    $self->{setuped}++;
 
     return $self;
 }
@@ -109,13 +115,28 @@ sub restore {
 
     open( STDERR, '>&', $self->{restore}->{stderr} )
       or croak("Can't restore stderr: $!");
-      
+
+    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 ) {
+        $self->stderr->sysseek( 0, SEEK_SET )
+          or croak("Can't seek stderr: $!");
+    }
+
     $self->{restored}++;
 }
 
 sub DESTROY {
     my $self = shift;
-    $self->restore unless $self->{restored};
+    $self->restore if $self->{setuped} && !$self->{restored};
 }
 
 1;
@@ -149,8 +170,6 @@ HTTP::Request::AsCGI - Setup a CGI enviroment from a HTTP::Request
         # enviroment and descriptors will automatically be restored when $c is destructed.
     }
     
-    $stdout->seek( 0, 0 );
-    
     while ( my $line = $stdout->getline ) {
         print $line;
     }