summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-06-25 11:01:48 +0200
committerfranck cuny <franck@lumberjaph.net>2009-06-25 11:01:48 +0200
commitce4eb9214f96b8e7351a918551702bc79fafb54f (patch)
tree12d8c3a4a4faec88b6f1ebc699ffe019a3ef6d08
parentadd dep (diff)
downloadmoosex-useragent-ce4eb9214f96b8e7351a918551702bc79fafb54f.tar.gz
split components in roles, start to update POD
-rw-r--r--lib/MooseX/UserAgent.pm112
1 files changed, 24 insertions, 88 deletions
diff --git a/lib/MooseX/UserAgent.pm b/lib/MooseX/UserAgent.pm
index 72c2fa1..edcd5dd 100644
--- a/lib/MooseX/UserAgent.pm
+++ b/lib/MooseX/UserAgent.pm
@@ -1,79 +1,31 @@
 package MooseX::UserAgent;
 
-use Moose::Role;
-
 our $VERSION = '0.2.0';
 
-use Encode;
+use Moose::Role;
+with qw/MooseX::UserAgent::Config MooseX::UserAgent::Content
+    MooseX::UserAgent::Cache/;
+
+use URI;
+use HTTP::Request;
 use HTTP::Response;
-use LWPx::ParanoidAgent;
-use HTML::Encoding 'encoding_from_http_message';
-use Compress::Zlib;
-
-has 'agent' => (
-    isa     => 'Object',
-    is      => 'rw',
-    lazy    => 1,
-    default => sub {
-        my $self = shift;
-        my $ua   = LWPx::ParanoidAgent->new;
-
-        my $conf = $self->useragent_conf;
-        $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;
-    }
-);
+use LWP::UserAgent;
 
 sub fetch {
     my ( $self, $url ) = @_;
 
     my $req = HTTP::Request->new( GET => URI->new( $url ) );
 
-    $req->header('Accept-Encoding', 'gzip');
-
-    if ( $self->context->{ useragent }->{ use_cache } ) {
-        my $ref = $self->cache->get( $url );
-        if ( defined $ref && $ref->{ LastModified } ne '' ) {
-            $req->header( 'If-Modified-Since' => $ref->{ LastModified } );
-        }
-    }
+    $req->header( 'Accept-Encoding', 'gzip' );
+    my $last_modified = $self->get_ua_cache($url);
+    $req->header( 'If-Modified-Since' => $last_modified )
+        if $last_modified;
 
     my $res = $self->agent->request( $req );
-
-    if ( $self->context->{ useragent }->{ use_cache } ) {
-        $self->cache->set(
-            $url,
-            {   ETag         => $res->header( 'Etag' )          || '',
-                LastModified => $res->header( 'Last-Modified' ) || ''
-            }
-        );
-    }
-
+    $self->store_ua_cache($url, $res);
     $res;
 }
 
-sub get_content {
-    my ( $self, $res ) = @_;
-
-    my $enc = encoding_from_http_message($res);
-
-    my $content = $res->content;
-    if ( $res->content_encoding && $res->content_encoding eq 'gzip' ) {
-        $content = Compress::Zlib::memGunzip($content);
-    }
-
-    if ( $enc && $enc !~ /utf-8/i ) {
-        $content = $res->decoded_content( raise_error => 1 );
-        if ($@) {
-            $content = Encode::decode( $enc, $content );
-        }
-    }
-    $content;
-}
-
 1;
 
 __END__
@@ -105,36 +57,20 @@ RTGI::Role::UserAgent - Fetch an url using LWP as the HTTP library
     mail: 'bot@rtgi.fr'
     max_size: 3000000
     timeout: 30
-
-    --- kwalify schema
-    "use_cache":
-      name: use_cache
-      desc: use cache
-      required: true
-      type: int
-    "name":
-      name: name
-      desc: useragent string
-      required: true
-      type: str
-    "mail":
-      name: mail
-      desc: mail for the useragent
-      required: true
-      type: str
-    "timeout":
-      name: timeout
-      desc: timeout
-      required: true
-      type: int
-    "max_size":
-      name: max_size
-      desc: max size
-      required: true
-      type: int
+    cache:
+      use_cache: 1
+      root: /tmp
+      default_expires_in: 5 days
+      namespace: my::useragent
 
 =head1 DESCRIPTION
 
+This is a role which provides a useragent to a Moose Class. 
+
+The role will do the caching for you if you need it, using Cache::*Cache
+modules. By default it uses Cache::FileCache, but you can use any Cache
+modules you want.
+
 =head2 METHODS
 
 =over 4
@@ -167,7 +103,7 @@ This method will return a content in utf8.
 
 =head1 AUTHOR
 
-franck cuny  C<< <franck.cuny@rtgi.fr> >>
+franck cuny  C<< <franck@lumberjaph.net> >>
 
 =head1 LICENCE AND COPYRIGHT