added simple env test

diff --git a/MANIFEST b/MANIFEST
index 6a48266..275c417 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,6 +1,7 @@
 lib/HTTP/Request/AsCGI.pm
 t/01use.t
 t/04io.t
+t/05env.t
 Makefile.PL
 MANIFEST                              This list of files
 META.yml                   Module meta-data (added by MakeMaker)

diff --git a/lib/HTTP/Request/AsCGI.pm b/lib/HTTP/Request/AsCGI.pm
index 1b0526c..f7b3b12 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
@@ -92,6 +93,8 @@ sub setup {
 
     open( STDERR, '>&=', $self->stderr->fileno )
       or croak("Can't open stderr: $!");
+      
+    $self->{setuped}++;
 
     return $self;
 }
@@ -110,21 +113,27 @@ sub restore {
     open( STDERR, '>&', $self->{restore}->{stderr} )
       or croak("Can't restore stderr: $!");
 
-    $self->stdin->sysseek( 0, SEEK_SET )
-      or croak("Can't seek stdin: $!");
+    if ( $self->stdin->fileno != STDIN->fileno ) {
+        $self->stdin->sysseek( 0, SEEK_SET )
+          or croak("Can't seek stdin: $!");
+    }
 
-    $self->stdout->sysseek( 0, SEEK_SET )
-      or croak("Can't seek stdout: $!");
+    if ( $self->stdout->fileno != STDOUT->fileno ) {
+        $self->stdout->sysseek( 0, SEEK_SET )
+          or croak("Can't seek stdout: $!");
+    }
 
-    $self->stderr->sysseek( 0, SEEK_SET )
-      or croak("Can't seek stderr: $!");
+    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;

diff --git a/t/05env.t b/t/05env.t
new file mode 100644 (file)
index 0000000..46252d0
--- /dev/null
+++ b/t/05env.t
@@ -0,0 +1,29 @@
+#!perl
+
+use Test::More tests => 8;
+
+use strict;
+use warnings;
+
+use IO::File;
+use HTTP::Request;
+use HTTP::Request::AsCGI;
+
+my $r = HTTP::Request->new( GET => 'http://www.host.com/cgi-bin/script.cgi?a=1&b=2' );
+my $c = HTTP::Request::AsCGI->new($r);
+$c->stdout( IO::File->new_from_fd( STDOUT->fileno, '>' ) );
+$c->stderr( IO::File->new_from_fd( STDERR->fileno, '>' ) );
+
+$c->setup;
+
+is( $ENV{GATEWAY_INTERFACE}, 'CGI/1.1', 'GATEWAY_INTERFACE' );
+is( $ENV{HTTP_HOST}, 'www.host.com:80', 'HTTP_HOST' );
+is( $ENV{QUERY_STRING}, 'a=1&b=2', 'QUERY_STRING' );
+is( $ENV{SCRIPT_NAME}, '/cgi-bin/script.cgi', 'SCRIPT_NAME' );
+is( $ENV{REQUEST_METHOD}, 'GET', 'REQUEST_METHOD' );
+is( $ENV{SERVER_NAME}, 'www.host.com', 'SERVER_NAME' );
+is( $ENV{SERVER_PORT}, '80', 'SERVER_PORT' );
+
+$c->restore;
+
+is( $ENV{GATEWAY_INTERFACE}, undef, 'No CGI env after restore' );