| 1 |
#!/usr/bin/perl |
| 2 |
use strict; |
| 3 |
use feature qw( switch ); |
| 4 |
use Getopt::Euclid; |
| 5 |
use List::MoreUtils qw( any ); |
| 6 |
|
| 7 |
my %authors; |
| 8 |
my $total; |
| 9 |
my $files; |
| 10 |
|
| 11 |
my %aliases = split /[,=]/, $ARGV{'-a'}; |
| 12 |
my @exclude = split(',', $ARGV{'-e'}); |
| 13 |
|
| 14 |
sub alias { |
| 15 |
my $alias = shift; |
| 16 |
exists $aliases{$alias} ? $aliases{$alias} : $alias; |
| 17 |
} |
| 18 |
sub exclude { |
| 19 |
my $file = shift; |
| 20 |
any { $file =~ /^$_/ } @exclude; |
| 21 |
} |
| 22 |
|
| 23 |
my @blame_args = (); |
| 24 |
given(1) { |
| 25 |
when($ARGV{'-w'}) { |
| 26 |
push @blame_args, '-w'; continue; |
| 27 |
} |
| 28 |
when($ARGV{'-C'}) { |
| 29 |
push @blame_args, '-C'; continue; |
| 30 |
} |
| 31 |
} |
| 32 |
|
| 33 |
foreach my $file (`git ls-tree --name-only -r $ARGV{'<rev>'}`) { |
| 34 |
next if exclude $file; |
| 35 |
chomp($file); |
| 36 |
print STDERR "Processing $file\n"; |
| 37 |
foreach my $line (`git blame @blame_args $ARGV{'<rev>'} -- "$file"`) { |
| 38 |
chomp($line); |
| 39 |
if (substr($line, 0, 1) eq "^") { |
| 40 |
++$authors{"*initial checkin"}; |
| 41 |
} else { |
| 42 |
$line =~ s[^.*?\((.*?)\s*\d{4}-\d{2}-\d{2}.*][$1]; |
| 43 |
++$authors{alias $line}; |
| 44 |
} |
| 45 |
++$total; |
| 46 |
} |
| 47 |
} |
| 48 |
|
| 49 |
print "Total lines: $total\n"; |
| 50 |
foreach my $author (sort { $authors{$b} <=> $authors{$a} } keys %authors) { |
| 51 |
printf "%12u %5.2f%% %s\n", |
| 52 |
$authors{$author}, |
| 53 |
$authors{$author} * 100 / $total, |
| 54 |
$author; |
| 55 |
} |
| 56 |
|
| 57 |
exit(0); |
| 58 |
|
| 59 |
__END__ |
| 60 |
|
| 61 |
=head1 NAME |
| 62 |
|
| 63 |
git-blame-stats - script witch uses git blame to work out who owns how much |
| 64 |
|
| 65 |
=head1 DESCRIPTION |
| 66 |
|
| 67 |
Modified script by Jan Engelhardt which uses the git blame command to work out who owns how much. |
| 68 |
|
| 69 |
Original version: http://dev.medozas.de/gitweb.cgi?p=hxtools;a=blob;f=libexec/git-blame-stats;hb=HEAD |
| 70 |
Where I found this script: http://use.perl.org/~acme/journal/39082?from=rss |
| 71 |
|
| 72 |
=head1 OPTIONS |
| 73 |
|
| 74 |
=over |
| 75 |
|
| 76 |
=item <rev> |
| 77 |
|
| 78 |
Revision (default: HEAD). |
| 79 |
|
| 80 |
=for Euclid: |
| 81 |
rev.default: 'HEAD' |
| 82 |
|
| 83 |
=item -e <files> |
| 84 |
|
| 85 |
Exclude the given files. Multiple files may be given separated by commas. |
| 86 |
|
| 87 |
=for Euclid: |
| 88 |
files.type: string |
| 89 |
files.type.error: --files must be given a comma-separated list of files names |
| 90 |
|
| 91 |
=item -a <aliases> |
| 92 |
|
| 93 |
Set aliases of author names as key=value pairs. (e.g. -a John=JohnDoe) Multiple aliases may be given separated by commas. |
| 94 |
|
| 95 |
=for Euclid: |
| 96 |
aliases.type: string, aliases =~ /\A([^=]+=[^=]+)(,[^=]+=[^=]+)*\Z/ |
| 97 |
aliases.type.error: --aliases must be given a comma-separated of key=value pairs |
| 98 |
|
| 99 |
=item -w |
| 100 |
|
| 101 |
Ignore whitespace, see: 'git help blame' for details. |
| 102 |
|
| 103 |
=item -C |
| 104 |
|
| 105 |
Detect lines copied from other files, see: 'git help blame' for details. |
| 106 |
|
| 107 |
=back |