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   280442 use strict;
  2         9  
  2         97  
4 2     2   17 use warnings;
  2         8  
  2         88  
5 2     2   68 use 5.010;
  2         11  
6 2     2   1465 use Alien::Build::Plugin;
  2         6721  
  2         21  
7 2     2   1614 use File::HomeDir 1.00;
  2         10700  
  2         213  
8 2     2   1973 use URI 1.71;
  2         11507  
  2         90  
9 2     2   1006 use Path::Tiny 0.100 ();
  2         14930  
  2         81  
10 2     2   1415 use Sereal 3.015 qw( encode_sereal decode_sereal );
  2         2378  
  2         193  
11 2     2   36 use Digest::MD5;
  2         5  
  2         2513  
12              
13             # ABSTRACT: Alien::Build plugin to cache files downloaded from the internet
14             our $VERSION = '0.02'; # VERSION
15              
16              
17             sub _local_file
18             {
19 7     7   27 my($uri) = @_;
20              
21 7         92 Path::Tiny
22             ->new(File::HomeDir->my_home)
23             ->child('.alienbuild/plugin_fetch_cache')
24             ->child($uri->scheme)
25             ->child($uri->host)
26             ->child($uri->path)
27             ->child('meta');
28             }
29              
30             sub init
31             {
32 1     1 1 42302 my($self, $meta) = @_;
33            
34             $meta->around_hook(
35             fetch => sub {
36 7     7   44583 my($orig, $build, $url) = @_;
37 7         25 my $local_file;
38            
39 7   66     40 my $cache_url = $url // $build->meta_prop->{plugin_download_negotiate_default_url};
40            
41 7 50 33     119 if($cache_url && $cache_url !~ m!^/! && $cache_url !~ m!^file:!)
      33        
42             {
43 7         97 my $uri = URI->new($cache_url);
44 7         8525 $local_file = _local_file($uri);
45 7 100       3046 if(-r $local_file)
46             {
47 4         144 $build->log("using cached response for $uri");
48 4         382 return decode_sereal($local_file->slurp_raw);
49             }
50             }
51 3         131 my $res = $orig->($build, $url);
52            
53 3 50       87 if(defined $local_file)
54             {
55 3         24 $local_file->parent->mkpath;
56 3 100       1534 if($res->{type} eq 'file')
    50          
57             {
58 2         33 my $md5 = Digest::MD5->new;
59            
60 2 100       12 if($res->{content})
61             {
62 1         11 $md5->add($res->{content});
63             }
64             else
65             {
66 1         41 open my $fh, '<', $res->{path};
67 1         21 $md5->addfile($fh);
68 1         13 close $fh;
69             }
70            
71             my $data = Path::Tiny->new(File::HomeDir->my_home)
72             ->child('.alienbuild/plugin_fetch_cache/payload')
73             ->child($md5->hexdigest)
74 2         17 ->child($res->{filename});
75 2         407 $data->parent->mkpath;
76              
77             my $res2 = {
78             type => 'file',
79             filename => $res->{filename},
80 2         574 path => $data->stringify,
81             };
82 2 100       22 if($res->{content})
    50          
83             {
84 1         8 $data->spew_raw($res->{content});
85             }
86             elsif($res->{path})
87             {
88 1         5 Path::Tiny->new($res->{path})->copy($data);
89             }
90             else
91             {
92 0         0 die "got a file without contant or path";
93             }
94 2         3427 $local_file->spew_raw( encode_sereal $res2 );
95             }
96             elsif($res->{type} =~ /^(list|html|dir_listing)$/)
97             {
98 1         64 $local_file->spew_raw( encode_sereal $res );
99             }
100             }
101            
102 3         1325 $res;
103             }
104 1         13 );
105              
106 1 50       13 if($ENV{ALIEN_BUILD_PLUGIN_FETCH_CACHE_PRECACHE})
107             {
108             $meta->around_hook(
109             prefer => sub {
110 0     0     my($orig, $build, @rest) = @_;
111 0           my $ret = $orig->($build, @rest);
112            
113 0 0         if($ret->{type} eq 'list')
114             {
115 0           foreach my $file (@{ $ret->{list} })
  0            
116             {
117 0           my $url = $file->{url};
118 0 0 0       if($url && $url !~ m!^/! && $url !~ m!^file:!)
      0        
119             {
120 0           my $local_file = _local_file(URI->new($url));
121 0 0         next if -f $local_file;
122 0           $build->log("precacheing $url");
123 0           $build->fetch($url);
124             }
125             }
126             }
127 0           $ret;
128             },
129 0           );
130             }
131             }
132              
133              
134             1;
135              
136             __END__