1#!perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 18; 7 8use CGI::Fast socket_path => ":7070"; 9 10# override FCGI::Accept method to get none-blocking behaviour 11# all we're interested in is having an FCGI::Request object 12# that has been instantiated with the ENV hash 13no warnings 'redefine'; 14no warnings 'prototype'; 15*FCGI::Accept = sub { 1 }; 16 17# fake up an ENV containing some CGI specific variables that 18# will get passed into FCGI::Request on the instantiation 19$ENV{$_} = $_ 20 for qw(REMOTE_ADDR HTTP_COOKIE PATH_INFO QUERY_STRING); 21 22foreach my $i ( 1 .. 5 ) { 23 24 # first loop will instantiate FCGI::Request object 25 # second loop needs an initialiser as ->Accept will 26 # return -1 so the call to ->new will return undef 27 my $q = CGI::Fast->new; 28 29 # even requests will contain empty ENV 30 if ( $i % 2 == 0 ) { 31 delete( $ENV{$_} ) 32 for qw(REMOTE_ADDR HTTP_COOKIE PATH_INFO QUERY_STRING); 33 } else { 34 $ENV{$_} = $_ 35 for qw(REMOTE_ADDR HTTP_COOKIE PATH_INFO QUERY_STRING); 36 } 37 38 my $cgi_vars = { 39 map { $_ => $q->$_ } 40 qw/remote_addr raw_cookie path_info query_string/ 41 }; 42 43 if ( $i % 2 == 0 ) { 44 is( $cgi_vars->{$_},'','ENV variables not reused from last request' ) 45 for qw/ raw_cookie path_info query_string /; 46 } else { 47 is( $cgi_vars->{remote_addr},'REMOTE_ADDR','ENV variables set from current environment' ); 48 is( $cgi_vars->{raw_cookie},'HTTP_COOKIE','ENV variables set from current environment' ); 49 is( $cgi_vars->{path_info},'PATH_INFO','ENV variables set from current environment' ); 50 is( $cgi_vars->{query_string},'','ENV variables set from current environment' ); 51 } 52} 53