File Coverage

blib/lib/VCS/Which/Plugin/Git.pm
Criterion Covered Total %
statement 46 185 24.8
branch 10 68 14.7
condition 0 27 0.0
subroutine 12 24 50.0
pod 10 10 100.0
total 78 314 24.8


line stmt bran cond sub pod time code
1             package VCS::Which::Plugin::Git;
2              
3             # Created on: 2009-05-16 16:58:22
4             # Create by: ivan
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   997 use Moo;
  2         5  
  2         12  
10 2     2   585 use strict;
  2         5  
  2         38  
11 2     2   40 use warnings;
  2         6  
  2         66  
12 2     2   22 use version;
  2         5  
  2         12  
13 2     2   138 use Carp;
  2         24  
  2         134  
14 2     2   14 use Data::Dumper qw/Dumper/;
  2         4  
  2         111  
15 2     2   16 use English qw/ -no_match_vars /;
  2         3  
  2         25  
16 2     2   725 use Path::Tiny;
  2         3  
  2         70  
17 2     2   10 use File::chdir;
  2         3  
  2         157  
18 2     2   14 use Contextual::Return;
  2         4  
  2         11  
19              
20             extends 'VCS::Which::Plugin';
21              
22             our $VERSION = version->new('0.6.9');
23             our $name = 'Git';
24             our $exe = 'git';
25             our $meta = '.git';
26              
27             sub installed {
28 6     6 1 12 my ($self) = @_;
29              
30 6 100       29 return $self->_installed if defined $self->_installed;
31              
32 1         9 for my $path (split /[:;]/, $ENV{PATH}) {
33 6 100       135 next if !-x "$path/$exe";
34              
35 1         23 return $self->_installed( 1 );
36             }
37              
38 0         0 return $self->_installed( 0 );
39             }
40              
41             sub used {
42 21     21 1 40 my ( $self, $dir ) = @_;
43              
44 21 50       225 if (-f $dir) {
45 0         0 $dir = path($dir)->parent;
46             }
47              
48 21 100       272 croak "$dir is not a directory!" if !-d $dir;
49              
50 20         159 my $current_dir = path($dir)->absolute;
51 20         1925 my $level = 1;
52              
53 20         79 while ($current_dir) {
54 111 50       3599 if ( -d "$current_dir/$meta" ) {
55 0         0 $self->_base( $current_dir );
56 0         0 return $level;
57             }
58              
59 111         1854 $level++;
60              
61             # check that we still have a parent directory
62 111 100       343 last if $current_dir eq $current_dir->parent;
63              
64 91         5660 $current_dir = $current_dir->parent;
65             }
66              
67 20         1280 return 0;
68             }
69              
70             sub uptodate {
71 0     0 1   my ( $self, $dir ) = @_;
72              
73 0   0       $dir ||= $self->_base;
74              
75 0 0         croak "'$dir' is not a directory!" if !-d $dir;
76              
77 0           local $CWD = path($dir)->absolute;
78 0           my $ans = `$exe status`;
79              
80 0 0         return $ans =~ /nothing \s to \s commit/xms ? 1 : 0;
81             }
82              
83             sub pull {
84 0     0 1   my ( $self, $dir ) = @_;
85              
86 0   0       $dir ||= $self->_base;
87              
88 0 0         croak "'$dir' is not a directory!" if !-e $dir;
89              
90 0           local $CWD = $dir;
91 0           return !system "$exe pull > /dev/null 2> /dev/null";
92             }
93              
94             sub push {
95 0     0 1   my ( $self, $dir ) = @_;
96              
97 0   0       $dir ||= $self->_base;
98              
99 0 0         croak "'$dir' is not a directory!" if !-e $dir;
100              
101 0           local $CWD = $dir;
102 0           return !system "$exe push origin master > /dev/null 2> /dev/null";
103             }
104              
105             sub cat {
106 0     0 1   my ($self, $file, $revision) = @_;
107              
108             # git expects $file to be relative to the base of the git repo not the
109             # current directory so we change it to being relative to the repo if nessesary
110 0 0         my $repo_dir = path($self->_base) or confess "How did I get here with out a base directory?\n";
111 0           my $cwd = path('.')->absolute;
112 0           local $CWD = $CWD;
113              
114 0 0 0       if ( -f $file && $cwd ne $repo_dir ) {
115             # get relavie directory of $cwd to $repo_dir
116 0           my ($relative) = $cwd =~ m{^ $repo_dir / (.*) $}xms;
117 0           my $old = $file;
118 0           $file = path("$relative/$file");
119 0 0         warn "Using repo absolute file $file from $old\n" if $ENV{VERBOSE};
120 0           $CWD = $repo_dir;
121             }
122              
123 0 0 0       if ( $revision && $revision =~ /^-?\d+$|[^0-9a-fA-F]/xms ) {
    0          
124 0           eval { require Git };
  0            
125 0 0         if ($EVAL_ERROR) {
126 0           die "Git.pm is not installed only propper revision names can be used\n";
127             }
128              
129 0           my $repo = Git->repository(Directory => $self->_base);
130 0           my @revs = reverse $repo->command('log', '--format=format:%H', '--', $file);
131 0 0 0       $revision = $revision =~ /^[-]?\d+$/xms && $revs[$revision] ? $revs[$revision] : $revision;
132             }
133             elsif ( !defined $revision ) {
134 0           $revision = '';
135             }
136 0 0         warn "$exe show $revision\:$file\n" if $ENV{VERBOSE};
137              
138 0           return `$exe show $revision\:$file`;
139             }
140              
141             sub log {
142 0     0 1   my ($self, @args) = @_;
143 0           local $CWD = $CWD;
144              
145 0           my $dir;
146 0 0 0       if ( defined $args[0] && -d $args[0] && $args[0] =~ m{^/} ) {
      0        
147 0           $dir = shift @args;
148 0           $CWD = $dir;
149             }
150 0           my $args = join ' ', grep {defined $_} @args;
  0            
151              
152             return
153 0     0     SCALAR { scalar `$exe log $args` }
154             ARRAYREF {
155 0     0     my @raw_log = `$exe log $args`;
156 0           my @log;
157 0           my $line = '';
158 0           for my $raw (@raw_log) {
159 0 0 0       if ( $raw =~ /^commit / && $line ) {
160 0           CORE::push @log, $line;
161 0           $line = $raw;
162             }
163             else {
164 0           $line .= $raw;
165             }
166              
167             }
168 0           return \@log;
169             }
170             HASHREF {
171 0     0     my $logs = `$exe log $args`;
172 0           my @logs = split /^commit\s*/xms, $logs;
173 0           shift @logs;
174 0           my $num = @logs;
175 0           my %log;
176 0           for my $log (@logs) {
177 0           $log{$num--} = $self->_log_expand($log);
178             }
179 0           return \%log;
180             }
181 0           }
182              
183             sub _log_expand {
184 0     0     my ($self, $log) = @_;
185              
186             # split the commit from the reset of the message
187 0           my ($ver, $rest) = split /\n/, $log, 2;
188              
189             # split log details and the description
190 0           my ($details, $description) = split /\n\n\s*/, $rest, 2;
191              
192             # remove excess whitespace at the end of the description
193 0           $description =~ s/\s+\Z//xms;
194 0           my ($conflicts) = $description =~ /\s+Conflicts:\s+(.*)\Z/xms;
195 0           $description =~ s/\s+Conflicts:\s+(.*)\Z//xms;
196              
197             # split up the details
198 0           my %log = map {split /:\s*/, $_, 2} split /\n/, $details;
  0            
199              
200             # add in the description
201 0           $log{description} = $description;
202              
203             # add in the revision
204 0           $log{rev} = $ver;
205              
206             # add conflicts if any
207 0 0         $log{conflicts} = [ split /\n\s+/, $conflicts ] if $conflicts;
208              
209 0           return \%log;
210             }
211              
212             sub versions {
213 0     0 1   my ($self, $file, $oldest, $newest, $max) = @_;
214              
215 0           eval { require Git };
  0            
216 0 0         if ($EVAL_ERROR) {
217 0           die "Git.pm is not installed only propper revision names can be used\n";
218             }
219              
220 0           my $repo = Git->repository(Directory => $self->_base);
221 0           my @revs = reverse $repo->command('rev-list', '--all', '--', path($file)->absolute);
222              
223 0           return @revs;
224             }
225              
226             sub status {
227 0     0 1   my ($self, $dir) = @_;
228 0           my %status;
229 0           my $name = '';
230 0 0         if ( -f $dir ) {
231 0           $name = path($dir)->absolute->basename;
232             }
233 0 0         local $CWD = -f $dir ? path($dir)->absolute->parent : path($dir)->absolute;
234 0           my $status = `$exe status $name`;
235 0           $status =~ s/^no \s+ changes (.*?) $//xms;
236 0           chomp $status;
237              
238 0           my @both = split /\n?[#]?\s+both\s+modified:\s+/, $status;
239 0 0         if ( @both > 1 ) {
240 0           shift @both;
241 0           $both[-1] =~ s/\n.*//xms;
242 0           $status{both} = \@both;
243             }
244              
245 0           my @modified = split /\n?[#]?\s+modified:\s+/, $status;
246 0 0         if ( @modified > 1 ) {
247 0           shift @modified;
248 0           $modified[-1] =~ s/\n.*//xms;
249 0           $status{modified} = \@modified;
250             }
251              
252 0           my @added = split /\n?[#]?\s+new\sfile:\s+/, $status;
253 0 0         if ( @added > 1 ) {
254 0           shift @added;
255 0           $added[-1] =~ s/\n.*//xms;
256 0           $status{added} = \@added;
257             }
258              
259 0           my @committed = split /Changes to be committed:\n/, $status;
260 0 0         if (@committed > 1) {
261 0           my $new = pop @committed;
262 0           $status{committed} = [ $new =~ /^\t[^:]+:\s+(.*?)\n/gxms ];
263             }
264              
265 0           my @untracked = split /Untracked files:\n/, $status;
266 0 0         if ( @untracked > 1 ) {
267 0           my $untracked = pop @untracked;
268 0 0         if ($untracked =~ s/^\s+[(]use \s+ "git \s+ add \s+ [^"]+" \s+ [^)]+\)\n\n//xms) {
269 0           chomp $untracked;
270             }
271             else {
272 0           $untracked =~ s/^[#].*?\n//gxms;
273             }
274              
275 0 0         if ($untracked =~ /^[#]/xms) {
276 0           $status{untracked} = [ grep {$_} map {chomp; $_} split /\n?[#]\s+/, $untracked ];
  0            
  0            
  0            
277             }
278             else {
279 0           $status{untracked} = [ $untracked =~ /^\t(.*?)\n/gxms ];
280             }
281             }
282              
283 0 0         if ($status =~ /
284             You \s+ have \s+ unmerged \s+ paths[.]$
285             |
286             All \s+ conflicts \s+ fixed \s+ but \s+ you \s+ are \s+ still \s+ merging[.]$
287             /xms) {
288 0           $status{merge} = 1;
289             }
290              
291 0           return \%status;
292             }
293              
294             sub checkout {
295 0     0 1   my ($self, $dir, @extra) = @_;
296 0           my $name = '';
297 0 0         if ( -f $dir ) {
298 0           $name = path($dir)->absolute->basename;
299             }
300 0 0         local $CWD = -f $dir ? path($dir)->absolute->parent : path($dir)->absolute;
301 0           my $extra = join ' ', @extra;
302 0           `$exe checkout $extra $name`;
303              
304 0           return;
305             }
306              
307             1;
308              
309             __END__