Merge branch 'kb/co-orphan-suggestion-short-sha1'
[git/mingw.git] / contrib / stats / mailmap.pl
blob9513f5e35b443c13cead1f73a27b5e76f94e8d66
1 #!/usr/bin/perl
3 use warnings 'all';
4 use strict;
5 use Getopt::Long;
7 my $match_emails;
8 my $match_names;
9 my $order_by = 'count';
10 Getopt::Long::Configure(qw(bundling));
11 GetOptions(
12 'emails|e!' => \$match_emails,
13 'names|n!' => \$match_names,
14 'count|c' => sub { $order_by = 'count' },
15 'time|t' => sub { $order_by = 'stamp' },
16 ) or exit 1;
17 $match_emails = 1 unless $match_names;
19 my $email = {};
20 my $name = {};
22 open(my $fh, '-|', "git log --format='%at <%aE> %aN'");
23 while(<$fh>) {
24 my ($t, $e, $n) = /(\S+) <(\S+)> (.*)/;
25 mark($email, $e, $n, $t);
26 mark($name, $n, $e, $t);
28 close($fh);
30 if ($match_emails) {
31 foreach my $e (dups($email)) {
32 foreach my $n (vals($email->{$e})) {
33 show($n, $e, $email->{$e}->{$n});
35 print "\n";
38 if ($match_names) {
39 foreach my $n (dups($name)) {
40 foreach my $e (vals($name->{$n})) {
41 show($n, $e, $name->{$n}->{$e});
43 print "\n";
46 exit 0;
48 sub mark {
49 my ($h, $k, $v, $t) = @_;
50 my $e = $h->{$k}->{$v} ||= { count => 0, stamp => 0 };
51 $e->{count}++;
52 $e->{stamp} = $t unless $t < $e->{stamp};
55 sub dups {
56 my $h = shift;
57 return grep { keys($h->{$_}) > 1 } keys($h);
60 sub vals {
61 my $h = shift;
62 return sort {
63 $h->{$b}->{$order_by} <=> $h->{$a}->{$order_by}
64 } keys($h);
67 sub show {
68 my ($n, $e, $h) = @_;
69 print "$n <$e> ($h->{$order_by})\n";