File Coverage

blib/lib/App/SCM/Digest/SCM/Git.pm
Criterion Covered Total %
statement 41 94 43.6
branch 3 14 21.4
condition 0 2 0.0
subroutine 11 18 61.1
pod 0 12 0.0
total 55 140 39.2


line stmt bran cond sub pod time code
1             package App::SCM::Digest::SCM::Git;
2              
3 5     5   27686 use strict;
  5         11  
  5         139  
4 5     5   25 use warnings;
  5         8  
  5         143  
5              
6 5     5   710 use App::SCM::Digest::Utils qw(system_ad);
  5         9  
  5         248  
7              
8 5     5   126791 use autodie;
  5         604669  
  5         26  
9 5     5   33161 use List::Util qw(first);
  5         20  
  5         6558  
10              
11             sub new
12             {
13 9     9 0 2136 my ($class) = @_;
14              
15 9         142270 my $res = system("git --version >/dev/null");
16 9 50       262 if ($res != 0) {
17 0         0 die "Unable to find git executable.";
18             }
19              
20 9         160 my $self = {};
21 9         99 bless $self, $class;
22 9         544 return $self;
23             }
24              
25             sub clone
26             {
27 4     4 0 66 my ($self, $url, $name) = @_;
28              
29 4         100 my $res = system_ad("git clone $url $name");
30              
31 1         613 return 1;
32             }
33              
34             sub open_repository
35             {
36 4     4 0 891 my ($self, $path) = @_;
37              
38 4         82 chdir $path;
39              
40 3         5128 return 1;
41             }
42              
43             sub is_usable
44             {
45 2     2 0 8 my ($self) = @_;
46              
47 2         16895 my @branches = `git branch -l`;
48 2 50       111 return (@branches ? 1 : 0);
49             }
50              
51             sub prune
52             {
53 0     0 0 0 my ($self) = @_;
54              
55 0   0     0 my $original_branch = $self->branch_name() || '';
56 0         0 my $current_branch = $original_branch;
57              
58 0         0 my @lines = `git remote prune origin`;
59 0         0 for my $line (@lines) {
60 0         0 chomp $line;
61 0 0       0 if (my ($branch) = ($line =~ /^ \* \[pruned\] origin\/(.*)$/)) {
62 0 0       0 if ($branch eq $current_branch) {
63 0         0 my @branches = @{$self->branches()};
  0         0  
64             my $other_branch =
65 0     0   0 first { $_->[0] ne $current_branch }
66 0         0 @branches;
67 0         0 $self->checkout($other_branch->[0]);
68 0         0 $current_branch = $other_branch->[0];
69             }
70 0         0 system_ad("git branch -D $branch");
71 0 0       0 if ($branch eq $original_branch) {
72 0         0 $original_branch = undef;
73             }
74             }
75             }
76 0 0       0 if ($original_branch) {
77 0         0 $self->checkout($original_branch);
78             }
79              
80 0         0 return 1;
81             }
82              
83             sub pull
84             {
85 0     0 0 0 my ($self) = @_;
86              
87 0         0 $self->prune();
88              
89 0         0 system_ad("git pull");
90              
91 0         0 return 1;
92             }
93              
94             sub branches
95             {
96 1     1 0 16 my ($self) = @_;
97              
98             my @branches =
99 0         0 map { s/^\s+//; s/^origin\///; s/\s+$//; $_ }
  0         0  
  0         0  
  0         0  
100 0         0 grep { !/ -> / }
101 1         7329 map { chomp; $_ }
  0         0  
  0         0  
102             `git branch -r`;
103              
104 1         11 my @results;
105 1         22 my $current_branch = $self->branch_name();
106 1         11 for my $branch (@branches) {
107 0         0 $self->checkout($branch);
108 0         0 $self->pull();
109 0         0 my $commit = `git log -1 --format="%H" $branch`;
110 0         0 chomp $commit;
111 0         0 push @results, [ $branch => $commit ];
112             }
113 1 50       19 if ($current_branch ne 'HEAD') {
114 0         0 $self->checkout($current_branch);
115             }
116              
117 1         19 return \@results;
118             }
119              
120             sub branch_name
121             {
122 1     1 0 6 my ($self) = @_;
123              
124             # todo: This prints a warning if there are no branches; there is
125             # probably a better way of dealing with this problem.
126 1         8181 my $branch = `git rev-parse --abbrev-ref HEAD 2>/dev/null`;
127 1         13 chomp $branch;
128              
129 1         29 return $branch;
130             }
131              
132             sub checkout
133             {
134 0     0 0   my ($self, $branch) = @_;
135              
136 0           system_ad("git checkout $branch");
137              
138 0           return 1;
139             }
140              
141             sub commits_from
142             {
143 0     0 0   my ($self, $branch, $from) = @_;
144              
145 0           $self->checkout($branch);
146 0           my @new_commits = reverse map { chomp; $_ } `git rev-list $from..HEAD`;
  0            
  0            
147              
148 0           return \@new_commits;
149             }
150              
151             sub show
152             {
153 0     0 0   my ($self, $id) = @_;
154              
155 0           my @data = `git show -s $id`;
156              
157 0           return \@data;
158             }
159              
160             sub show_all
161             {
162 0     0 0   my ($self, $id) = @_;
163              
164 0           my @data = (`git show $id`);
165              
166 0           return \@data;
167             }
168              
169             1;
170              
171             __END__