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 |