From 9731c038acf73a68352fc622cf742b5940a517ef Mon Sep 17 00:00:00 2001 From: franck cuny Date: Thu, 25 Jun 2009 11:01:13 +0200 Subject: add dep --- lib/MooseX/UserAgent/Async.pm | 34 +++++++++++++++++++++++++++++++ lib/MooseX/UserAgent/Cache.pm | 45 +++++++++++++++++++++++++++++++++++++++++ lib/MooseX/UserAgent/Config.pm | 22 ++++++++++++++++++++ lib/MooseX/UserAgent/Content.pm | 26 ++++++++++++++++++++++++ 4 files changed, 127 insertions(+) create mode 100644 lib/MooseX/UserAgent/Async.pm create mode 100644 lib/MooseX/UserAgent/Cache.pm create mode 100644 lib/MooseX/UserAgent/Config.pm create mode 100644 lib/MooseX/UserAgent/Content.pm (limited to 'lib/MooseX/UserAgent') 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; -- cgit 1.4.1