summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-06-25 15:33:29 +0200
committerfranck cuny <franck@lumberjaph.net>2009-06-25 15:33:29 +0200
commit443918302b9a9fac6c853c77ce49182be38feb6f (patch)
tree24621eb0260fa9a2d250c9906933a28bc18d4cde
parentPOD (diff)
downloadmoosex-useragent-443918302b9a9fac6c853c77ce49182be38feb6f.tar.gz
POD, add useragent string to async, tests
-rw-r--r--lib/MooseX/UserAgent/Async.pm13
-rw-r--r--lib/MooseX/UserAgent/Config.pm21
-rw-r--r--xt/tests/Test/MooseX/UserAgent.pm29
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;