File Coverage

blib/lib/Alien/Build/Plugin/Core/Download.pm
Criterion Covered Total %
statement 65 74 87.8
branch 16 24 66.6
condition 2 3 66.6
subroutine 8 8 100.0
pod 1 1 100.0
total 92 110 83.6


line stmt bran cond sub pod time code
1             package Alien::Build::Plugin::Core::Download;
2              
3 48     48   244397 use strict;
  48         135  
  48         1583  
4 48     48   402 use warnings;
  48         173  
  48         1333  
5 48     48   934 use 5.008004;
  48         179  
6 48     48   1022 use Alien::Build::Plugin;
  48         167  
  48         431  
7 48     48   1299 use Path::Tiny ();
  48         12112  
  48         1443  
8 48     48   1427 use Alien::Build::Util qw( _mirror );
  48         211  
  48         41327  
9              
10             # ABSTRACT: Core download plugin
11             our $VERSION = '2.46'; # VERSION
12              
13              
14             sub _hook
15             {
16 12     12   34 my($build) = @_;
17              
18 12         120 my $res = $build->fetch;
19              
20 12 100       100 if($res->{type} =~ /^(?:html|dir_listing)$/)
21             {
22 2         6 my $type = $res->{type};
23 2         8 $type =~ s/_/ /;
24 2         12 $build->log("decoding $type");
25 2         22 $res = $build->decode($res);
26             }
27              
28 12 100       54 if($res->{type} eq 'list')
29             {
30 3         36 $res = $build->prefer($res);
31 3 50       25 die "no matching files in listing" if @{ $res->{list} } == 0;
  3         17  
32 3         11 my $version = $res->{list}->[0]->{version};
33 3         6 my($pick, @other) = map { $_->{url} } @{ $res->{list} };
  303         468  
  3         8  
34 3 50       13 if(@other > 8)
35             {
36 3         14 splice @other, 7;
37 3         9 push @other, '...';
38             }
39 3         17 $build->log("candidate *$pick");
40 3         30 $build->log("candidate $_") for @other;
41 3         16 $res = $build->fetch($pick);
42              
43 3 50       17 if($version)
44             {
45 0         0 $version =~ s/\.+$//;
46 0         0 $build->log("setting version based on archive to $version");
47 0         0 $build->runtime_prop->{version} = $version;
48             }
49             }
50              
51 12 50       39 if($res->{type} eq 'file')
52             {
53 12         28 my $alienfile = $res->{filename};
54 12         89 $build->log("downloaded $alienfile");
55 12 100       120 if($res->{content})
    50          
56             {
57 4         28 my $tmp = Alien::Build::TempDir->new($build, "download");
58 4         1409 my $path = Path::Tiny->new("$tmp/$alienfile");
59 4         143 $path->spew_raw($res->{content});
60 4         1817 $build->install_prop->{download} = $path->stringify;
61 4         10 $build->install_prop->{complete}->{download} = 1;
62 4         18 return $build;
63             }
64             elsif($res->{path})
65             {
66 8 100 66     83 if(defined $res->{tmp} && !$res->{tmp})
67             {
68 7 50       138 if(-e $res->{path})
69             {
70 7         45 $build->install_prop->{download} = $res->{path};
71 7         24 $build->install_prop->{complete}->{download} = 1;
72             }
73             else
74             {
75 0         0 die "not a file or directory: @{[ $res->{path} ]}";
  0         0  
76             }
77             }
78             else
79             {
80 1         7 my $from = Path::Tiny->new($res->{path});
81 1         49 my $tmp = Alien::Build::TempDir->new($build, "download");
82 1         315 my $to = Path::Tiny->new("$tmp/@{[ $from->basename ]}");
  1         9  
83 1 50       72 if(-d $res->{path})
84             {
85             # Please note: _mirror and Alien::Build::Util are ONLY
86             # allowed to be used by core plugins. If you are writing
87             # a non-core plugin it may be removed. That is why it
88             # is private.
89 0         0 _mirror $from, $to;
90             }
91             else
92             {
93 1         8 require File::Copy;
94 1 50       5 File::Copy::copy(
95             "$from" => "$to",
96             ) || die "copy $from => $to failed: $!";
97             }
98 1         353 $build->install_prop->{download} = $to->stringify;
99 1         5 $build->install_prop->{complete}->{download} = 1;
100             }
101 8         194 return $build;
102             }
103 0         0 die "file without content or path";
104             }
105 0         0 die "unknown fetch response type: @{[ $res->{type} ]}";
  0         0  
106             }
107              
108             sub init
109             {
110 337     337 1 901 my($self, $meta) = @_;
111              
112 337         1464 $meta->default_hook(download => \&_hook);
113             }
114              
115             1;
116              
117             __END__