root/trunk/plagger/lib/Plagger/UserAgent.pm

Revision 1248 (checked in by miyagawa, 14 years ago)

Update UserAgent?::AuthenRequest? to use $agent->credentials() instead of overriding request() method.
Hack Publish::MT and XMLRPC::Lite internal to use Plagger::UserAgent? instead of LWP.

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::UserAgent;
2 use strict;
3 use base qw( LWP::UserAgent );
4
5 use Plagger::Cookies;
6 use URI::Fetch 0.06;
7
8 sub new {
9     my $class = shift;
10     my $self  = $class->SUPER::new(@_);
11
12     my $conf = Plagger->context->conf->{user_agent};
13     if ($conf->{cookies}) {
14         $self->cookie_jar( Plagger::Cookies->create($conf->{cookies}) );
15     }
16
17     $self->agent( $conf->{agent} || "Plagger/$Plagger::VERSION (http://plagger.org/)" );
18     $self->timeout( $conf->{timeout} || 15 );
19     $self->env_proxy();
20
21     $self;
22 }
23
24 sub fetch {
25     my($self, $url, $plugin, $opt) = @_;
26
27     my $res = URI::Fetch->fetch($url,
28         UserAgent => $self,
29         $plugin ? (Cache => $plugin->cache) : (),
30         ForceResponse => 1,
31         ($opt ? %$opt : ()),
32     );
33
34     if ($res && $url =~ m!^file://!) {
35         $res->content_type( Plagger::Util::mime_type_of(URI->new($url)) );
36     }
37
38     $res;
39 }
40
41 sub request {
42     my $self = shift;
43     my($req) = @_;
44     Plagger->context->run_hook('useragent.request', { ua => $self, url => $req->uri });
45     $self->SUPER::request(@_);
46 }
47
48 sub mirror {
49     my($self, $request, $file) = @_;
50
51     unless (ref($request)) {
52         return $self->SUPER::mirror($request, $file);
53     }
54
55     # below is copied from LWP::UserAgent
56     if (-e $file) {
57         my($mtime) = (stat($file))[9];
58         if($mtime) {
59             $request->header('If-Modified-Since' =>
60                              HTTP::Date::time2str($mtime));
61         }
62     }
63     my $tmpfile = "$file-$$";
64
65     my $response = $self->request($request, $tmpfile);
66     if ($response->is_success) {
67
68         my $file_length = (stat($tmpfile))[7];
69         my($content_length) = $response->header('Content-length');
70
71         if (defined $content_length and $file_length < $content_length) {
72             unlink($tmpfile);
73             die "Transfer truncated: " .
74                 "only $file_length out of $content_length bytes received\n";
75         }
76         elsif (defined $content_length and $file_length > $content_length) {
77             unlink($tmpfile);
78             die "Content-length mismatch: " .
79                 "expected $content_length bytes, got $file_length\n";
80         }
81         else {
82             # OK
83             if (-e $file) {
84                 # Some dosish systems fail to rename if the target exists
85                 chmod 0777, $file;
86                 unlink $file;
87             }
88             rename($tmpfile, $file) or
89                 die "Cannot rename '$tmpfile' to '$file': $!\n";
90
91             if (my $lm = $response->last_modified) {
92                 # make sure the file has the same last modification time
93                 utime $lm, $lm, $file;
94             }
95         }
96     }
97     else {
98         unlink($tmpfile);
99     }
100     return $response;
101 }
102
103 1;
104
Note: See TracBrowser for help on using the browser.