File Coverage

blib/lib/Group/Git/Cmd/Stats.pm
Criterion Covered Total %
statement 33 87 37.9
branch 0 34 0.0
condition 0 5 0.0
subroutine 11 14 78.5
pod 3 3 100.0
total 47 143 32.8


line stmt bran cond sub pod time code
1             package Group::Git::Cmd::Stats;
2              
3             # Created on: 2013-05-10 07:05:17
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   68897 use strict;
  1         2  
  1         28  
10 1     1   442 use version;
  1         1917  
  1         5  
11 1     1   535 use Moose::Role;
  1         469981  
  1         5  
12 1     1   6851 use Carp;
  1         2  
  1         85  
13 1     1   9 use List::Util qw/max/;
  1         2  
  1         60  
14 1     1   790 use Data::Dumper qw/Dumper/;
  1         7079  
  1         62  
15 1     1   520 use English qw/ -no_match_vars /;
  1         3619  
  1         6  
16 1     1   823 use File::chdir;
  1         3229  
  1         121  
17 1     1   852 use Path::Tiny;
  1         12671  
  1         101  
18 1     1   625 use Getopt::Alt;
  1         261130  
  1         8  
19 1     1   1447 use YAML::Syck;
  1         2161  
  1         908  
20              
21             our $VERSION = version->new('0.0.4');
22              
23             my $opt = Getopt::Alt->new(
24             {
25             helper => 1,
26             help => __PACKAGE__,
27             default => {
28             by => 'name',
29             of => 'commits',
30             },
31             },
32             [
33             'by|b=s',
34             'of|o=s',
35             'verbose|v+',
36             'quiet|q!',
37             ]
38             );
39              
40             sub stats_start {
41 0     0 1   $opt->process;
42              
43 0           return;
44             }
45              
46             my $collected = {};
47             sub stats {
48 0     0 1   my ($self, $name) = @_;
49              
50 0 0         return unless -d $name;
51              
52 0 0         $opt->process if !%{ $opt->opt || {} };
  0 0          
53              
54 0           my $dir = path($CWD);
55 0           my $stats = $dir->path('.stats');
56 0           my $log_file = $stats->path('error.log');
57              
58 0           local $CWD = $name;
59              
60 0           my $cache = $dir->path('.stats', $name . '.yml');
61 0           $cache->parent->mkpath;
62 0           my %stats;
63              
64 0 0         if ( -f $cache ) {
65 0           %stats = %{ LoadFile($cache) };
  0            
66             }
67              
68 0           open my $pipe, '-|', q{git log --format=format:"%H';'%ai';'%an';'%ae"};
69              
70 0           while (my $log = <$pipe>) {
71 0           chomp $log;
72 0           my ($id, $date, $name, $email) = split q{';'}, $log, 4;
73              
74 0 0         last if $stats{$id};
75              
76             # dodgy date handling but hay
77 0           $date =~ s/\s.+$//;
78              
79 0 0         unlink $log_file if -f $log_file;
80 0           open my $show, '-|', qq{git show '$id' 2> $log | grep -Pv '^[+][+][+]|^[-][-][-]' | grep -Pv '^[^-+]'};
81 0           my ($added, $removed, $total, $lines) = (0, 0, 0, 0);
82 0           while (my $change = <$show>) {
83 0 0         $total = $change =~ /^[+]/ ? $added++ : $removed++;
84 0           $lines++;
85             }
86 0 0         if ( -s $log_file ) {
87 0           warn qq{git show $id 2> $log_file | grep -v '^[+][+][+]|^[-][-][-]' | grep -v '^[^-+]'\n};
88 0           return;
89             }
90              
91 0           $stats{$id} = {
92             name => $name,
93             email => $email,
94             date => $date,
95             added => $added,
96             removed => $removed,
97             lines => $lines,
98             };
99             }
100              
101 0           DumpFile($cache, \%stats);
102              
103 0           $collected->{$name} = \%stats;
104              
105 0           return;
106             }
107              
108             sub stats_end {
109 0 0   0 1   if ( -d '.stats' ) {
110 0           DumpFile('.stats/collated.yml', $collected);
111 0           my $out = '';
112              
113 0 0         my $type = $opt->opt->by eq 'email' ? 'email'
    0          
    0          
    0          
    0          
114             : $opt->opt->by eq 'name' ? 'name'
115             : $opt->opt->by eq 'date' ? 'date'
116             : $opt->opt->by eq 'total' ? 'total'
117             : $opt->opt->by eq 'repo' ? ''
118             : die "Unknown --by '" . $opt->opt->by . "'! (must be one of email, name or date)\n";
119              
120 0 0         my $of = $opt->opt->of eq 'commits' ? 'commits'
    0          
    0          
121             : $opt->opt->of eq 'additions' ? 'added'
122             : $opt->opt->of eq 'removals' ? 'removed'
123             : die "Unknown --of '" . $opt->opt->of . "'! (must be one of commits, additions or removals)\n";
124              
125 0           my %stats;
126 0           for my $repo (keys %{ $collected }) {
  0            
127 0           for my $id (keys %{ $collected->{$repo} }) {
  0            
128 0   0       $stats{ $collected->{$repo}{$id}{$type} // $repo } += $collected->{$repo}{$id}{$of} // 1;
      0        
129             }
130             }
131              
132 0           my @items = sort { $stats{$a} <=> $stats{$b} } keys %stats;
  0            
133 0           my $max = max map {length $_} @items;
  0            
134 0           for my $item (@items) {
135 0           $out .= sprintf "%-${max}s %d\n", $item, $stats{$item};
136             }
137              
138 0           return $out;
139             }
140              
141 0           return "No stats!\n";
142             }
143              
144             1;
145              
146             __END__
147              
148             =head1 NAME
149              
150             Group::Git::Cmd::Stats - Group-Git tools to show statistics across many repositories
151              
152             =head1 VERSION
153              
154             This documentation refers to Group::Git::Cmd::Stats version 0.0.4
155              
156             =head1 SYNOPSIS
157              
158             use Group::Git::Cmd::Stats;
159              
160             # Brief but working code example(s) here showing the most common usage(s)
161             # This section will be as far as many users bother reading, so make it as
162             # educational and exemplary as possible.
163              
164              
165             =head1 DESCRIPTION
166              
167             Adds the stats command to L<Group::Git> which allows you to collect statistics
168             across many repositories.
169              
170             =head1 SUBROUTINES/METHODS
171              
172             =head2 C<stats ($name)>
173              
174             Collects the stats for each repository.
175              
176             =head2 C<stats_start ()>
177              
178             Initializes stats
179              
180             =head2 C<stats_end ()>
181              
182             Outputs the stats results.
183              
184             =head1 DIAGNOSTICS
185              
186             =head1 CONFIGURATION AND ENVIRONMENT
187              
188             =head1 DEPENDENCIES
189              
190             =head1 INCOMPATIBILITIES
191              
192             =head1 BUGS AND LIMITATIONS
193              
194             There are no known bugs in this module.
195              
196             Please report problems to Ivan Wills (ivan.wills@gmail.com).
197              
198             Patches are welcome.
199              
200             =head1 AUTHOR
201              
202             Ivan Wills - (ivan.wills@gmail.com)
203              
204             =head1 LICENSE AND COPYRIGHT
205              
206             Copyright (c) 2013 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
207             All rights reserved.
208              
209             This module is free software; you can redistribute it and/or modify it under
210             the same terms as Perl itself. See L<perlartistic>. This program is
211             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
212             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
213             PARTICULAR PURPOSE.
214              
215             =cut