Skip Menu |
 

This queue is for tickets about the POE-Component-Client-HTTP CPAN distribution.

Report information
The Basics
Id: 8454
Status: resolved
Priority: 0/
Queue: POE-Component-Client-HTTP

People
Owner: Nobody in particular
Requestors: britzt [...] student.ethz.ch
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: POE::Component::Client::HTTP with compression
From: Thibaut Britz <britzt [...] student.ethz.ch>
To: rcaputo [...] pobox.com
Date: Tue, 02 Nov 2004 16:29:44 +0100
Download (untitled) / with headers
text/plain 248b
Hi, I added a few things to the latest version so that the module now also supports compressed transfers. They are very handy because they save a lot of bandwith. I also added it in the documentation. The feature is disabled by default. Thibaut
Download POE-Component-Client-HTTP-0.66.tar.gz
application/x-compressed-tar 29.6k

Message body not shown because it is not plain text.

Download (untitled) / with headers
text/plain 1.2k
[britzt@student.ethz.ch - Tue Nov 16 04:53:23 2004]: Show quoted text
> Hi, > > I added a few things to the latest version so that the module now also > supports compressed transfers. They are very handy because they save a > lot of bandwith. I also added it in the documentation. > The feature is disabled by default. > > Thibaut >
the new version of HTTP::Message now has a decoded_content method which does something similar, so the returned HTTP::Response object will also have it. Your version doesn't do error handling and Gisle's is too harsh (it dies). both versions don't handle the 'compress' method. i'd personally do something like: if ($response->is_success and my $encoding = $Response->content_encoding) { my $content = $response->content; if ($encoding =~ /gzip/i) { $content = Compress::Zlib::memGunzip(\$content); } elsif ($encoding =~ /deflate/i) { if (my $i = Compress::Zlib::inflateInit) { $content = $i->inflate(\$content) } else { $content = undef; } } elsif ($encoding =~ /compress/i) { $content = Compress::Zlib::uncompress(\$content); } ## if decompression fails (and it does sometimes) ... unless (defined $content) { ## Reissue request without accept-encoding } }
From: Thibaut
Download (untitled) / with headers
text/plain 1.4k
Show quoted text
> [britzt@student.ethz.ch - Tue Nov 16 04:53:23 2004]: >
> > Hi, > > > > I added a few things to the latest version so that the module now
> also
> > supports compressed transfers. They are very handy because they save
> a
> > lot of bandwith. I also added it in the documentation. > > The feature is disabled by default. > > > > Thibaut > >
> > the new version of HTTP::Message now has a decoded_content method > which > does something similar, so the returned HTTP::Response object will > also > have it. Your version doesn't do error handling and Gisle's is too > harsh (it dies). both versions don't handle the 'compress' method. > i'd > personally do something like: > > if ($response->is_success and my $encoding = $Response-
> >content_encoding)
> { > my $content = $response->content; > > if ($encoding =~ /gzip/i) > { > $content = Compress::Zlib::memGunzip(\$content); > } > elsif ($encoding =~ /deflate/i) > { > if (my $i = Compress::Zlib::inflateInit) > { > $content = $i->inflate(\$content) > } > else { $content = undef; } > } > elsif ($encoding =~ /compress/i) > { > $content = Compress::Zlib::uncompress(\$content); > } > > ## if decompression fails (and it does sometimes) ... > unless (defined $content) > { > ## Reissue request without accept-encoding > } > }
Yes, that would be better. I just assumed that the server would only send back compressed data if the client requested it.
Download (untitled) / with headers
text/plain 336b
[guest - Wed Dec 1 08:19:47 2004]: Show quoted text
> Yes, that would be better. > > I just assumed that the server would only send back compressed data if > the client requested it.
you are correct, the client must request it first. but the server may incorrectly compress it (bad data, sending encoding tag without actually compressing it, etc.).
Download (untitled) / with headers
text/plain 181b
Could you attach a diff between 0.65 and your new version, so we can look at what you did without having to do this ourselves? Please make sure it is a unified format diff (diff -u)
Download (untitled) / with headers
text/plain 374b
On Tue Apr 26 17:00:40 2005, MARTIJN wrote: Show quoted text
> Could you attach a diff between 0.65 and your new version, so we can > look at what you did without having to do this ourselves? Please > make sure it is a unified format diff (diff -u)
I checked out 0.65 and built the diff. My day's winding down, so I'm just attaching it here rather than figure out where the code should go.
--- POE-Component-Client-HTTP-0.65-orig/HTTP.pm 2006-03-23 23:32:54.000000000 -0500 +++ POE-Component-Client-HTTP-0.66/HTTP.pm 2004-11-02 10:23:08.000000000 -0500 @@ -1,4 +1,4 @@ -# $Id: HTTP.pm 114 2004-10-02 15:37:11Z rcaputo $ +# $Id: HTTP.pm,v 1.58 2004/10/02 15:37:11 rcaputo Exp $ # License and documentation are after __END__. package POE::Component::Client::HTTP; @@ -9,7 +9,7 @@ sub DEBUG_DATA () { 0 } use vars qw($VERSION); -$VERSION = '0.65'; +$VERSION = '0.66'; use Carp qw(croak); use POSIX; @@ -95,6 +95,17 @@ eval "sub HAS_SSL () { $has_ssl }"; } + +# Bring in gzip/deflate support +BEGIN { + my $has_gzip = 0; + eval { require Compress::Zlib; + $has_gzip=1; + }; + + eval "sub HAS_GZIP () { $has_gzip }"; +} + #------------------------------------------------------------------------------ # Spawn a new PoCo::Client::HTTP session. This basically is a # constructor, but it isn't named "new" because it doesn't create a @@ -152,7 +163,8 @@ my $no_proxy = delete $params{NoProxy}; my $proxy = delete $params{Proxy}; my $frmax = delete $params{FollowRedirects}; - + my $compression = delete $params{UseCompression}; + # Process HTTP_PROXY and NO_PROXY environment variables. $proxy = $ENV{HTTP_PROXY} || $ENV{http_proxy} unless defined $proxy; @@ -225,6 +237,7 @@ protocol => $protocol, max_size => $max_size, streaming => $streaming, + compression => $compression, }, ); @@ -343,7 +356,13 @@ and length $http_request->from ); } - + + #Add a Accept-Encoding header to get gzipped content if available + if (defined $heap->{compression}) + { + $http_request->header("Accept-Encoding" => "gzip,deflate"); + } + # Create a progress postback if requested. my $progress_postback; $progress_postback = $sender->postback($progress_event, $http_request, $tag) @@ -1173,6 +1192,16 @@ } } } + + # Check if data is compressed and decompress it. + if (HAS_GZIP and $response->header('Content-Encoding') =~m/gzip/io) + { + $response->content(Compress::Zlib::memGunzip($response->content())); + } + elsif (HAS_GZIP and $response->header('Content-Encoding') =~m/deflate/io) + { + $response->content(Compress::Zlib::uncompress($response->content())); + } $request->[REQ_POSTBACK]->($response); } @@ -1382,6 +1411,12 @@ C<Timeout> specifies the amount of time a HTTP request will wait for an answer. This defaults to 180 seconds (three minutes). +=item UseCompression => 1 + +C<UseCompression> specifies if we request compressed answers if the +server supports it. Default is disabled. + + =back Sessions communicate asynchronously with PoCo::Client::HTTP. They
From: guest
Download (untitled) / with headers
text/plain 1.6k
On Thu Mar 23 23:48:33 2006, RCAPUTO wrote: Show quoted text
> On Tue Apr 26 17:00:40 2005, MARTIJN wrote:
> > Could you attach a diff between 0.65 and your new version, so we can > > look at what you did without having to do this ourselves? Please > > make sure it is a unified format diff (diff -u)
> > I checked out 0.65 and built the diff. My day's winding down, so I'm > just attaching it here rather than figure out where the code should go.
the logic from http://rt.cpan.org/Ticket/Display.html?id=8454#txn-116208 seems better since it handles the 'compress' encoding in addition to 'gzip' and 'deflate'. plus 'deflate' is handled properly (see below) and the request is retried without compression if there's a compression problem (which i've seen happen frequently). <rfc:2616> gzip An encoding format produced by the file compression program "gzip" (GNU zip) as described in RFC 1952 [25]. This format is a Lempel-Ziv coding (LZ77) with a 32 bit CRC. compress The encoding format produced by the common UNIX file compression program "compress". This format is an adaptive Lempel-Ziv-Welch coding (LZW). Use of program names for the identification of encoding formats is not desirable and is discouraged for future encodings. Their use here is representative of historical practice, not good design. For compatibility with previous implementations of HTTP, applications SHOULD consider "x-gzip" and "x-compress" to be equivalent to "gzip" and "compress" respectively. deflate The "zlib" format defined in RFC 1950 [31] in combination with the "deflate" compression mechanism described in RFC 1951 [29]. </rfc:2616>
this needs to be implemented as a Filter so it works with 'Streaming'
Download (untitled) / with headers
text/plain 251b
I've committed preliminary support for filter-based HTTP compression, but it's commented out. This feature is stalled until I can find a suitable Perl module for decompressing gzip streams. We'll need a POE::Filter module based on whatever turns up.
Download (untitled) / with headers
text/plain 287b
patch against current SVN and rocco's last work. includes a test... but I think I forgot to add a SKIP block for clients without Compress::Zlib installed. short version: using a filter is a Bad Idea with Content-Encoding, IMO. My solution works. Bug me about it on IRC if you like :)
diff -uwrN --exclude='*~' --exclude=.svn poco-client-http/lib/POE/Component/Client/HTTP/RequestFactory.pm poco-client-http-gzip/lib/POE/Component/Client/HTTP/RequestFactory.pm --- poco-client-http/lib/POE/Component/Client/HTTP/RequestFactory.pm 2006-10-23 15:59:52.000000000 -0700 +++ poco-client-http-gzip/lib/POE/Component/Client/HTTP/RequestFactory.pm 2006-10-23 16:33:34.000000000 -0700 @@ -429,4 +429,42 @@ $_[1] = $proxy; } +sub decode_content { + my ($self, $response, $ce) = @_; + + if (zlib_ok() and $ce eq 'gzip') { + my $content = $response->content; + my $decoded = Compress::Zlib::memGunzip($content); + + if (defined $decoded) { + $response->content($decoded); + } + } + +} + +## stolen from libwww-perl lib/Net/HTTP/Methods.pm +BEGIN { +my $zlib_ok; + +sub zlib_ok { + return $zlib_ok if defined $zlib_ok; + + # Try to load Compress::Zlib. + local $@; + local $SIG{__DIE__}; + $zlib_ok = 0; + + eval { + require Compress::Zlib; + Compress::Zlib->VERSION(1.10); + $zlib_ok++; + }; + + return $zlib_ok; +} + +} # BEGIN + + 1; diff -uwrN --exclude='*~' --exclude=.svn poco-client-http/lib/POE/Component/Client/HTTP/Request.pm poco-client-http-gzip/lib/POE/Component/Client/HTTP/Request.pm --- poco-client-http/lib/POE/Component/Client/HTTP/Request.pm 2006-10-23 15:59:52.000000000 -0700 +++ poco-client-http-gzip/lib/POE/Component/Client/HTTP/Request.pm 2006-10-23 16:30:16.000000000 -0700 @@ -167,6 +167,12 @@ # if we are. that there's no ARG1 lets the client know we're done # with the content in the latter case if ($self->[REQ_STATE] & RS_DONE) { + + DEBUG and warn "checking $response for content-encoding ", $self->[REQ_ID]; + if (defined (my $ce = $response->header('content-encoding'))) { + $self->[REQ_FACTORY]->decode_content($response, $ce); + } + DEBUG and warn "done; returning $response for ", $self->[REQ_ID]; $self->[REQ_POSTBACK]->($self->[REQ_RESPONSE]); $self->[REQ_STATE] |= RS_POSTED; diff -uwrN --exclude='*~' --exclude=.svn poco-client-http/lib/POE/Component/Client/HTTP.pm poco-client-http-gzip/lib/POE/Component/Client/HTTP.pm --- poco-client-http/lib/POE/Component/Client/HTTP.pm 2006-10-23 15:59:55.000000000 -0700 +++ poco-client-http-gzip/lib/POE/Component/Client/HTTP.pm 2006-10-23 16:40:22.000000000 -0700 @@ -74,7 +74,17 @@ ",", grep { exists $te_filters{$_} } qw(x-bzip2 gzip x-gzip deflate compress chunked identity) -); +) if 0; + +# The above defaults to 'chunked,identity' which is technically +# correct but arguably useless. It also stomps on gzip'd transport +# because in the World Wild Web, Accept-Encoding is used to indicate +# gzip readiness, but the server responds with 'Content-Encoding: gzip', +# completely outside of TE encoding. +# +# FIXME: should zlib_ok() be imported? +$accept_encoding = 'gzip' + if POE::Component::Client::HTTP::RequestFactory::zlib_ok(); my %supported_schemes = ( http => 1, diff -uwrN --exclude='*~' --exclude=.svn poco-client-http/t/58_gzipped_content.t poco-client-http-gzip/t/58_gzipped_content.t --- poco-client-http/t/58_gzipped_content.t 1969-12-31 16:00:00.000000000 -0800 +++ poco-client-http-gzip/t/58_gzipped_content.t 2006-10-23 16:30:47.000000000 -0700 @@ -0,0 +1,177 @@ +#!/usr/bin/perl +# $Id: 53_response_parser.t 242 2006-03-23 23:46:18Z rcaputo $ +# vim: filetype=perl + +# Generic response parser testing, especially for cases where +# POE::Component::Client::HTTP generates the wrong response. + +use warnings; +use strict; + +use IO::Socket::INET; +use Socket '$CRLF', '$LF', '$CR'; +use HTTP::Request::Common 'GET'; + +sub DEBUG () { 0 } + +# The number of tests must match scalar(@tests). +use Test::More tests => 1; + +use POE; +use POE::Component::Client::HTTP; +use POE::Component::Server::TCP; + +use Compress::Zlib; + +my $test_number = 0; + +my @server_ports; + +# A list of test responses, each paired with a subroutine to check +# whether the response was parsed. +# use YAML; + +my $original_content = <<DONE; +<html> + <head> + <title>Sample Document</title> + </head> + <body> + Sample body content + </body> +</html> +DONE + +## content compression lifted from Apache::Dynagzip +## this is functionally equivalent to mod_gzip, etc. +## so we have a "real-world" piece of encoded content + +my $gzipped_content; + +GZIP: { + use constant MAGIC1 => 0x1f ; + use constant MAGIC2 => 0x8b ; + use constant OSCODE => 3 ; + use constant MIN_HDR_SIZE => 10 ; # minimum gzip header size + + # Create the first outgoing portion of the content: + + my $gzipHeader = pack("C" . MIN_HDR_SIZE, MAGIC1, MAGIC2, Z_DEFLATED(), 0,0,0,0,0,0, OSCODE); + $gzipped_content = $gzipHeader; + + my $gzip_handler = deflateInit( -Level => Z_BEST_COMPRESSION(), + -WindowBits => - MAX_WBITS(), + ); + + $_ = $original_content; + + my ($out, $status) = $gzip_handler->deflate(\$_); + unless (length($out)) { + ($out, $status) = $gzip_handler->flush(); + } + + $gzipped_content .= $out; + + # same thing only shorter, but I wanted to go thru all the hoops: + if (0) { + $_ = $original_content; + $gzipped_content = Compress::Zlib::memGzip($_); + } + +} + +my @tests = ( + # Gzipped content decoded correctly. + [ + ( + "HTTP/1.1 200 OK$CRLF" . + "Connection: close$CRLF" . + "Content-Encoding: gzip$CRLF" . + "Content-type: text/plain$CRLF" . + $CRLF . + "$gzipped_content$CRLF" + ), + sub { + my $response = shift; + + ok( + $response->code() == 200 && + $response->content eq $original_content, + "gzip encoded transfers decode correctly" + ); + }, + ], + ); + +# We are testing against a localhost server. +# Don't proxy, because localhost takes on new meaning. +BEGIN { + delete $ENV{HTTP_PROXY}; +} + +# Spawn one server per test response. +{ + foreach (@tests) { + POE::Component::Server::TCP->new( + Address => "127.0.0.1", + Port => 0, + Started => \&register_port, + ClientInputFilter => "POE::Filter::Line", + ClientOutputFilter => "POE::Filter::Stream", + ClientInput => \&parse_next_request, + ); + } + + sub register_port { + push( + @server_ports, + (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0] + ); + } + + sub parse_next_request { + my $input = $_[ARG0]; + + DEBUG and diag "got line: [$input]"; + return if $input ne ""; + + my $response = $tests[$test_number][0]; + $_[HEAP]->{client}->put($response); + + $response =~ s/$CRLF/{CRLF}/g; + DEBUG and diag "sending: [$response]"; + + $_[KERNEL]->yield("shutdown"); + } +} + + +# Spawn the HTTP user-agent component. +POE::Component::Client::HTTP->spawn(); + +# Create a client session to drive the HTTP component. +POE::Session->create( + inline_states => { + _start => sub { + $_[KERNEL]->yield("run_next_test"); + }, + run_next_test => sub { + my $port = $server_ports[$test_number]; + $_[KERNEL]->post( + weeble => request => response => + GET "http://127.0.0.1:${port}/" + ); + }, + response => sub { + my $response = $_[ARG1][0]; + my $test = $tests[$test_number][1]; + $test->($response); + + $_[KERNEL]->yield("run_next_test") if ++$test_number < @tests; + }, + _stop => sub { exit }, # Nasty but expedient. + } + ); + +POE::Kernel->run(); +exit;
Download (untitled) / with headers
text/plain 474b
OK, new patch, against current svn, disregard last patch. includes: automatic request of gzip'd content if Compress::Zlib is present skips same if the request is streaming returns decoded content to client transparently borrows zlib_ok() from LWP tests using compression algorithm lifted from Apache::Dynagzip - which in turns follows apache mod_gzip/mod_deflate skips test if Compress::Zlib is NOT present on system updated PREREQ_PM in Makefile.PL docs NOT updated.
diff -urN --exclude='*~' --exclude=.svn poco-client-http/lib/POE/Component/Client/HTTP/Request.pm poco-client-http-gzip/lib/POE/Component/Client/HTTP/Request.pm --- poco-client-http/lib/POE/Component/Client/HTTP/Request.pm 2006-10-24 11:54:57.000000000 -0700 +++ poco-client-http-gzip/lib/POE/Component/Client/HTTP/Request.pm 2006-10-24 13:36:24.000000000 -0700 @@ -167,6 +167,13 @@ # if we are. that there's no ARG1 lets the client know we're done # with the content in the latter case if ($self->[REQ_STATE] & RS_DONE) { + DEBUG and warn "checking $response for content-encoding ", $self->[REQ_ID]; + if ($response->header('content-encoding')) { + my $content; + eval { $content = $response->decoded_content }; # LWP likes to die() on errors + if ($content) { $response->content($content); } + } + DEBUG and warn "done; returning $response for ", $self->[REQ_ID]; $self->[REQ_POSTBACK]->($self->[REQ_RESPONSE]); $self->[REQ_STATE] |= RS_POSTED; diff -urN --exclude='*~' --exclude=.svn poco-client-http/lib/POE/Component/Client/HTTP.pm poco-client-http-gzip/lib/POE/Component/Client/HTTP.pm --- poco-client-http/lib/POE/Component/Client/HTTP.pm 2006-10-24 11:54:59.000000000 -0700 +++ poco-client-http-gzip/lib/POE/Component/Client/HTTP.pm 2006-10-24 13:39:13.000000000 -0700 @@ -15,6 +15,7 @@ use Carp qw(croak); use HTTP::Response; +use Net::HTTP::Methods; use POE::Component::Client::HTTP::RequestFactory; use POE::Component::Client::HTTP::Request qw(:states :fields); @@ -74,7 +75,16 @@ ",", grep { exists $te_filters{$_} } qw(x-bzip2 gzip x-gzip deflate compress chunked identity) -); +) if 0; + +# The above defaults to 'chunked,identity' which is technically +# correct but arguably useless. It also stomps on gzip'd transport +# because in the World Wild Web, Accept-Encoding is used to indicate +# gzip readiness, but the server responds with 'Content-Encoding: gzip', +# completely outside of TE encoding. +# +# set default here, but DON'T SET later, if the request is streaming. +$accept_encoding = Net::HTTP::Methods::zlib_ok() ? 'gzip' : ''; my %supported_schemes = ( http => 1, @@ -236,7 +246,8 @@ # Add an Accept-Encoding header if we don't have one. if ( !defined($http_request->header('Accept-Encoding')) and - length($accept_encoding) + length($accept_encoding) and + !$heap->{factory}->is_streaming # don't offer encoding for streaming. 'chunked' doesn't count. ) { $http_request->header('Accept-Encoding', $accept_encoding); } diff -urN --exclude='*~' --exclude=.svn poco-client-http/Makefile.PL poco-client-http-gzip/Makefile.PL --- poco-client-http/Makefile.PL 2006-10-24 11:55:01.000000000 -0700 +++ poco-client-http-gzip/Makefile.PL 2006-10-24 14:10:25.000000000 -0700 @@ -9,10 +9,11 @@ open(CHANGES, ">>CHANGES") and close CHANGES; my %prereq = ( - 'POE' => 0.3202, - 'HTTP::Request' => 1.30, - 'HTTP::Response' => 1.37, - 'URI' => 1.24, + 'POE' => 0.3202, + 'HTTP::Request' => 1.30, + 'HTTP::Response' => 1.37, + 'URI' => 1.24, + 'Net::HTTP::Methods' => 0.02, 'POE::Component::Client::Keepalive' => 0.09, ); diff -urN --exclude='*~' --exclude=.svn poco-client-http/t/59_gzipped_content.t poco-client-http-gzip/t/59_gzipped_content.t --- poco-client-http/t/59_gzipped_content.t 1969-12-31 16:00:00.000000000 -0800 +++ poco-client-http-gzip/t/59_gzipped_content.t 2006-10-24 14:20:50.000000000 -0700 @@ -0,0 +1,185 @@ +#!/usr/bin/perl +# $Id$ +# vim: filetype=perl + +# Gzip'd content encoding. + +use warnings; +use strict; + +use IO::Socket::INET; +use Socket '$CRLF', '$LF', '$CR'; +use HTTP::Request::Common 'GET'; + +sub DEBUG () { 0 } + +# The number of tests must match scalar(@tests). +use Test::More; + +use POE; +use POE::Component::Client::HTTP; +use POE::Component::Server::TCP; + +use Net::HTTP::Methods; + +if (Net::HTTP::Methods::zlib_ok()) { + plan tests => 1; +} else { + plan skip_all => 'Compress::Zlib no present'; +} + +# eval this so that if it's NOT present we don't barf before we can call zlib_ok() +eval "use Compress::Zlib"; + +my $test_number = 0; + +my @server_ports; + +# A list of test responses, each paired with a subroutine to check +# whether the response was parsed. +# use YAML; + +my $original_content = <<DONE; +<html> + <head> + <title>Sample Document</title> + </head> + <body> + Sample content + </body> +</html> +DONE + +## content compression lifted from Apache::Dynagzip +## this is functionally equivalent to mod_gzip, etc. +## so we have a "real-world" piece of encoded content + +my $gzipped_content; + +GZIP: { + use constant MAGIC1 => 0x1f ; + use constant MAGIC2 => 0x8b ; + use constant OSCODE => 3 ; + use constant MIN_HDR_SIZE => 10 ; # minimum gzip header size + + # Create the first outgoing portion of the content: + + my $gzipHeader = pack("C" . MIN_HDR_SIZE, MAGIC1, MAGIC2, Z_DEFLATED(), 0,0,0,0,0,0, OSCODE); + $gzipped_content = $gzipHeader; + + my $gzip_handler = deflateInit( -Level => Z_BEST_COMPRESSION(), + -WindowBits => - MAX_WBITS(), + ); + + $_ = $original_content; + + my ($out, $status) = $gzip_handler->deflate(\$_); + unless (length($out)) { + ($out, $status) = $gzip_handler->flush(); + } + + $gzipped_content .= $out; + + # almost the same thing, but I wanted to go thru all the hoops: + if (0) { + $_ = $original_content; + $gzipped_content = Compress::Zlib::memGzip($_); + } + +} + +my @tests = ( + # Gzipped content decoded correctly. + [ + ( + "HTTP/1.1 200 OK$CRLF" . + "Connection: close$CRLF" . + "Content-Encoding: gzip$CRLF" . + "Content-type: text/plain$CRLF" . + $CRLF . + "$gzipped_content$CRLF" + ), + sub { + my $response = shift; + + ok( + $response->code() == 200 && + $response->content eq $original_content, + "gzip encoded transfers decode correctly" + ); + }, + ], + ); + +# We are testing against a localhost server. +# Don't proxy, because localhost takes on new meaning. +BEGIN { + delete $ENV{HTTP_PROXY}; +} + +# Spawn one server per test response. +{ + foreach (@tests) { + POE::Component::Server::TCP->new( + Address => "127.0.0.1", + Port => 0, + Started => \&register_port, + ClientInputFilter => "POE::Filter::Line", + ClientOutputFilter => "POE::Filter::Stream", + ClientInput => \&parse_next_request, + ); + } + + sub register_port { + push( + @server_ports, + (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0] + ); + } + + sub parse_next_request { + my $input = $_[ARG0]; + + DEBUG and diag "got line: [$input]"; + return if $input ne ""; + + my $response = $tests[$test_number][0]; + $_[HEAP]->{client}->put($response); + + $response =~ s/$CRLF/{CRLF}/g; + DEBUG and diag "sending: [$response]"; + + $_[KERNEL]->yield("shutdown"); + } +} + + +# Spawn the HTTP user-agent component. +POE::Component::Client::HTTP->spawn(); + +# Create a client session to drive the HTTP component. +POE::Session->create( + inline_states => { + _start => sub { + $_[KERNEL]->yield("run_next_test"); + }, + run_next_test => sub { + my $port = $server_ports[$test_number]; + $_[KERNEL]->post( + weeble => request => response => + GET "http://127.0.0.1:${port}/" + ); + }, + response => sub { + my $response = $_[ARG1][0]; + my $test = $tests[$test_number][1]; + $test->($response); + + $_[KERNEL]->yield("run_next_test") if ++$test_number < @tests; + }, + _stop => sub { exit }, # Nasty but expedient. + } +); + +POE::Kernel->run(); +exit;
Thanks, Rob. Your patch is applied and committed as revision 294.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.