lib/System/Introspector/Repositories/Git.pm

   1 package System::Introspector::Repositories::Git;
   2 use Moo;
   3
   4 has root => (
   5     is      => 'ro',
   6     default => sub { '/' },
   7 );
   8
   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),
  27         tracked         => $self->_gather_track_info($config),
  28     };
  29 }
  30
  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
  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) = @_;
 109     my $root = $self->root;
 110     $root =~ s{/$}{};
 111     my $command = sprintf q{locate --regex '^%s/.*\\.git/config$'}, $root;
 112     open my $pipe, '-|', $command
 113         or die "Unable to open pipe to '$command': $!\n";
 114     return $pipe;
 115 }
 116
 117 1;