lib/System/Introspector/Report/Builder/Repositories/Git/Locations.pm

   1 package System::Introspector::Report::Builder::Repositories::Git::Locations;
   2 use Moo;
   3
   4 extends 'System::Introspector::Report::Builder';
   5
   6 has collect_matching        => (is => 'ro', default => sub { [] });
   7 has _locations_by_origin    => (is => 'lazy', default => sub { {} });
   8
   9 sub required_data {
  10   return qw(
  11     repositories/git
  12     host
  13   );
  14 }
  15
  16 sub _match_origin {
  17   my ($self, $origin) = @_;
  18   my @match_rx = @{ $self->collect_matching };
  19   for my $rx (@match_rx) {
  20     if ($origin =~ qr{^$rx$}i) {
  21       return $1;
  22     }
  23   }
  24   return undef;
  25 }
  26
  27 my $_trim = sub {
  28     my ($string) = @_;
  29     $string =~ s{^\s*}{}g;
  30     $string =~ s{\s*$}{}g;
  31     return $string;
  32 };
  33
  34 my $_format_commit = sub {
  35     my ($current) = @_;
  36     my @lines = @{ $current->{commit} || [] };
  37     return undef
  38         unless @lines;
  39     (my $commit = shift @lines) =~ s{^commit\s+}{}i;
  40     my %header;
  41     HEADER: while (my $line = shift @lines) {
  42         if ($line =~ m{^([^:]+):\s*(.+)$}) {
  43             $header{$1} = $2;
  44         }
  45         elsif ($line =~ m{^\s*$}) {
  46             last HEADER;
  47         }
  48         else {
  49             return 'Unable to parse message headers';
  50         }
  51     }
  52     my $title = '';
  53     while (my $line = shift @lines) {
  54         if ($line =~ m{\S}) {
  55             $title = $line;
  56         }
  57     }
  58     return join("\n",
  59         $commit->$_trim,
  60         sprintf('by %s', $header{Author} || ''),
  61         sprintf('at %s', $header{CommitDate} || ''),
  62         $title->$_trim,
  63     );
  64 };
  65
  66 my $_commit_count = sub {
  67     my ($data) = @_;
  68     my $branch = $data->{current}{branch};
  69     return undef
  70         unless defined $branch;
  71     if (my $cnt = $data->{tracked}{branches}{$branch}{local_commit_count}) {
  72         return $cnt
  73             if defined($cnt) and not(ref $cnt);
  74     }
  75     if (my $cnt = $data->{current}{origin}{local_commit_count}) {
  76         return $cnt
  77             if defined($cnt) and not(ref $cnt);
  78     }
  79     return undef;
  80 };
  81
  82 sub collect_from {
  83   my ($self, $remote, $data) = @_;
  84   my $git = $data->{'repositories/git'}{git} || {};
  85   for my $location (keys %$git) {
  86     my $origin  = $git->{$location}{config}{contents}{'remote.origin.url'}
  87       or next;
  88     my $matched = $self->_match_origin($origin)
  89       or next;
  90     my $current = $git->{$location}{current} || {};
  91     push @{$self->_locations_by_origin->{$matched}}, {
  92       remote        => $remote,
  93       hostname      => $data->{host}{hostname},
  94       location      => $location,
  95       origin        => $origin,
  96       local_count   => $git->{$location}->$_commit_count,
  97       branch        => $current->{branch},
  98       last_commit   => $current->$_format_commit,
  99     };
 100   }
 101   return 1;
 102 }
 103
 104 sub render_reports {
 105   my ($self) = @_;
 106   my @columns = (
 107     { key => 'remote',      label => 'Remote Host' },
 108     { key => 'hostname',    label => 'Hostname' },
 109     { key => 'location',    label => 'Location' },
 110     { key => 'branch',      label => 'Branch' },
 111     { key => 'local_count', label => 'Changes' },
 112     { key => 'last_commit', label => 'Last Commit' },
 113   );
 114   my $collected = $self->_locations_by_origin;
 115   return map {
 116     my $identifier  = $_;
 117     my $rows        = $collected->{$identifier};
 118     {
 119       columns   => [@columns],
 120       title     => "$identifier Checkouts",
 121       id        => ['repositories-git-locations', $identifier],
 122       rowid     => [qw( remote location )],
 123       meta      => { repository => $identifier },
 124       rows      => [
 125         sort {
 126           ($a->{remote} cmp $b->{remote})
 127             ||
 128           ($a->{location} cmp $b->{location})
 129         } @$rows,
 130       ],
 131     };
 132   } keys %$collected;
 133 }
 134
 135 1;