File Coverage

blib/lib/CPAN/MirrorMerger/MirrorCache.pm
Criterion Covered Total %
statement 52 52 100.0
branch 4 6 66.6
condition 2 6 33.3
subroutine 9 9 100.0
pod 0 3 0.0
total 67 76 88.1


line stmt bran cond sub pod time code
1             package CPAN::MirrorMerger::MirrorCache;
2 2     2   12 use strict;
  2         3  
  2         52  
3 2     2   8 use warnings;
  2         3  
  2         54  
4              
5 2     2   9 use Class::Accessor::Lite ro => [qw/cache_dir index_cache_timeout agent logger/];
  2         2  
  2         10  
6              
7 2     2   176 use Path::Tiny ();
  2         3  
  2         46  
8 2     2   714 use CPAN::MirrorMerger::Index;
  2         5  
  2         65  
9 2     2   12 use CPAN::MirrorMerger::Logger::Null;
  2         4  
  2         768  
10              
11             sub new {
12 1     1 0 63 my ($class, %args) = @_;
13 1   33     4 $args{logger} ||= CPAN::MirrorMerger::Logger::Null->instance();
14              
15 1         4 my $cache_dir = Path::Tiny->new(delete $args{cache_dir});
16 1         53 bless {
17             %args,
18             cache_dir => $cache_dir,
19             index_cache => {},
20             } => $class;
21             }
22              
23             sub get_or_fetch_index {
24 6     6 0 41 my ($self, $mirror) = @_;
25 6 100       19 if ($self->{index_cache}->{$mirror->name}) {
26 3         19 $self->logger->debug("memory cache hit mirror: @{[ $mirror->name ]}");
  3         16  
27 3         20 return $self->{index_cache}->{$mirror->name};
28             }
29              
30 3         25 my $cache_dir = $self->cache_dir->child($mirror->name);
31 3         141 $cache_dir->mkpath();
32              
33 3         524 my $index_url = $mirror->index_url();
34 3         8 my $index_path = $cache_dir->child($index_url->path);
35              
36 3         124 my $timeout_at = time - $self->index_cache_timeout;
37 3 50 33     22 if (!$index_path->exists || $index_path->stat->mtime < $timeout_at) {
38 3         80 $index_path->parent->mkpath();
39 3         2596 $self->logger->info("download mirror @{[ $mirror->name ]} index");
  3         23  
40 3         6190 $self->agent->download($index_url, $index_path);
41             }
42              
43 3         197 my $index = CPAN::MirrorMerger::Index->parse($index_path, $mirror);
44 3         213 $self->{index_cache}->{$mirror->name} = $index;
45 3         42 return $index;
46             }
47              
48             sub get_or_fetch_package {
49 3     3 0 22 my ($self, $mirror, $package_info) = @_;
50              
51 3         7 my $cache_dir = $self->cache_dir->child($mirror->name);
52 3         141 $cache_dir->mkpath();
53              
54 3         155 my $package_url = $mirror->package_url($package_info->canonicalized_path);
55 3         8 my $package_path = $cache_dir->child($package_url->path);
56              
57 3 50       118 unless ($package_path->exists) {
58 3         81 $package_path->parent->mkpath();
59 3         1656 $self->logger->info("download package @{[ $package_info->path ]} from @{[ $mirror->name ]}");
  3         22  
  3         24  
60 3         1129 $self->agent->download($package_url, $package_path);
61             }
62              
63 3         171 return $package_path;
64             }
65              
66             1;
67             __END__