File: make-authors.pl

package info (click to toggle)
openmpi 5.0.8-4
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 201,684 kB
  • sloc: ansic: 613,078; makefile: 42,353; sh: 11,194; javascript: 9,244; f90: 7,052; java: 6,404; perl: 5,179; python: 1,859; lex: 740; fortran: 61; cpp: 20; tcl: 12
file content (171 lines) | stat: -rwxr-xr-x 4,595 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
#!/usr/bin/env perl
#
# Copyright (c) 2008-2016 Cisco Systems, Inc.  All rights reserved.
# Copyright (c) 2017      Amazon.com, Inc. or its affiliates.
#                         All Rights reserved.
#

use strict;

use Data::Dumper;
use Getopt::Long;
use Cwd;

# Ensure that we're in the root of a writeable Git clone
my $in_git_clone = 1;
my $skip_ok = 0;
my $quiet = 0;
my $srcdir = ".";
my $destdir = getcwd();

GetOptions("skip-ok" => \$skip_ok,
	   "quiet" => \$quiet,
	   "srcdir=s" => \$srcdir,
	   "destdir=s" => \$destdir)
    or die("Error in command line arguments\n");

# we still work with git old enough to not have the -C option, and the
# --git-dir option screws up .mailmap, so just jump into the source
# directory and make life easier.
chdir($srcdir);

if (! -e ".git") {
    if ($skip_ok == 0) {
	print STDERR "I don't seem to be in a git repo :(\n";
	exit(1);
    } else {
	# called from make dist, just exit quietly (for case where
	# user runs "make dist" from a dist tarball)
	exit(0);
    }
}

######################################################################

my $people;

######################################################################

# Run git log to get a list of committers

open (GIT, "git log --no-merges --format=tformat:'%aN <%aE>'|") || die "Can't run 'git log'.";
while (<GIT>) {
    chomp;
    m/^\s*(.+)\s+<(.+)>\s*$/;

    my $email = lc($2);

    # special case from the SVN migration
    if ($email eq 'no-author@open-mpi.org') { next; }
    # skip the mpi bot...
    if ($email eq 'mpiteam@open-mpi.org') { next; }

    if (!exists($people->{$1})) {
        # The person doesn't exist, so save a new entry
        $people->{$1} = {
            name => $1,
            emails => {
                $email => 1,
            }
        };

        if ($quiet == 0) { print STDOUT "Found Git committer: $1 <$email>\n"; }
    } else {
        # The person already exists, so just add (or overwrite) this
        # email address
        $people->{$1}->{emails}->{$email} = 1;
    }
}
close(GIT);

if (scalar(keys(%{$people})) == 0) {
    print STDERR "Found no author entries, assuming git broke.  Aborting!\n";
    exit(1);
}

######################################################################

# Output a new AUTHORS file

open (AUTHORS, ">$destdir/AUTHORS") || die "Can't write to AUTHORS file";

my $header = <<'END_HEADER';
Open MPI Authors
================

The following cumulative list contains the names and email addresses
of all individuals who have committed code to the Open MPI repository
(either directly or through a third party, such as through a
Github.com pull request).  Note that these email addresses are not
guaranteed to be current; they are simply a unique indicator of the
individual who committed them.


END_HEADER
print AUTHORS $header;

my $email_dups;

my @sorted_people = sort(keys(%{$people}));
foreach my $p (@sorted_people) {
    print AUTHORS "$p\n";

    foreach my $e (sort(keys(%{$people->{$p}->{emails}}))) {
        # Sanity check: make sure this email address does not show up
        # with any other person/name
        my $dup;
        foreach my $p2 (@sorted_people) {
            next
                if ($p eq $p2);

            foreach my $e2 (keys(%{$people->{$p2}->{emails}})) {
                if ($e eq $e2) {
                    $dup = $p2;

                    # Record this so that we can warn about it
                    if ($p le $p2) {
                        $email_dups->{$p} = $p2;
                    } else {
                        $email_dups->{$p2} = $p;
                    }
                    last;
                }
            }

            last
                if (defined($dup));
        }

        print AUTHORS "  $e";
        print AUTHORS " (**** DUPLICATE EMAIL ADDRESS WITH $dup ***)"
            if (defined($dup));
        print AUTHORS "\n";
    }
}
close(AUTHORS);

print STDOUT "New AUTHORS file written.\n";

######################################################################

# Output any relevant warnings

my $warned = 0;

my @k = sort(keys(%{$email_dups}));
if ($#k >= 0) {
    $warned = 1;
    print STDERR "\n*** WARNING: The following people had the same email address:\n";
    foreach my $p (@k) {
        print STDERR "***   $p, $email_dups->{$p}\n";
    }
}

if ($warned) {
    print STDERR "
*******************************************************************************
*** YOU SHOULD EDIT THE .mailmap FILE TO RESOLVE THESE WARNINGS!
*******************************************************************************\n";
}

exit($warned);