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   15 use strict;
  2         5  
  2         62  
3 2     2   10 use warnings;
  2         5  
  2         69  
4              
5 2     2   11 use Class::Accessor::Lite ro => [qw/cache_dir index_cache_timeout agent logger/];
  2         4  
  2         12  
6              
7 2     2   216 use Path::Tiny ();
  2         4  
  2         43  
8 2     2   902 use CPAN::MirrorMerger::Index;
  2         6  
  2         80  
9 2     2   21 use CPAN::MirrorMerger::Logger::Null;
  2         5  
  2         934  
10              
11             sub new {
12 1     1 0 74 my ($class, %args) = @_;
13 1   33     5 $args{logger} ||= CPAN::MirrorMerger::Logger::Null->instance();
14              
15 1         7 my $cache_dir = Path::Tiny->new(delete $args{cache_dir});
16 1         67 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 49 my ($self, $mirror) = @_;
25 6 100       22 if ($self->{index_cache}->{$mirror->name}) {
26 3         26 $self->logger->debug("memory cache hit mirror: @{[ $mirror->name ]}");
  3         18  
27 3         27 return $self->{index_cache}->{$mirror->name};
28             }
29              
30 3         34 my $cache_dir = $self->cache_dir->child($mirror->name);
31 3         160 $cache_dir->mkpath();
32              
33 3         656 my $index_url = $mirror->index_url();
34 3         10 my $index_path = $cache_dir->child($index_url->path);
35              
36 3         165 my $timeout_at = time - $self->index_cache_timeout;
37 3 50 33     29 if (!$index_path->exists || $index_path->stat->mtime < $timeout_at) {
38 3         93 $index_path->parent->mkpath();
39 3         2964 $self->logger->info("download mirror @{[ $mirror->name ]} index");
  3         26  
40 3         7558 $self->agent->download($index_url, $index_path);
41             }
42              
43 3         297 my $index = CPAN::MirrorMerger::Index->parse($index_path, $mirror);
44 3         263 $self->{index_cache}->{$mirror->name} = $index;
45 3         54 return $index;
46             }
47              
48             sub get_or_fetch_package {
49 3     3 0 26 my ($self, $mirror, $package_info) = @_;
50              
51 3         10 my $cache_dir = $self->cache_dir->child($mirror->name);
52 3         135 $cache_dir->mkpath();
53              
54 3         183 my $package_url = $mirror->package_url($package_info->canonicalized_path);
55 3         9 my $package_path = $cache_dir->child($package_url->path);
56              
57 3 50       180 unless ($package_path->exists) {
58 3         108 $package_path->parent->mkpath();
59 3         2031 $self->logger->info("download package @{[ $package_info->path ]} from @{[ $mirror->name ]}");
  3         26  
  3         29  
60 3         1427 $self->agent->download($package_url, $package_path);
61             }
62              
63 3         207 return $package_path;
64             }
65              
66             1;
67             __END__