File Coverage

blib/lib/Alien/Build/Plugin/Fetch/Git.pm
Criterion Covered Total %
statement 79 98 80.6
branch 16 30 53.3
condition 2 12 16.6
subroutine 15 17 88.2
pod 1 3 33.3
total 113 160 70.6


line stmt bran cond sub pod time code
1             package Alien::Build::Plugin::Fetch::Git;
2              
3 3     3   224147 use strict;
  3         11  
  3         75  
4 3     3   14 use warnings;
  3         4  
  3         67  
5 3     3   41 use 5.008001;
  3         9  
6 3     3   1102 use Alien::Util qw( version_cmp );
  3         926  
  3         152  
7 3     3   369 use Alien::Build::Plugin;
  3         9594  
  3         15  
8 3     3   1540 use URI;
  3         11874  
  3         75  
9 3     3   1134 use URI::file;
  3         13170  
  3         88  
10 3     3   1047 use URI::git;
  3         10029  
  3         91  
11 3     3   668 use Path::Tiny qw( path );
  3         9596  
  3         158  
12 3     3   604 use File::Temp qw( tempdir );
  3         14078  
  3         123  
13 3     3   1089 use File::chdir;
  3         8048  
  3         291  
14 3     3   466 use Capture::Tiny qw( capture_merged capture_stdout );
  3         3514  
  3         2411  
15              
16             # ABSTRACT: Alien::Build plugin to fetch from git
17             our $VERSION = '0.10'; # VERSION
18              
19              
20             sub init
21             {
22 1     1 1 37957 my($self, $meta) = @_;
23              
24 1         4 $meta->add_requires('share' => 'Alien::git' => 0);
25              
26             $meta->register_hook(
27             fetch => sub {
28 2     2   58001 my($build, $url) = @_;
29              
30 2   33     19 $url ||= $build->meta_prop->{start_url};
31 2 50       6 die "no default URL provided!" unless defined $url;
32              
33 2 50 0     25 if($url =~ /^[a-zA-Z0-9]+:/ && !( $url =~ /^[A-Z]:/i && $^O eq 'MSWin32' ))
      33        
34             {
35 0         0 $url = URI->new($url);
36             }
37             else
38             {
39 2         50 my $tmp = URI::file->new_abs(".");
40 2 50       11202 if($^O eq 'MSWin32')
41             {
42 0         0 $tmp->host('');
43             }
44             else
45             {
46 2         27 $tmp->host('localhost');
47             }
48 2 100       127 if($url =~ s/#(.*)$//)
49             {
50 1         21 $tmp->fragment($1);
51             }
52 2         54 $tmp->path($url);
53 2         65 $url = $tmp;
54             }
55              
56 2         62 my $exe = Alien::git->exe;
57              
58 2 100       402 if(defined $url->fragment)
59             {
60 1         36 local $CWD = tempdir( CLEANUP => 1 );
61 1         702 my($tag) = $url->fragment;
62 1         22 $url->fragment(undef);
63 1 50       24 if(can_branch_clone())
64             {
65 1         21 $build->system('%{git}', 'clone', '--depth' => 1, '--branch', "$tag", "$url");
66             }
67             else
68             {
69 0         0 $build->system('%{git}', 'clone', "$url");
70             }
71 1 50       68164 die "command failed" if $?;
72 1         35 my($dir) = path(".")->absolute->children;
73              
74 1 50       555 if(can_branch_clone())
75             {
76             # do nothing
77             }
78             else
79             {
80             # mildly prefer the -C version as it will handle spaces in $dir.
81 0 0       0 if(can_minus_c())
82             {
83 0         0 $build->system('%{git}', -C => "$dir", 'checkout', $tag);
84             }
85             else
86             {
87 0         0 $build->system("cd $dir ; %{git} checkout $tag");
88             }
89 0 0       0 die "command failed" if $?;
90             }
91             return {
92 1         13 type => 'file',
93             filename => $dir->basename,
94             path => $dir->stringify,
95             protocol => $url->scheme,
96             };
97             }
98             else
99             {
100 1         32 $build->log("fetching tags from $url");
101             my($output, $error) = capture_merged {
102 1         1231 $build->system('%{git}', 'ls-remote', '--tags', "$url");
103 1         7913 $?;
104 1         242 };
105              
106 1 50       1093 if($error)
107             {
108 0         0 print $output;
109 0         0 die "command failed";
110             }
111              
112             my @tags = sort
113 4         35 grep { defined $_ }
114 1 100       30 map { m{refs/tags/(.*)$} ? $1 : undef }
  4         72  
115             split /\n\r?/, $output;
116              
117             return {
118             type => 'list',
119             list => [
120             map {
121 1         8 my $tag = $_;
  3         6  
122 3         25 my $url = $url->clone;
123 3         52 $url->fragment($tag);
124 3         67 my %h = (
125             filename => $tag,
126             url => "$url",
127             );
128 3         84 \%h;
129             } @tags
130             ],
131             protocol => $url->scheme,
132             };
133             }
134             },
135 1         19 );
136             }
137              
138              
139             my $can_minus_c;
140             sub can_minus_c
141             {
142 0 0   0 0 0 unless(defined $can_minus_c)
143             {
144 0         0 require Alien::git;
145 0         0 my $tmp = path(tempdir( CLEANUP => 1));
146             my(undef, $ret) = capture_merged {
147 0     0   0 system(Alien::git->exe, -C => $tmp, 'init');
148 0         0 $?;
149 0         0 };
150 0   0     0 $can_minus_c = !! $? == 0 && -d $tmp->child('.git');
151 0         0 $tmp->remove_tree;
152             }
153              
154 0         0 $can_minus_c;
155             }
156              
157             my $can_branch_clone;
158             sub can_branch_clone
159             {
160 2 100   2 0 20 unless(defined $can_branch_clone)
161             {
162 1         19 require Alien::git;
163 1 50       15 if(version_cmp(Alien::git->version, "1.8.3.5") >= 0)
164             {
165 1         61 $can_branch_clone = 1;
166             }
167             else
168             {
169 0         0 $can_branch_clone = 0;
170             }
171             }
172              
173 2         17 $can_branch_clone;
174             }
175              
176             1;
177              
178             __END__