line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package System::Introspector::Probe::Repositories::Git; |
2
|
1
|
|
|
1
|
|
69096
|
use Moo; |
|
1
|
|
|
|
|
17880
|
|
|
1
|
|
|
|
|
8
|
|
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
|
|
1196
|
use System::Introspector::Util qw( |
5
|
|
|
|
|
|
|
handle_from_command |
6
|
|
|
|
|
|
|
transform_exceptions |
7
|
|
|
|
|
|
|
lines_from_command |
8
|
1
|
|
|
1
|
|
2704
|
); |
|
1
|
|
|
|
|
5
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
has root => ( |
11
|
|
|
|
|
|
|
is => 'ro', |
12
|
|
|
|
|
|
|
default => sub { '/' }, |
13
|
|
|
|
|
|
|
); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub gather { |
16
|
1
|
|
|
1
|
0
|
20675
|
my ($self) = @_; |
17
|
|
|
|
|
|
|
return transform_exceptions { |
18
|
1
|
|
|
1
|
|
7
|
my $pipe = $self->_open_locate_git_config_pipe; |
19
|
1
|
|
|
|
|
1567
|
my %location; |
20
|
1
|
|
|
|
|
12
|
while (defined( my $line = <$pipe> )) { |
21
|
1
|
|
|
|
|
4
|
chomp $line; |
22
|
1
|
50
|
|
|
|
14
|
next unless $line =~ m{^(.+)/\.git/config$}; |
23
|
1
|
|
|
|
|
3
|
my $base = $1; |
24
|
1
|
|
|
|
|
14
|
$location{ $base } = $self->_gather_git_info($line); |
25
|
|
|
|
|
|
|
} |
26
|
1
|
|
|
|
|
38
|
return { git => \%location }; |
27
|
1
|
|
|
|
|
25
|
}; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub _gather_git_info { |
31
|
1
|
|
|
1
|
|
3
|
my ($self, $config) = @_; |
32
|
|
|
|
|
|
|
return { |
33
|
|
|
|
|
|
|
config_file => $config, |
34
|
|
|
|
|
|
|
config => transform_exceptions { |
35
|
1
|
|
|
1
|
|
7
|
$self->_gather_git_config($config); |
36
|
|
|
|
|
|
|
}, |
37
|
|
|
|
|
|
|
tracked => transform_exceptions { |
38
|
1
|
|
|
1
|
|
5
|
$self->_gather_track_info($config); |
39
|
|
|
|
|
|
|
}, |
40
|
1
|
|
|
|
|
16
|
}; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub _gather_track_info { |
44
|
1
|
|
|
1
|
|
2
|
my ($self, $config) = @_; |
45
|
1
|
|
|
|
|
14
|
(my $git_dir = $config) =~ s{/config$}{}; |
46
|
1
|
|
|
|
|
5
|
return $self->_find_tracking($git_dir); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _find_tracking { |
50
|
1
|
|
|
1
|
|
2
|
my ($self, $dir) = @_; |
51
|
1
|
|
|
|
|
18
|
local $ENV{GIT_DIR} = $dir; |
52
|
1
|
|
|
|
|
10
|
my @lines = lines_from_command |
53
|
|
|
|
|
|
|
['git', 'for-each-ref', |
54
|
|
|
|
|
|
|
'--format', q{OK %(refname:short) %(upstream:short)}, |
55
|
|
|
|
|
|
|
'refs/heads', |
56
|
|
|
|
|
|
|
]; |
57
|
1
|
|
|
|
|
10
|
my %branch; |
58
|
1
|
|
|
|
|
9
|
for my $line (@lines) { |
59
|
0
|
0
|
|
|
|
0
|
if ($line =~ m{^OK\s+(\S+)\s+(\S+)?$}) { |
60
|
0
|
|
|
|
|
0
|
my ($local, $remote) = ($1, $2); |
61
|
|
|
|
|
|
|
$branch{ $local } = { |
62
|
|
|
|
|
|
|
upstream => $remote, |
63
|
|
|
|
|
|
|
changed_files => transform_exceptions { |
64
|
0
|
|
|
0
|
|
0
|
$self->_find_changes($dir, $local, $remote); |
65
|
|
|
|
|
|
|
}, |
66
|
|
|
|
|
|
|
local_commit_count => transform_exceptions { |
67
|
0
|
|
|
0
|
|
0
|
$self->_find_commit_count($dir, $local, $remote); |
68
|
|
|
|
|
|
|
}, |
69
|
|
|
|
|
|
|
} |
70
|
0
|
|
|
|
|
0
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
0
|
|
|
|
|
0
|
return { __error__ => join "\n", @lines }; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
1
|
|
|
|
|
48
|
return { branches => \%branch }; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub _find_commit_count { |
79
|
0
|
|
|
0
|
|
0
|
my ($self, $dir, $local, $remote) = @_; |
80
|
0
|
0
|
|
|
|
0
|
return { __error__ => "No remote" } |
81
|
|
|
|
|
|
|
unless defined $remote; |
82
|
0
|
|
|
|
|
0
|
local $ENV{GIT_DIR} = $dir; |
83
|
0
|
|
|
|
|
0
|
my @lines = lines_from_command |
84
|
|
|
|
|
|
|
['git', 'log', '--oneline', "$remote..$local"]; |
85
|
0
|
|
|
|
|
0
|
return scalar @lines; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _find_changes { |
89
|
0
|
|
|
0
|
|
0
|
my ($self, $dir, $local, $remote) = @_; |
90
|
0
|
0
|
|
|
|
0
|
return { __error__ => "No remote" } |
91
|
|
|
|
|
|
|
unless defined $remote; |
92
|
0
|
|
|
|
|
0
|
local $ENV{GIT_DIR} = $dir; |
93
|
0
|
|
|
|
|
0
|
my @lines = lines_from_command |
94
|
|
|
|
|
|
|
['git', 'diff', '--name-only', $local, $remote]; |
95
|
0
|
|
|
|
|
0
|
return \@lines; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub _gather_git_config { |
99
|
1
|
|
|
1
|
|
5
|
my ($self, $config) = @_; |
100
|
1
|
|
|
|
|
5
|
my $pipe = $self->_open_git_config_pipe($config); |
101
|
1
|
|
|
|
|
3
|
my %config; |
102
|
1
|
|
|
|
|
5
|
while (defined( my $line = <$pipe> )) { |
103
|
4
|
|
|
|
|
5
|
chomp $line; |
104
|
4
|
|
|
|
|
21
|
my ($name, $value) = split m{=}, $line, 2; |
105
|
4
|
|
|
|
|
23
|
$config{ $name } = $value; |
106
|
|
|
|
|
|
|
} |
107
|
1
|
|
|
|
|
20
|
return { contents => \%config }; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub _open_git_config_pipe { |
111
|
1
|
|
|
1
|
|
2
|
my ($self, $config) = @_; |
112
|
1
|
|
|
|
|
11
|
return handle_from_command "git config --file $config --list"; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _open_locate_git_config_pipe { |
116
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
117
|
0
|
|
|
|
|
|
(my $root = $self->root) =~ s{/$}{}; |
118
|
0
|
|
|
|
|
|
return handle_from_command sprintf |
119
|
|
|
|
|
|
|
q{locate --regex '^%s/.*\\.git/config$'}, $root; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
1; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
__END__ |