From: Christian Hansen Date: Sat, 25 Nov 2006 18:34:36 +0000 (+0000) Subject: Improved error messages. More tolerant parsing of CGI responses. X-Git-Tag: v1.0~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTTP-Request-AsCGI.git;a=commitdiff_plain;h=14f243e8c78199aad82785aa32f2f3e5409d9a9b Improved error messages. More tolerant parsing of CGI responses. --- diff --git a/examples/daemon.pl b/examples/daemon.pl index c5a04ee..bd4c235 100644 --- a/examples/daemon.pl +++ b/examples/daemon.pl @@ -53,7 +53,7 @@ while ( my $client = $server->accept ) { $q->end_form, $q->h2('Parameters'), $q->Dump, - $q->h2('Enviroment'), + $q->h2('Environment'), $q->table( $q->Tr( [ map{ $q->td( [ $_, $ENV{$_} ] ) } sort keys %ENV diff --git a/examples/synopsis.pl b/examples/synopsis.pl index 2106a1e..4d6847f 100644 --- a/examples/synopsis.pl +++ b/examples/synopsis.pl @@ -21,7 +21,7 @@ my $stdout; $stdout = $c->stdout; - # enviroment and descriptors will automatically be restored when $c is destructed. + # environment and descriptors will automatically be restored when $c is destructed. } while ( my $line = $stdout->getline ) { diff --git a/lib/HTTP/Request/AsCGI.pm b/lib/HTTP/Request/AsCGI.pm index 4cc479a..55b7bdb 100644 --- a/lib/HTTP/Request/AsCGI.pm +++ b/lib/HTTP/Request/AsCGI.pm @@ -11,7 +11,7 @@ use IO::Handle qw[]; use IO::File qw[SEEK_SET]; use Symbol qw[]; -__PACKAGE__->mk_accessors( qw[ is_setuped +__PACKAGE__->mk_accessors( qw[ is_setup is_prepared is_restored @@ -53,7 +53,7 @@ sub initialize { } if ( exists $params->{environment} ) { - $self->environment( $params->{environment} ); + $self->environment( { %{ $params->{environment} } } ); } else { $self->environment( {} ); @@ -179,6 +179,10 @@ sub prepare { sub setup { my $self = shift; + if ( $self->is_setup ) { + croak("An attempt was made to setup environment variables and STD handles which has already been setup."); + } + $self->setup_content; $self->setup_stdin; $self->setup_stdout; @@ -189,7 +193,7 @@ sub setup { CGI::initialize_globals(); } - $self->is_setuped(1); + $self->is_setup(1); return $self; } @@ -204,12 +208,12 @@ sub write_content { if ( defined($$content) && length($$content) ) { print( { $self->stdin } $$content ) - or croak("Couldn't write request content to stdin handle: '$!'"); + or croak("Couldn't write request content SCALAR to stdin handle: '$!'"); if ( $self->should_rewind ) { seek( $self->stdin, 0, SEEK_SET ) - or croak("Couldn't seek stdin handle: '$!'"); + or croak("Couldn't rewind stdin handle: '$!'"); } } } @@ -222,7 +226,7 @@ sub write_content { if ( defined($chunk) && length($chunk) ) { print( { $self->stdin } $chunk ) - or croak("Couldn't write request content chunk to stdin handle: '$!'"); + or croak("Couldn't write request content callback to stdin handle: '$!'"); } else { last; @@ -232,7 +236,7 @@ sub write_content { if ( $self->should_rewind ) { seek( $self->stdin, 0, SEEK_SET ) - or croak("Couldn't seek stdin handle: '$!'"); + or croak("Couldn't rewind stdin handle: '$!'"); } } else { @@ -243,7 +247,7 @@ sub write_content { sub setup_content { my $self = shift; - if ( $self->has_stdin && $self->should_setup_content ) { + if ( $self->should_setup_content && $self->has_stdin ) { $self->write_content($self->stdin); } } @@ -263,7 +267,7 @@ sub setup_stdin { $self->{restore}->{stdin} = $stdin; } - STDIN->fdopen( $self->stdin, '<' ) + open( STDIN, '<&' . fileno($self->stdin) ) or croak("Couldn't dup stdin handle to STDIN: '$!'"); } else { @@ -299,7 +303,7 @@ sub setup_stdout { $self->{restore}->{stdout} = $stdout; } - STDOUT->fdopen( $self->stdout, '>' ) + open( STDOUT, '>&' . fileno($self->stdout) ) or croak("Couldn't dup stdout handle to STDOUT: '$!'"); } else { @@ -335,8 +339,8 @@ sub setup_stderr { $self->{restore}->{stderr} = $stderr; } - STDERR->fdopen( $self->stderr, '>' ) - or croak("Couldn't dup stderr handle to STDERR: '$!'"); + open( STDERR, '>&' . fileno($self->stderr) ) + or croak("Couldn't dup stdout handle to STDOUT: '$!'"); } else { @@ -388,7 +392,14 @@ sub response { $response->protocol('HTTP/1.1'); while ( my $line = readline($self->stdout) ) { - $message .= $line; + + if ( !$message && $line =~ /^\x0d?\x0a$/ ) { + next; + } + else { + $message .= $line; + } + last if $message =~ /\x0d?\x0a\x0d?\x0a$/; } @@ -431,7 +442,7 @@ sub response { } if ( !$response->date ) { - $response->date(time); + $response->date(time()); } if ( $params{headers_only} ) { @@ -484,18 +495,27 @@ sub response { sub restore { my $self = shift; - if ( $self->should_restore ) { - - $self->restore_environment; - $self->restore_stdin; - $self->restore_stdout; - $self->restore_stderr; + if ( !$self->should_restore ) { + croak("An attempt was made to restore environment variables and STD handles which has not been saved."); + } - $self->{restore} = {}; + if ( !$self->is_setup ) { + croak("An attempt was made to restore environment variables and STD handles which has not been setup."); + } - $self->is_restored(1); + if ( $self->is_restored ) { + croak("An attempt was made to restore environment variables and STD handles which has already been restored."); } + $self->restore_environment; + $self->restore_stdin; + $self->restore_stdout; + $self->restore_stderr; + + $self->{restore} = {}; + + $self->is_restored(1); + return $self; } @@ -516,7 +536,7 @@ sub restore_stdin { if ( $self->should_dup ) { - STDIN->fdopen( $stdin, '<' ) + STDIN->fdopen( fileno($stdin), '<' ) or croak("Couldn't restore STDIN: '$!'"); } else { @@ -528,7 +548,7 @@ sub restore_stdin { if ( $self->should_rewind ) { seek( $self->stdin, 0, SEEK_SET ) - or croak("Couldn't seek stdin handle: '$!'"); + or croak("Couldn't rewind stdin handle: '$!'"); } } } @@ -545,7 +565,7 @@ sub restore_stdout { STDOUT->flush or croak("Couldn't flush STDOUT: '$!'"); - STDOUT->fdopen( $stdout, '>' ) + STDOUT->fdopen( fileno($stdout), '>' ) or croak("Couldn't restore STDOUT: '$!'"); } else { @@ -557,7 +577,7 @@ sub restore_stdout { if ( $self->should_rewind ) { seek( $self->stdout, 0, SEEK_SET ) - or croak("Couldn't seek stdout handle: '$!'"); + or croak("Couldn't rewind stdout handle: '$!'"); } } } @@ -574,7 +594,7 @@ sub restore_stderr { STDERR->flush or croak("Couldn't flush STDERR: '$!'"); - STDERR->fdopen( $stderr, '>' ) + STDERR->fdopen( fileno($stderr), '>' ) or croak("Couldn't restore STDERR: '$!'"); } else { @@ -586,7 +606,7 @@ sub restore_stderr { if ( $self->should_rewind ) { seek( $self->stderr, 0, SEEK_SET ) - or croak("Couldn't seek stderr handle: '$!'"); + or croak("Couldn't rewind stderr handle: '$!'"); } } } @@ -594,7 +614,7 @@ sub restore_stderr { sub DESTROY { my $self = shift; - if ( $self->should_restore && $self->is_setuped && !$self->is_restored ) { + if ( $self->should_restore && $self->is_setup && !$self->is_restored ) { $self->restore; } } @@ -627,7 +647,7 @@ HTTP::Request::AsCGI - Setup a CGI environment from a HTTP::Request $stdout = $c->stdout; - # environment and descriptors will automatically be restored + # environment and descriptors is automatically restored # when $c is destructed. } @@ -643,10 +663,76 @@ Provides a convinient way of setting up an CGI environment from a HTTP::Request. =over 4 -=item new ( $request [, key => value ] ) +=item * new + +Contructor + + HTTP::Request->new( $request, %environment ); + + HTTP::Request->new( request => $request, environment => \%environment ); + +=over 8 + +=item * request -Contructor, first argument must be a instance of HTTP::Request -followed by optional pairs of environment key and value. + request => HTTP::Request->new( GET => 'http://www.host.com/' ) + +=item * stdin + +Filehandle to be used as C, defaults to a temporary file. If value is +C, C will be left as is. + + stdin => IO::File->new_tmpfile + stdin => IO::String->new + stdin => $fh + stdin => undef + +=item * stdout + +Filehandle to be used as C, defaults to a temporary file. If value is +C, C will be left as is. + + stdout => IO::File->new_tmpfile + stdout => IO::String->new + stdout => $fh + stdout => undef + +=item * stderr + +Filehandle to be used as C, defaults to C. If value is C, +C will be left as is. + + stderr => IO::File->new_tmpfile + stderr => IO::String->new + stderr => $fh + stderr => undef + +=item * environment + + environment => \%ENV + environment => { PATH => '/bin:/usr/bin' } + +=item * dup + + dup => 0 + dup => 1 + +=item * restore + + restore => 0 + restore => 1 + +=item * rewind + + rewind => 0 + rewind => 1 + +=item * content + + content => 0 + content => 1 + +=back =item environment @@ -672,12 +758,12 @@ Returns a HTTP::Response. Can only be called after restore. =item stdin Accessor for handle that will be used for STDIN, must be a real seekable -handle with an file descriptor. Defaults to a tempoary IO::File instance. +handle with an file descriptor. Defaults to a temporary IO::File instance. =item stdout Accessor for handle that will be used for STDOUT, must be a real seekable -handle with an file descriptor. Defaults to a tempoary IO::File instance. +handle with an file descriptor. Defaults to a temporary IO::File instance. =item stderr