File Coverage

blib/lib/CPAN/MirrorMerger/Agent.pm
Criterion Covered Total %
statement 35 53 66.0
branch 1 10 10.0
condition 1 3 33.3
subroutine 10 11 90.9
pod 0 2 0.0
total 47 79 59.4


line stmt bran cond sub pod time code
1             package CPAN::MirrorMerger::Agent;
2 2     2   14 use strict;
  2         4  
  2         62  
3 2     2   12 use warnings;
  2         4  
  2         69  
4              
5 2     2   11 use Class::Accessor::Lite ro => [qw/furl retry_policy logger/];
  2         5  
  2         14  
6              
7 2     2   1310 use Furl;
  2         47078  
  2         69  
8 2     2   18 use Furl::Response;
  2         4  
  2         35  
9 2     2   12 use Path::Tiny ();
  2         4  
  2         34  
10 2     2   992 use CPAN::MirrorMerger::Logger::Null;
  2         7  
  2         944  
11              
12             sub new {
13 1     1 0 9 my ($class, %args) = @_;
14 1         3 my $retry_policy = delete $args{retry_policy};
15 1   33     12 my $logger = delete $args{logger} || CPAN::MirrorMerger::Logger::Null->instance();
16 1         10 bless {
17             furl => Furl->new(%args),
18             retry_policy => $retry_policy,
19             logger => $logger,
20             }, $class;
21             }
22              
23             sub download {
24 6     6 0 57 my ($self, $url, $path) = @_;
25              
26             # file:///...
27 6 50       41 if ($url->scheme eq 'file') {
28 6         141 $self->logger->debug("copy @{[ $url->file ]} to $path");
  6         54  
29              
30 6         60 my $src = Path::Tiny->new($url->file);
31 6         1257 $src->copy($path);
32 6         6073 return Furl::Response->new(0, 200, 'OK', [
33             'Content-Type' => 'application/octet-stream',
34             'Content-Length' => -s $src,
35             ], 'DUMMY');
36             }
37              
38             return $self->retry_policy->apply_and_doit(sub {
39 0     0     my ($retry_count, $e) = @_;
40 0 0         $self->logger->warn("retry request: $retry_count", { error => $e }) if $retry_count;
41 0           $self->logger->debug("download $url to $path");
42              
43 0           my $tempfile = Path::Tiny->tempfile(UNLINK => 1);
44              
45 0           my $fh = $tempfile->openw_raw();
46 0           my $res = $self->furl->request(
47             method => 'GET',
48             url => $url,
49             write_file => $fh,
50             );
51 0 0         close $fh
52             or die "$!: $tempfile";
53              
54 0 0         unless ($res->is_success) {
55 0           $self->logger->debug("error status: @{[ $res->status_line ]}");
  0            
56 0 0         if ($res->status == 404) {
57 0           CPAN::MirrorMerger::Agent::Exception::NotFound->throw(
58 0           message => "Failed to download: $url (@{[ $res->status_line ]})",
59             );
60             }
61 0           die "Failed to download: $url (@{[ $res->status_line ]})";
  0            
62             }
63              
64 0           $tempfile->copy($path);
65              
66 0           return $res;
67 0           });
68             }
69              
70             package # hide from PAUSE
71             CPAN::MirrorMerger::Agent::Exception::NotFound;
72              
73 2     2   23 use parent qw/Exception::Tiny/;
  2         14  
  2         13  
74              
75              
76             1;
77             __END__