turned into a dist
[scpubgit/System-Introspector.git] / lib / System / Introspector / Repositories / Git.pm
CommitLineData
5843e886 1package System::Introspector::Repositories::Git;
2use Moo;
3
1d5b2d19 4use System::Introspector::Util qw(
5 handle_from_command
6 transform_exceptions
7 lines_from_command
8);
9
e05a74d7 10has root => (
11 is => 'ro',
12 default => sub { '/' },
13);
14
5843e886 15sub gather {
16 my ($self) = @_;
1d5b2d19 17 return transform_exceptions {
18 my $pipe = $self->_open_locate_git_config_pipe;
19 my %location;
20 while (defined( my $line = <$pipe> )) {
21 chomp $line;
22 next unless $line =~ m{^(.+)/\.git/config$};
23 my $base = $1;
24 $location{ $base } = $self->_gather_git_info($line);
25 }
26 return { git => \%location };
27 };
5843e886 28}
29
30sub _gather_git_info {
31 my ($self, $config) = @_;
32 return {
1d5b2d19 33 config_file => $config,
34 config => transform_exceptions {
35 $self->_gather_git_config($config);
36 },
37 tracked => transform_exceptions {
38 $self->_gather_track_info($config);
39 },
5843e886 40 };
41}
42
e05a74d7 43sub _gather_track_info {
44 my ($self, $config) = @_;
45 (my $git_dir = $config) =~ s{/config$}{};
1d5b2d19 46 return $self->_find_tracking($git_dir);
e05a74d7 47}
48
49sub _find_tracking {
50 my ($self, $dir) = @_;
1d5b2d19 51 local $ENV{GIT_DIR} = $dir;
52 my @lines = lines_from_command
53 ['git', 'for-each-ref',
1eff200c 54 '--format', q{OK %(refname:short) %(upstream:short)},
1d5b2d19 55 'refs/heads',
56 ];
e05a74d7 57 my %branch;
58 for my $line (@lines) {
59 if ($line =~ m{^OK\s+(\S+)\s+(\S+)?$}) {
60 my ($local, $remote) = ($1, $2);
61 $branch{ $local } = {
62 upstream => $remote,
1d5b2d19 63 changed_files => transform_exceptions {
64 $self->_find_changes($dir, $local, $remote);
65 },
66 local_commit_count => transform_exceptions {
67 $self->_find_commits($dir, $local, $remote);
68 },
e05a74d7 69 }
70 }
71 else {
72 return { error => join "\n", @lines };
73 }
74 }
75 return { branches => \%branch };
76}
77
78sub _find_commits {
79 my ($self, $dir, $local, $remote) = @_;
80 return { error => "No remote" }
81 unless defined $remote;
1d5b2d19 82 local $ENV{GIT_DIR} = $dir;
83 my @lines = lines_from_command
84 ['git', 'log', '--oneline', "$remote..$local"];
85 return { count => scalar @lines };
e05a74d7 86}
87
88sub _find_changes {
89 my ($self, $dir, $local, $remote) = @_;
90 return { error => "No remote" }
91 unless defined $remote;
1d5b2d19 92 local $ENV{GIT_DIR} = $dir;
93 my @lines = lines_from_command
94 ['git', 'diff', '--name-only', $local, $remote];
95 return { list => \@lines };
e05a74d7 96}
97
5843e886 98sub _gather_git_config {
99 my ($self, $config) = @_;
100 my $pipe = $self->_open_git_config_pipe($config);
101 my %config;
102 while (defined( my $line = <$pipe> )) {
103 chomp $line;
104 my ($name, $value) = split m{=}, $line, 2;
105 $config{ $name } = $value;
106 }
1d5b2d19 107 return { contents => \%config };
5843e886 108}
109
110sub _open_git_config_pipe {
111 my ($self, $config) = @_;
1d5b2d19 112 return handle_from_command "git config --file $config --list";
5843e886 113}
114
115sub _open_locate_git_config_pipe {
116 my ($self) = @_;
1d5b2d19 117 (my $root = $self->root) =~ s{/$}{};
118 return handle_from_command sprintf
119 q{locate --regex '^%s/.*\\.git/config$'}, $root;
5843e886 120}
121
1221;
535e84b6 123
124__END__
125
126=head1 NAME
127
128System::Introspector::Repositories::Git - Gather Git repository info
129
130=head1 DESCRIPTION
131
132Find Git repositories and gathers their information.
133
134=head1 ATTRIBUTES
135
136=head2 root
137
138This is the root path for the search of git directories. Defaults to C</>.
139
140=head1 SEE ALSO
141
142=over
143
144=item L<System::Introspector>
145
146=back
147
148=cut
149