File Coverage

blib/lib/Alien/Build/Plugin/Fetch/Cache.pm
Criterion Covered Total %
statement 59 73 80.8
branch 13 24 54.1
condition 4 15 26.6
subroutine 12 13 92.3
pod 1 1 100.0
total 89 126 70.6


line stmt bran cond sub pod time code
1             package Alien::Build::Plugin::Fetch::Cache;
2              
3 2     2   201199 use strict;
  2         5  
  2         51  
4 2     2   9 use warnings;
  2         29  
  2         44  
5 2     2   31 use 5.010001;
  2         7  
6 2     2   475 use Alien::Build::Plugin;
  2         3442  
  2         12  
7 2     2   713 use URI 1.71;
  2         6455  
  2         60  
8 2     2   488 use Path::Tiny 0.100 ();
  2         8126  
  2         57  
9 2     2   498 use Sereal 3.015 qw( encode_sereal decode_sereal );
  2         1339  
  2         109  
10 2     2   12 use Digest::MD5;
  2         4  
  2         60  
11 2     2   10 use File::Glob qw( bsd_glob );
  2         3  
  2         1185  
12              
13             # ABSTRACT: Alien::Build plugin to cache files downloaded from the internet
14             our $VERSION = '0.04'; # VERSION
15              
16              
17             sub _local_file
18             {
19 7     7   13 my($uri) = @_;
20              
21 7         164 Path::Tiny
22             ->new(bsd_glob '~/.alienbuild/plugin_fetch_cache')
23             ->child($uri->scheme)
24             ->child($uri->host)
25             ->child($uri->path)
26             ->child('meta');
27             }
28              
29             sub init
30             {
31 1     1 1 45934 my($self, $meta) = @_;
32            
33             $meta->around_hook(
34             fetch => sub {
35 7     7   26368 my($orig, $build, $url) = @_;
36 7         13 my $local_file;
37            
38 7   66     21 my $cache_url = $url // $build->meta_prop->{plugin_download_negotiate_default_url};
39            
40 7 50 33     58 if($cache_url && $cache_url !~ m!^/! && $cache_url !~ m!^file:!)
      33        
41             {
42 7         35 my $uri = URI->new($cache_url);
43 7         5445 $local_file = _local_file($uri);
44 7 100       1340 if(-r $local_file)
45             {
46 4         63 $build->log("using cached response for $uri");
47 4         163 return decode_sereal($local_file->slurp_raw);
48             }
49             }
50 3         54 my $res = $orig->($build, $url);
51            
52 3 50       50 if(defined $local_file)
53             {
54 3         13 $local_file->parent->mkpath;
55 3 100       722 if($res->{type} eq 'file')
    50          
56             {
57 2         18 my $md5 = Digest::MD5->new;
58            
59 2 100       7 if($res->{content})
60             {
61 1         5 $md5->add($res->{content});
62             }
63             else
64             {
65 1         21 open my $fh, '<', $res->{path};
66 1         13 $md5->addfile($fh);
67 1         6 close $fh;
68             }
69            
70             my $data = Path::Tiny->new(bsd_glob '~/.alienbuild/plugin_fetch_cache/payload')
71             ->child($md5->hexdigest)
72 2         40 ->child($res->{filename});
73 2         156 $data->parent->mkpath;
74              
75             my $res2 = {
76             type => 'file',
77             filename => $res->{filename},
78 2         331 path => $data->stringify,
79             };
80 2 100       16 if($res->{content})
    50          
81             {
82 1         4 $data->spew_raw($res->{content});
83             }
84             elsif($res->{path})
85             {
86 1         4 Path::Tiny->new($res->{path})->copy($data);
87             }
88             else
89             {
90 0         0 die "got a file without contant or path";
91             }
92 2         2677 $local_file->spew_raw( encode_sereal $res2 );
93             }
94             elsif($res->{type} =~ /^(list|html|dir_listing)$/)
95             {
96 1         28 $local_file->spew_raw( encode_sereal $res );
97             }
98             }
99            
100 3         827 $res;
101             }
102 1         9 );
103              
104 1 50       11 if($ENV{ALIEN_BUILD_PLUGIN_FETCH_CACHE_PRECACHE})
105             {
106             $meta->around_hook(
107             prefer => sub {
108 0     0     my($orig, $build, @rest) = @_;
109 0           my $ret = $orig->($build, @rest);
110            
111 0 0         if($ret->{type} eq 'list')
112             {
113 0           foreach my $file (@{ $ret->{list} })
  0            
114             {
115 0           my $url = $file->{url};
116 0 0 0       if($url && $url !~ m!^/! && $url !~ m!^file:!)
      0        
117             {
118 0           my $local_file = _local_file(URI->new($url));
119 0 0         next if -f $local_file;
120 0           $build->log("precacheing $url");
121 0           $build->fetch($url);
122             }
123             }
124             }
125 0           $ret;
126             },
127 0           );
128             }
129             }
130              
131              
132             1;
133              
134             __END__