up

7 files changed, 103 insertions, 44 deletions

diff --git a/lib/MooseX/UserAgent.pm b/lib/MooseX/UserAgent.pm
index 58ee83f..cc589bc 100644
--- a/lib/MooseX/UserAgent.pm
+++ b/lib/MooseX/UserAgent.pm
@@ -2,35 +2,16 @@ package MooseX::UserAgent;
 
 our $VERSION = '0.2.0';
 
-use URI;
-use HTTP::Request;
-use HTTP::Response;
-use LWP::UserAgent;
-
 use Moose::Role;
 with qw/
     MooseX::UserAgent::Config
     MooseX::UserAgent::Content
     MooseX::UserAgent::Cache
+    MooseX::UserAgent::Generic
     /;
 
 has _LWPLIB => ( isa => 'Str', is => 'ro', default => 'LWP::UserAgent' );
 
-sub fetch {
-    my ( $self, $url ) = @_;
-
-    my $req = HTTP::Request->new( GET => URI->new($url) );
-
-    $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);
-    $self->store_ua_cache( $url, $res );
-    $res;
-}
-
 1;
 
 __END__
diff --git a/lib/MooseX/UserAgent/Async.pm b/lib/MooseX/UserAgent/Async.pm
index b00cc73..8d68384 100644
--- a/lib/MooseX/UserAgent/Async.pm
+++ b/lib/MooseX/UserAgent/Async.pm
@@ -90,6 +90,7 @@ franck cuny  C<< <franck.cuny@rtgi.fr> >>
 
 Copyright (c) 2009, RTGI
 All rights reserved.
+L<http://rtgi.fr/>
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/lib/MooseX/UserAgent/Cache.pm b/lib/MooseX/UserAgent/Cache.pm
index b5fff18..36be242 100644
--- a/lib/MooseX/UserAgent/Cache.pm
+++ b/lib/MooseX/UserAgent/Cache.pm
@@ -62,6 +62,7 @@ franck cuny  C<< <franck.cuny@rtgi.fr> >>
 
 Copyright (c) 2009, RTGI
 All rights reserved.
+L<http://rtgi.fr/>
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/lib/MooseX/UserAgent/Config.pm b/lib/MooseX/UserAgent/Config.pm
index cf453b0..d31a4dd 100644
--- a/lib/MooseX/UserAgent/Config.pm
+++ b/lib/MooseX/UserAgent/Config.pm
@@ -1,23 +1,29 @@
 package MooseX::UserAgent::Config;
 
 use Moose::Role;
+use Carp qw/croak/;
 
 has 'agent' => (
     isa     => 'Object',
     is      => 'rw',
     lazy    => 1,
     default => sub {
-        my $self = shift;
-        my $ua   = $self->_LWPLIB->new;
+        my $self  = shift;
+        my $class = $self->_LWPLIB;
+        eval "  require $class ";
+        if ($@) {
+            croak "can't load " . $self->_LWPLIB . " : " . $@;
+        }
+        my $ua = $self->_LWPLIB->new;
 
-        if (!$self->can('useragent_conf')) {
-            # TODO
+        if ( !$self->can('useragent_conf') ) {
+            croak "no useragent_conf";
         }
         my $conf = $self->useragent_conf;
-        $ua->agent( $conf->{name} ) if $conf->{name};
-        $ua->from( $conf->{mail} )  if $conf->{mail};
+        $ua->agent( $conf->{name} )        if $conf->{name};
+        $ua->from( $conf->{mail} )         if $conf->{mail};
         $ua->max_size( $conf->{max_size} ) if $conf->{max_size};
-        $ua->timeout( $conf->{timeout}   || 180 );
+        $ua->timeout( $conf->{timeout} || 180 );
         $ua;
     }
 );
@@ -107,6 +113,7 @@ franck cuny  C<< <franck.cuny@rtgi.fr> >>
 
 Copyright (c) 2009, RTGI
 All rights reserved.
+L<http://rtgi.fr/>
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/lib/MooseX/UserAgent/Content.pm b/lib/MooseX/UserAgent/Content.pm
index 653b5d9..66dfa41 100644
--- a/lib/MooseX/UserAgent/Content.pm
+++ b/lib/MooseX/UserAgent/Content.pm
@@ -44,6 +44,7 @@ franck cuny  C<< <franck.cuny@rtgi.fr> >>
 
 Copyright (c) 2009, RTGI
 All rights reserved.
+L<http://rtgi.fr>
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/lib/MooseX/UserAgent/Generic.pm b/lib/MooseX/UserAgent/Generic.pm
new file mode 100644
index 0000000..dd1966f
--- /dev/null
+++ b/lib/MooseX/UserAgent/Generic.pm
@@ -0,0 +1,30 @@
+package MooseX::UserAgent::Generic;
+
+our $VERSION = '0.2.0';
+
+use URI;
+use HTTP::Request;
+
+use Moose::Role;
+with qw/
+    MooseX::UserAgent::Config
+    MooseX::UserAgent::Content
+    MooseX::UserAgent::Cache
+    /;
+
+sub fetch {
+    my ( $self, $url ) = @_;
+
+    my $req = HTTP::Request->new( GET => URI->new($url) );
+
+    $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);
+    $self->store_ua_cache( $url, $res );
+    $res;
+}
+
+1;
diff --git a/lib/MooseX/UserAgent/Paranoid.pm b/lib/MooseX/UserAgent/Paranoid.pm
index 61dab94..b33b157 100644
--- a/lib/MooseX/UserAgent/Paranoid.pm
+++ b/lib/MooseX/UserAgent/Paranoid.pm
@@ -1,32 +1,70 @@
 package MooseX::UserAgent::Paranoid;
 
-use URI;
-use HTTP::Request;
-use HTTP::Response;
-use LWPx::ParanoidAgent;
-
 use Moose::Role;
 with qw/
     MooseX::UserAgent::Config 
     MooseX::UserAgent::Content
     MooseX::UserAgent::Cache
+    MooseX::UserAgent::Generic
     /;
 
 has _LWPLIB => ( isa => 'Str', is => 'ro', default => 'LWPx::ParanoidAgent' );
 
-sub fetch {
-    my ( $self, $url ) = @_;
+1;
 
-    my $req = HTTP::Request->new( GET => URI->new($url) );
+__END__
 
-    $req->header( 'Accept-Encoding', 'gzip' );
-    my $last_modified = $self->get_ua_cache($url);
-    $req->header( 'If-Modified-Since' => $last_modified )
-        if $last_modified;
+=head1 NAME
 
-    my $res = $self->agent->request($req);
-    $self->store_ua_cache( $url, $res );
-    $res;
-}
+RTGI::Role::UserAgent::Paranoid - Fetch an url using LWPx::ParanoidAgent
 
-1;
+=head1 SYNOPSIS
+
+    package Foo;
+
+    use Moose;
+    with qw/MooseX::UserAgent::Paranoid/;
+
+    has useragent_conf => (
+        isa     => 'HashRef',
+        default => sub {
+            { name => 'myownbot', };
+        }
+    );
+
+    my $res = $self->fetch($url, $cache);
+    ...
+    my $content = $self->get_content($res);
+
+=head1 DESCRIPTION
+
+=head2 METHODS
+
+=over 4
+
+=item B<fetch>
+
+This method will fetch a given URL. This method handle only the http
+protocol.
+
+If there is a cache configuration, the url will be checked in the cache,
+and if there is a match, a 304 HTTP code will be returned.
+
+Return a HTTP::Response object. 
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=head1 AUTHOR
+
+franck cuny  C<< <franck.cuny@rtgi.fr> >>
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2009, RTGI
+All rights reserved.
+L<http://rtgi.fr/>
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.