summary refs log tree commit diff
path: root/lib/MooseX
diff options
context:
space:
mode:
Diffstat (limited to 'lib/MooseX')
-rw-r--r--lib/MooseX/UserAgent/Async.pm34
-rw-r--r--lib/MooseX/UserAgent/Cache.pm45
-rw-r--r--lib/MooseX/UserAgent/Config.pm22
-rw-r--r--lib/MooseX/UserAgent/Content.pm26
4 files changed, 127 insertions, 0 deletions
diff --git a/lib/MooseX/UserAgent/Async.pm b/lib/MooseX/UserAgent/Async.pm
new file mode 100644
index 0000000..4adcf9a
--- /dev/null
+++ b/lib/MooseX/UserAgent/Async.pm
@@ -0,0 +1,34 @@
+package MooseX::UserAgent::Async;
+
+use Moose::Role;
+with qw/MooseX::UserAgent::Config MooseX::UserAgent::Content
+    MooseX::UserAgent::Cache/;
+
+use AnyEvent::HTTP;
+use HTTP::Response;
+
+sub fetch {
+    my ( $self, $url ) = @_;
+    my $status = AnyEvent->condvar;
+
+    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 {
+        my ( $data, $headers ) = @_;
+        my $response = HTTP::Response->new;
+        $response->content($data);
+        $response->code(delete $headers->{Status});
+        foreach my $header ( keys %$headers ) {
+            $response->header( $header => $headers->{$header} );
+        }
+        $self->store_ua_cache($url, $response);
+        $status->send($response);
+    };
+    return $status->recv;
+}
+
+1;
diff --git a/lib/MooseX/UserAgent/Cache.pm b/lib/MooseX/UserAgent/Cache.pm
new file mode 100644
index 0000000..f593dc7
--- /dev/null
+++ b/lib/MooseX/UserAgent/Cache.pm
@@ -0,0 +1,45 @@
+package MooseX::UserAgent::Cache;
+
+use Moose::Role;
+use Cache::FileCache;
+
+has 'ua_cache' => (
+    is      => 'rw',
+    isa     => 'Object',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        Cache::FileCache->new(
+            {
+                cache_root => $self->useragent_conf->{cache}->{root},
+                default_expires_in =>
+                    $self->useragent_conf->{cache}->{expires},
+                namespace => $self->useragent_conf->{cache}->{namespace}
+            }
+        );
+    }
+);
+
+sub get_ua_cache {
+    my ( $self, $url ) = @_;
+    if ( $self->useragent_conf->{cache}->{use_cache} ) {
+        my $ref = $self->ua_cache->get($url);
+        if ( defined $ref && $ref->{LastModified} ne '' ) {
+            return $ref->{LastModified};
+        }
+    }
+}
+
+sub store_ua_cache {
+    my ( $self, $url, $res ) = @_;
+    if ( $self->useragent_conf->{ cache }->{ use_cache } ) {
+        $self->ua_cache->set(
+            $url,
+            {   ETag         => $res->header( 'Etag' )          || '',
+                LastModified => $res->header( 'Last-Modified' ) || ''
+            }
+        );
+    }
+}
+
+1;
diff --git a/lib/MooseX/UserAgent/Config.pm b/lib/MooseX/UserAgent/Config.pm
new file mode 100644
index 0000000..b468e4c
--- /dev/null
+++ b/lib/MooseX/UserAgent/Config.pm
@@ -0,0 +1,22 @@
+package MooseX::UserAgent::Config;
+
+use Moose::Role;
+
+has 'agent' => (
+    isa     => 'Object',
+    is      => 'rw',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        my $ua   = LWP::UserAgent->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;
+    }
+);
+
+1;
diff --git a/lib/MooseX/UserAgent/Content.pm b/lib/MooseX/UserAgent/Content.pm
new file mode 100644
index 0000000..0cae0df
--- /dev/null
+++ b/lib/MooseX/UserAgent/Content.pm
@@ -0,0 +1,26 @@
+package MooseX::UserAgent::Content;
+
+use Encode;
+use Moose::Role;
+use Compress::Zlib;
+use HTML::Encoding 'encoding_from_http_message';
+
+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;