lib/System/Introspector/Probe/Repositories/Git.pm

   1 package System::Introspector::Probe::Repositories::Git;
   2 use Moo;
   3
   4 use System::Introspector::Util qw(
   5     handle_from_command
   6     transform_exceptions
   7     lines_from_command
   8 );
   9
  10 has root => (
  11     is      => 'ro',
  12     default => sub { '/' },
  13 );
  14
  15 sub gather {
  16     my ($self) = @_;
  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     };
  28 }
  29
  30 sub _gather_git_info {
  31     my ($self, $config) = @_;
  32     (my $git_dir = $config) =~ s{/config$}{};
  33     return {
  34         config_file => $config,
  35         current     => transform_exceptions {
  36             $self->_gather_current_state($git_dir);
  37         },
  38         config      => transform_exceptions {
  39             $self->_gather_git_config($config);
  40         },
  41         tracked     => transform_exceptions {
  42             $self->_gather_track_info($git_dir);
  43         },
  44     };
  45 }
  46
  47 sub _gather_current_state {
  48     my ($self, $git_dir) = @_;
  49     local $ENV{GIT_DIR} = $git_dir;
  50     my ($active_branch) =
  51         map { s{^\s*\*\s+}{}; $_ }
  52         grep { m{^\s*\*\s+(.+)$} }
  53         lines_from_command ['git', 'branch'];
  54     return { __error__ => 'No active branch' }
  55         unless $active_branch;
  56     my @log_lines = lines_from_command [
  57         'git', 'log',
  58         '-n1',
  59         '--date=iso',
  60         '--pretty=fuller',
  61     ];
  62     return {
  63         branch => $active_branch,
  64         commit => [@log_lines],
  65         origin => transform_exceptions {
  66             my $count = $self->_find_commit_count(
  67                 $git_dir,
  68                 $active_branch,
  69                 "origin/$active_branch",
  70             );
  71             return {
  72                 local_commit_count => $count,
  73             };
  74         },
  75     };
  76 }
  77
  78 sub _gather_track_info {
  79     my ($self, $git_dir) = @_;
  80     return $self->_find_tracking($git_dir);
  81 }
  82
  83 sub _find_tracking {
  84     my ($self, $dir) = @_;
  85     local $ENV{GIT_DIR} = $dir;
  86     my @lines = lines_from_command
  87         ['git', 'for-each-ref',
  88             '--format', q{OK %(refname:short) %(upstream:short)},
  89             'refs/heads',
  90         ];
  91     my %branch;
  92     for my $line (@lines) {
  93         if ($line =~ m{^OK\s+(\S+)\s+(\S+)?$}) {
  94             my ($local, $remote) = ($1, $2);
  95             $branch{ $local } = {
  96                 upstream => $remote,
  97                 changed_files => transform_exceptions {
  98                     $self->_find_changes($dir, $local, $remote);
  99                 },
 100                 local_commit_count => transform_exceptions {
 101                     $self->_find_commit_count($dir, $local, $remote);
 102                 },
 103             }
 104         }
 105         else {
 106             return { __error__ => join "\n", @lines };
 107         }
 108     }
 109     return { branches => \%branch };
 110 }
 111
 112 sub _find_commit_count {
 113     my ($self, $dir, $local, $remote) = @_;
 114     return { __error__ => "No remote" }
 115         unless defined $remote;
 116     local $ENV{GIT_DIR} = $dir;
 117     my @lines = lines_from_command
 118         ['git', 'log', '--oneline', "$remote..$local"];
 119     return scalar @lines;
 120 }
 121
 122 sub _find_changes {
 123     my ($self, $dir, $local, $remote) = @_;
 124     return { __error__ => "No remote" }
 125         unless defined $remote;
 126     local $ENV{GIT_DIR} = $dir;
 127     my @lines = lines_from_command
 128         ['git', 'diff', '--name-only', $local, $remote];
 129     return \@lines;
 130 }
 131
 132 sub _gather_git_config {
 133     my ($self, $config) = @_;
 134     my $pipe = $self->_open_git_config_pipe($config);
 135     my %config;
 136     while (defined( my $line = <$pipe> )) {
 137         chomp $line;
 138         my ($name, $value) = split m{=}, $line, 2;
 139         $config{ $name } = $value;
 140     }
 141     return { contents => \%config };
 142 }
 143
 144 sub _open_git_config_pipe {
 145     my ($self, $config) = @_;
 146     return handle_from_command "git config --file $config --list";
 147 }
 148
 149 sub _open_locate_git_config_pipe {
 150     my ($self) = @_;
 151     (my $root = $self->root) =~ s{/$}{};
 152     return handle_from_command sprintf
 153         q{locate --regex '^%s/.*\\.git/config$'}, $root;
 154 }
 155
 156 1;
 157
 158 __END__
 159
 160 =head1 NAME
 161
 162 System::Introspector::Probe::Repositories::Git - Gather Git repository info
 163
 164 =head1 DESCRIPTION
 165
 166 Find Git repositories and gathers their information.
 167
 168 =head1 ATTRIBUTES
 169
 170 =head2 root
 171
 172 This is the root path for the search of git directories. Defaults to C</>.
 173
 174 =head1 SEE ALSO
 175
 176 =over
 177
 178 =item L<System::Introspector>
 179
 180 =back
 181
 182 =head1 COPYRIGHT
 183
 184 Copyright (c) 2012 the L<System::Introspector>
 185 L<AUTHOR|System::Introspector/AUTHOR>,
 186 L<CONTRIBUTORS|System::Introspector/CONTRIBUTORS> and
 187 L<SPONSORS|System::Introspector/SPONSORS>.
 188
 189 =head1 LICENSE
 190
 191 This library is free software and may be distributed under the same terms
 192 as perl itself.
 193
 194 =cut