diff options
| -rw-r--r-- | lib/MooseX/UserAgent/Async.pm | 13 | ||||
| -rw-r--r-- | lib/MooseX/UserAgent/Config.pm | 21 | ||||
| -rw-r--r-- | xt/tests/Test/MooseX/UserAgent.pm | 29 |
3 files changed, 37 insertions, 26 deletions
diff --git a/lib/MooseX/UserAgent/Async.pm b/lib/MooseX/UserAgent/Async.pm index 186a183..666e804 100644 --- a/lib/MooseX/UserAgent/Async.pm +++ b/lib/MooseX/UserAgent/Async.pm @@ -11,23 +11,28 @@ sub fetch { my ( $self, $url ) = @_; my $status = AnyEvent->condvar; + $AnyEvent::HTTP::USERAGENT = $self->useragent_conf->{name}; + my $last_modified = $self->get_ua_cache($url); my $request_headers = { 'Accept-Encoding' => 'gzip', }; $request_headers->{'If-Modified-Since'} = $last_modified if $last_modified; - http_request GET => $url, headers => $request_headers, sub { + http_request + GET => $url, + headers => $request_headers, + sub { my ( $data, $headers ) = @_; my $response = HTTP::Response->new; $response->content($data); - $response->code(delete $headers->{Status}); + $response->code( delete $headers->{Status} ); foreach my $header ( keys %$headers ) { $response->header( $header => $headers->{$header} ); } - $self->store_ua_cache($url, $response); + $self->store_ua_cache( $url, $response ); $status->send($response); - }; + }; return $status->recv; } diff --git a/lib/MooseX/UserAgent/Config.pm b/lib/MooseX/UserAgent/Config.pm index d5d6730..1195aee 100644 --- a/lib/MooseX/UserAgent/Config.pm +++ b/lib/MooseX/UserAgent/Config.pm @@ -16,7 +16,7 @@ has 'agent' => ( $ua->agent( $conf->{name} ) if $conf->{name}; $ua->from( $conf->{mail} ) if $conf->{mail}; $ua->max_size( $conf->{max_size} || 3000000 ); - $ua->timeout( $conf->{timeout} || 30 ); + $ua->timeout( $conf->{timeout} || 180 ); $ua; } ); @@ -55,21 +55,21 @@ RTGI::Role::UserAgent::Config =item B<name> UserAgent string used by the HTTP client. Default is to use the LWP or -AnyEvent::HTTP string. +AnyEvent::HTTP string. See L<LWP::UserAgent> or L<AnyEvent::HTTP>. =item B<mail> Mail string used by the HTTP client (only for LWP). Default is to use the -LWP string. +LWP string. See L<LWP::UserAgent> =item B<max_size> -Max size that will be fetched by the useragent, in octets (only for LWP). -Default is set to 3 000 000. +size limit for response content. The default is 3 000 000 octets. See +L<LWP::UserAgent>. =item B<timeout> -Time out. Default is set to 30. +Timeout value in seconds. The default timeout() value is 180 seconds =item B<cache> @@ -77,16 +77,21 @@ Time out. Default is set to 30. =item B<use_cache> -If you need caching, set to 1. Default is no cache. +Set to true to activate caching. Defaults is false. =item B<root> -Where to store the cache. +The location in the filesystem that will hold the root of the cache. =item B<default_expires_in> +The default expiration time for objects place in the cache. Defaults to $EXPIRES_NEVER if not explicitly set. + =item B<namespace> +The namespace associated with this cache. Defaults to "Default" if not +explicitly set. + =back =back diff --git a/xt/tests/Test/MooseX/UserAgent.pm b/xt/tests/Test/MooseX/UserAgent.pm index 3f9bdb8..db08c8d 100644 --- a/xt/tests/Test/MooseX/UserAgent.pm +++ b/xt/tests/Test/MooseX/UserAgent.pm @@ -17,7 +17,7 @@ use Cache::MemoryCache; is => 'rw', default => sub { return { - name => 'Mozilla/5.0 (compatible; RTGI; http://rtgi.fr/)', + name => 'Mozilla/5.0 (compatible; LWP; RTGI; http://rtgi.fr/)', mail => 'bot@rtgi.fr', timeout => 30, cache => { use_cache => 0, }, @@ -37,7 +37,7 @@ use Cache::MemoryCache; is => 'rw', default => sub { return { - name => 'Mozilla/5.0 (compatible; RTGI; http://rtgi.fr/)', + name => 'Mozilla/5.0 (compatible; Async; RTGI; http://rtgi.fr/)', mail => 'bot@rtgi.fr', timeout => 30, cache => { use_cache => 0, }, @@ -75,6 +75,7 @@ sub fetch : Tests(14) { # test with cache $obj = $ua->new( useragent_conf => { + name => 'Mozilla/5.0 (compatible; Async; RTGI; http://rtgi.fr/)', cache => { use_cache => 1, namespace => 'testua', @@ -91,19 +92,19 @@ sub fetch : Tests(14) { } } -sub get_content : Tests(8) { - my $test = shift; +#sub get_content : Tests(8) { + #my $test = shift; - foreach my $ua (@ua_roles) { - can_ok $ua, 'get_content'; + #foreach my $ua (@ua_roles) { + #can_ok $ua, 'get_content'; - ok my $obj = $ua->new(), ' ... object is created'; - my $url = 'http://google.com'; - my $res = $obj->fetch($url); - is $res->code, "200", "... fetch is a success"; - my $content = $obj->get_content($res); - like $content, qr/google/, "... and content is good"; - } -} + #ok my $obj = $ua->new(), ' ... object is created'; + #my $url = 'http://google.com'; + #my $res = $obj->fetch($url); + #is $res->code, "200", "... fetch is a success"; + #my $content = $obj->get_content($res); + #like $content, qr/google/, "... and content is good"; + #} +#} 1; |