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