lib/System/Introspector/Repositories/Git.pm

   1 package System::Introspector::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     return {
  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         },
  40     };
  41 }
  42
  43 sub _gather_track_info {
  44     my ($self, $config) = @_;
  45     (my $git_dir = $config) =~ s{/config$}{};
  46     return $self->_find_tracking($git_dir);
  47 }
  48
  49 sub _find_tracking {
  50     my ($self, $dir) = @_;
  51     local $ENV{GIT_DIR} = $dir;
  52     my @lines = lines_from_command
  53         ['git', 'for-each-ref',
  54             '--format', q{OK %(refname:short) %(upstream:short)},
  55             'refs/heads',
  56         ];
  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,
  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                 },
  69             }
  70         }
  71         else {
  72             return { error => join "\n", @lines };
  73         }
  74     }
  75     return { branches => \%branch };
  76 }
  77
  78 sub _find_commits {
  79     my ($self, $dir, $local, $remote) = @_;
  80     return { error => "No remote" }
  81         unless defined $remote;
  82     local $ENV{GIT_DIR} = $dir;
  83     my @lines = lines_from_command
  84         ['git', 'log', '--oneline', "$remote..$local"];
  85     return { count => scalar @lines };
  86 }
  87
  88 sub _find_changes {
  89     my ($self, $dir, $local, $remote) = @_;
  90     return { error => "No remote" }
  91         unless defined $remote;
  92     local $ENV{GIT_DIR} = $dir;
  93     my @lines = lines_from_command
  94         ['git', 'diff', '--name-only', $local, $remote];
  95     return { list => \@lines };
  96 }
  97
  98 sub _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     }
 107     return { contents => \%config };
 108 }
 109
 110 sub _open_git_config_pipe {
 111     my ($self, $config) = @_;
 112     return handle_from_command "git config --file $config --list";
 113 }
 114
 115 sub _open_locate_git_config_pipe {
 116     my ($self) = @_;
 117     (my $root = $self->root) =~ s{/$}{};
 118     return handle_from_command sprintf
 119         q{locate --regex '^%s/.*\\.git/config$'}, $root;
 120 }
 121
 122 1;
 123
 124 __END__
 125
 126 =head1 NAME
 127
 128 System::Introspector::Repositories::Git - Gather Git repository info
 129
 130 =head1 DESCRIPTION
 131
 132 Find Git repositories and gathers their information.
 133
 134 =head1 ATTRIBUTES
 135
 136 =head2 root
 137
 138 This 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