Commit 7fa8ff2e0c0f326cdaaa4ae7d00f5d021e43ffa2

Authored by Florian Mickler
Committed by Linus Torvalds
1 parent 6ef1c52e12

scripts/get_maintainer.pl: fix mailmap handling

Implement it, like it is described in git-shortlog.

Signed-off-by: Florian Mickler <florian@mickler.org>
Signed-off-by: Joe Perches <joe@perches.com>
Signed-off-by: Andrew Morton <akpm@linux-foundation.org>
Signed-off-by: Linus Torvalds <torvalds@linux-foundation.org>

Showing 1 changed file with 109 additions and 38 deletions Inline Diff

scripts/get_maintainer.pl
1 #!/usr/bin/perl -w 1 #!/usr/bin/perl -w
2 # (c) 2007, Joe Perches <joe@perches.com> 2 # (c) 2007, Joe Perches <joe@perches.com>
3 # created from checkpatch.pl 3 # created from checkpatch.pl
4 # 4 #
5 # Print selected MAINTAINERS information for 5 # Print selected MAINTAINERS information for
6 # the files modified in a patch or for a file 6 # the files modified in a patch or for a file
7 # 7 #
8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
9 # perl scripts/get_maintainer.pl [OPTIONS] -f <file> 9 # perl scripts/get_maintainer.pl [OPTIONS] -f <file>
10 # 10 #
11 # Licensed under the terms of the GNU GPL License version 2 11 # Licensed under the terms of the GNU GPL License version 2
12 12
13 use strict; 13 use strict;
14 14
15 my $P = $0; 15 my $P = $0;
16 my $V = '0.26-beta4'; 16 my $V = '0.26-beta4';
17 17
18 use Getopt::Long qw(:config no_auto_abbrev); 18 use Getopt::Long qw(:config no_auto_abbrev);
19 19
20 my $lk_path = "./"; 20 my $lk_path = "./";
21 my $email = 1; 21 my $email = 1;
22 my $email_usename = 1; 22 my $email_usename = 1;
23 my $email_maintainer = 1; 23 my $email_maintainer = 1;
24 my $email_list = 1; 24 my $email_list = 1;
25 my $email_subscriber_list = 0; 25 my $email_subscriber_list = 0;
26 my $email_git_penguin_chiefs = 0; 26 my $email_git_penguin_chiefs = 0;
27 my $email_git = 0; 27 my $email_git = 0;
28 my $email_git_all_signature_types = 0; 28 my $email_git_all_signature_types = 0;
29 my $email_git_blame = 0; 29 my $email_git_blame = 0;
30 my $email_git_blame_signatures = 1; 30 my $email_git_blame_signatures = 1;
31 my $email_git_fallback = 1; 31 my $email_git_fallback = 1;
32 my $email_git_min_signatures = 1; 32 my $email_git_min_signatures = 1;
33 my $email_git_max_maintainers = 5; 33 my $email_git_max_maintainers = 5;
34 my $email_git_min_percent = 5; 34 my $email_git_min_percent = 5;
35 my $email_git_since = "1-year-ago"; 35 my $email_git_since = "1-year-ago";
36 my $email_hg_since = "-365"; 36 my $email_hg_since = "-365";
37 my $interactive = 0; 37 my $interactive = 0;
38 my $email_remove_duplicates = 1; 38 my $email_remove_duplicates = 1;
39 my $output_multiline = 1; 39 my $output_multiline = 1;
40 my $output_separator = ", "; 40 my $output_separator = ", ";
41 my $output_roles = 0; 41 my $output_roles = 0;
42 my $output_rolestats = 0; 42 my $output_rolestats = 0;
43 my $scm = 0; 43 my $scm = 0;
44 my $web = 0; 44 my $web = 0;
45 my $subsystem = 0; 45 my $subsystem = 0;
46 my $status = 0; 46 my $status = 0;
47 my $keywords = 1; 47 my $keywords = 1;
48 my $sections = 0; 48 my $sections = 0;
49 my $file_emails = 0; 49 my $file_emails = 0;
50 my $from_filename = 0; 50 my $from_filename = 0;
51 my $pattern_depth = 0; 51 my $pattern_depth = 0;
52 my $version = 0; 52 my $version = 0;
53 my $help = 0; 53 my $help = 0;
54 54
55 my $vcs_used = 0; 55 my $vcs_used = 0;
56 56
57 my $exit = 0; 57 my $exit = 0;
58 58
59 my %commit_author_hash; 59 my %commit_author_hash;
60 my %commit_signer_hash; 60 my %commit_signer_hash;
61 61
62 my @penguin_chief = (); 62 my @penguin_chief = ();
63 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org"); 63 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
64 #Andrew wants in on most everything - 2009/01/14 64 #Andrew wants in on most everything - 2009/01/14
65 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org"); 65 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
66 66
67 my @penguin_chief_names = (); 67 my @penguin_chief_names = ();
68 foreach my $chief (@penguin_chief) { 68 foreach my $chief (@penguin_chief) {
69 if ($chief =~ m/^(.*):(.*)/) { 69 if ($chief =~ m/^(.*):(.*)/) {
70 my $chief_name = $1; 70 my $chief_name = $1;
71 my $chief_addr = $2; 71 my $chief_addr = $2;
72 push(@penguin_chief_names, $chief_name); 72 push(@penguin_chief_names, $chief_name);
73 } 73 }
74 } 74 }
75 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)"; 75 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
76 76
77 # Signature types of people who are either 77 # Signature types of people who are either
78 # a) responsible for the code in question, or 78 # a) responsible for the code in question, or
79 # b) familiar enough with it to give relevant feedback 79 # b) familiar enough with it to give relevant feedback
80 my @signature_tags = (); 80 my @signature_tags = ();
81 push(@signature_tags, "Signed-off-by:"); 81 push(@signature_tags, "Signed-off-by:");
82 push(@signature_tags, "Reviewed-by:"); 82 push(@signature_tags, "Reviewed-by:");
83 push(@signature_tags, "Acked-by:"); 83 push(@signature_tags, "Acked-by:");
84 84
85 # rfc822 email address - preloaded methods go here. 85 # rfc822 email address - preloaded methods go here.
86 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 86 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
87 my $rfc822_char = '[\\000-\\377]'; 87 my $rfc822_char = '[\\000-\\377]';
88 88
89 # VCS command support: class-like functions and strings 89 # VCS command support: class-like functions and strings
90 90
91 my %VCS_cmds; 91 my %VCS_cmds;
92 92
93 my %VCS_cmds_git = ( 93 my %VCS_cmds_git = (
94 "execute_cmd" => \&git_execute_cmd, 94 "execute_cmd" => \&git_execute_cmd,
95 "available" => '(which("git") ne "") && (-d ".git")', 95 "available" => '(which("git") ne "") && (-d ".git")',
96 "find_signers_cmd" => 96 "find_signers_cmd" =>
97 "git log --no-color --since=\$email_git_since " . 97 "git log --no-color --since=\$email_git_since " .
98 '--format="GitCommit: %H%n' . 98 '--format="GitCommit: %H%n' .
99 'GitAuthor: %an <%ae>%n' . 99 'GitAuthor: %an <%ae>%n' .
100 'GitDate: %aD%n' . 100 'GitDate: %aD%n' .
101 'GitSubject: %s%n' . 101 'GitSubject: %s%n' .
102 '%b%n"' . 102 '%b%n"' .
103 " -- \$file", 103 " -- \$file",
104 "find_commit_signers_cmd" => 104 "find_commit_signers_cmd" =>
105 "git log --no-color " . 105 "git log --no-color " .
106 '--format="GitCommit: %H%n' . 106 '--format="GitCommit: %H%n' .
107 'GitAuthor: %an <%ae>%n' . 107 'GitAuthor: %an <%ae>%n' .
108 'GitDate: %aD%n' . 108 'GitDate: %aD%n' .
109 'GitSubject: %s%n' . 109 'GitSubject: %s%n' .
110 '%b%n"' . 110 '%b%n"' .
111 " -1 \$commit", 111 " -1 \$commit",
112 "find_commit_author_cmd" => 112 "find_commit_author_cmd" =>
113 "git log --no-color " . 113 "git log --no-color " .
114 '--format="GitCommit: %H%n' . 114 '--format="GitCommit: %H%n' .
115 'GitAuthor: %an <%ae>%n' . 115 'GitAuthor: %an <%ae>%n' .
116 'GitDate: %aD%n' . 116 'GitDate: %aD%n' .
117 'GitSubject: %s%n"' . 117 'GitSubject: %s%n"' .
118 " -1 \$commit", 118 " -1 \$commit",
119 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file", 119 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
120 "blame_file_cmd" => "git blame -l \$file", 120 "blame_file_cmd" => "git blame -l \$file",
121 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})", 121 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
122 "blame_commit_pattern" => "^([0-9a-f]+) ", 122 "blame_commit_pattern" => "^([0-9a-f]+) ",
123 "author_pattern" => "^GitAuthor: (.*)", 123 "author_pattern" => "^GitAuthor: (.*)",
124 "subject_pattern" => "^GitSubject: (.*)", 124 "subject_pattern" => "^GitSubject: (.*)",
125 ); 125 );
126 126
127 my %VCS_cmds_hg = ( 127 my %VCS_cmds_hg = (
128 "execute_cmd" => \&hg_execute_cmd, 128 "execute_cmd" => \&hg_execute_cmd,
129 "available" => '(which("hg") ne "") && (-d ".hg")', 129 "available" => '(which("hg") ne "") && (-d ".hg")',
130 "find_signers_cmd" => 130 "find_signers_cmd" =>
131 "hg log --date=\$email_hg_since " . 131 "hg log --date=\$email_hg_since " .
132 "--template='HgCommit: {node}\\n" . 132 "--template='HgCommit: {node}\\n" .
133 "HgAuthor: {author}\\n" . 133 "HgAuthor: {author}\\n" .
134 "HgSubject: {desc}\\n'" . 134 "HgSubject: {desc}\\n'" .
135 " -- \$file", 135 " -- \$file",
136 "find_commit_signers_cmd" => 136 "find_commit_signers_cmd" =>
137 "hg log " . 137 "hg log " .
138 "--template='HgSubject: {desc}\\n'" . 138 "--template='HgSubject: {desc}\\n'" .
139 " -r \$commit", 139 " -r \$commit",
140 "find_commit_author_cmd" => 140 "find_commit_author_cmd" =>
141 "hg log " . 141 "hg log " .
142 "--template='HgCommit: {node}\\n" . 142 "--template='HgCommit: {node}\\n" .
143 "HgAuthor: {author}\\n" . 143 "HgAuthor: {author}\\n" .
144 "HgSubject: {desc|firstline}\\n'" . 144 "HgSubject: {desc|firstline}\\n'" .
145 " -r \$commit", 145 " -r \$commit",
146 "blame_range_cmd" => "", # not supported 146 "blame_range_cmd" => "", # not supported
147 "blame_file_cmd" => "hg blame -n \$file", 147 "blame_file_cmd" => "hg blame -n \$file",
148 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})", 148 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
149 "blame_commit_pattern" => "^([ 0-9a-f]+):", 149 "blame_commit_pattern" => "^([ 0-9a-f]+):",
150 "author_pattern" => "^HgAuthor: (.*)", 150 "author_pattern" => "^HgAuthor: (.*)",
151 "subject_pattern" => "^HgSubject: (.*)", 151 "subject_pattern" => "^HgSubject: (.*)",
152 ); 152 );
153 153
154 my $conf = which_conf(".get_maintainer.conf"); 154 my $conf = which_conf(".get_maintainer.conf");
155 if (-f $conf) { 155 if (-f $conf) {
156 my @conf_args; 156 my @conf_args;
157 open(my $conffile, '<', "$conf") 157 open(my $conffile, '<', "$conf")
158 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n"; 158 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
159 159
160 while (<$conffile>) { 160 while (<$conffile>) {
161 my $line = $_; 161 my $line = $_;
162 162
163 $line =~ s/\s*\n?$//g; 163 $line =~ s/\s*\n?$//g;
164 $line =~ s/^\s*//g; 164 $line =~ s/^\s*//g;
165 $line =~ s/\s+/ /g; 165 $line =~ s/\s+/ /g;
166 166
167 next if ($line =~ m/^\s*#/); 167 next if ($line =~ m/^\s*#/);
168 next if ($line =~ m/^\s*$/); 168 next if ($line =~ m/^\s*$/);
169 169
170 my @words = split(" ", $line); 170 my @words = split(" ", $line);
171 foreach my $word (@words) { 171 foreach my $word (@words) {
172 last if ($word =~ m/^#/); 172 last if ($word =~ m/^#/);
173 push (@conf_args, $word); 173 push (@conf_args, $word);
174 } 174 }
175 } 175 }
176 close($conffile); 176 close($conffile);
177 unshift(@ARGV, @conf_args) if @conf_args; 177 unshift(@ARGV, @conf_args) if @conf_args;
178 } 178 }
179 179
180 if (!GetOptions( 180 if (!GetOptions(
181 'email!' => \$email, 181 'email!' => \$email,
182 'git!' => \$email_git, 182 'git!' => \$email_git,
183 'git-all-signature-types!' => \$email_git_all_signature_types, 183 'git-all-signature-types!' => \$email_git_all_signature_types,
184 'git-blame!' => \$email_git_blame, 184 'git-blame!' => \$email_git_blame,
185 'git-blame-signatures!' => \$email_git_blame_signatures, 185 'git-blame-signatures!' => \$email_git_blame_signatures,
186 'git-fallback!' => \$email_git_fallback, 186 'git-fallback!' => \$email_git_fallback,
187 'git-chief-penguins!' => \$email_git_penguin_chiefs, 187 'git-chief-penguins!' => \$email_git_penguin_chiefs,
188 'git-min-signatures=i' => \$email_git_min_signatures, 188 'git-min-signatures=i' => \$email_git_min_signatures,
189 'git-max-maintainers=i' => \$email_git_max_maintainers, 189 'git-max-maintainers=i' => \$email_git_max_maintainers,
190 'git-min-percent=i' => \$email_git_min_percent, 190 'git-min-percent=i' => \$email_git_min_percent,
191 'git-since=s' => \$email_git_since, 191 'git-since=s' => \$email_git_since,
192 'hg-since=s' => \$email_hg_since, 192 'hg-since=s' => \$email_hg_since,
193 'i|interactive!' => \$interactive, 193 'i|interactive!' => \$interactive,
194 'remove-duplicates!' => \$email_remove_duplicates, 194 'remove-duplicates!' => \$email_remove_duplicates,
195 'm!' => \$email_maintainer, 195 'm!' => \$email_maintainer,
196 'n!' => \$email_usename, 196 'n!' => \$email_usename,
197 'l!' => \$email_list, 197 'l!' => \$email_list,
198 's!' => \$email_subscriber_list, 198 's!' => \$email_subscriber_list,
199 'multiline!' => \$output_multiline, 199 'multiline!' => \$output_multiline,
200 'roles!' => \$output_roles, 200 'roles!' => \$output_roles,
201 'rolestats!' => \$output_rolestats, 201 'rolestats!' => \$output_rolestats,
202 'separator=s' => \$output_separator, 202 'separator=s' => \$output_separator,
203 'subsystem!' => \$subsystem, 203 'subsystem!' => \$subsystem,
204 'status!' => \$status, 204 'status!' => \$status,
205 'scm!' => \$scm, 205 'scm!' => \$scm,
206 'web!' => \$web, 206 'web!' => \$web,
207 'pattern-depth=i' => \$pattern_depth, 207 'pattern-depth=i' => \$pattern_depth,
208 'k|keywords!' => \$keywords, 208 'k|keywords!' => \$keywords,
209 'sections!' => \$sections, 209 'sections!' => \$sections,
210 'fe|file-emails!' => \$file_emails, 210 'fe|file-emails!' => \$file_emails,
211 'f|file' => \$from_filename, 211 'f|file' => \$from_filename,
212 'v|version' => \$version, 212 'v|version' => \$version,
213 'h|help|usage' => \$help, 213 'h|help|usage' => \$help,
214 )) { 214 )) {
215 die "$P: invalid argument - use --help if necessary\n"; 215 die "$P: invalid argument - use --help if necessary\n";
216 } 216 }
217 217
218 if ($help != 0) { 218 if ($help != 0) {
219 usage(); 219 usage();
220 exit 0; 220 exit 0;
221 } 221 }
222 222
223 if ($version != 0) { 223 if ($version != 0) {
224 print("${P} ${V}\n"); 224 print("${P} ${V}\n");
225 exit 0; 225 exit 0;
226 } 226 }
227 227
228 if (-t STDIN && !@ARGV) { 228 if (-t STDIN && !@ARGV) {
229 # We're talking to a terminal, but have no command line arguments. 229 # We're talking to a terminal, but have no command line arguments.
230 die "$P: missing patchfile or -f file - use --help if necessary\n"; 230 die "$P: missing patchfile or -f file - use --help if necessary\n";
231 } 231 }
232 232
233 $output_multiline = 0 if ($output_separator ne ", "); 233 $output_multiline = 0 if ($output_separator ne ", ");
234 $output_rolestats = 1 if ($interactive); 234 $output_rolestats = 1 if ($interactive);
235 $output_roles = 1 if ($output_rolestats); 235 $output_roles = 1 if ($output_rolestats);
236 236
237 if ($sections) { 237 if ($sections) {
238 $email = 0; 238 $email = 0;
239 $email_list = 0; 239 $email_list = 0;
240 $scm = 0; 240 $scm = 0;
241 $status = 0; 241 $status = 0;
242 $subsystem = 0; 242 $subsystem = 0;
243 $web = 0; 243 $web = 0;
244 $keywords = 0; 244 $keywords = 0;
245 $interactive = 0; 245 $interactive = 0;
246 } else { 246 } else {
247 my $selections = $email + $scm + $status + $subsystem + $web; 247 my $selections = $email + $scm + $status + $subsystem + $web;
248 if ($selections == 0) { 248 if ($selections == 0) {
249 die "$P: Missing required option: email, scm, status, subsystem or web\n"; 249 die "$P: Missing required option: email, scm, status, subsystem or web\n";
250 } 250 }
251 } 251 }
252 252
253 if ($email && 253 if ($email &&
254 ($email_maintainer + $email_list + $email_subscriber_list + 254 ($email_maintainer + $email_list + $email_subscriber_list +
255 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) { 255 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
256 die "$P: Please select at least 1 email option\n"; 256 die "$P: Please select at least 1 email option\n";
257 } 257 }
258 258
259 if (!top_of_kernel_tree($lk_path)) { 259 if (!top_of_kernel_tree($lk_path)) {
260 die "$P: The current directory does not appear to be " 260 die "$P: The current directory does not appear to be "
261 . "a linux kernel source tree.\n"; 261 . "a linux kernel source tree.\n";
262 } 262 }
263 263
264 ## Read MAINTAINERS for type/value pairs 264 ## Read MAINTAINERS for type/value pairs
265 265
266 my @typevalue = (); 266 my @typevalue = ();
267 my %keyword_hash; 267 my %keyword_hash;
268 268
269 open (my $maint, '<', "${lk_path}MAINTAINERS") 269 open (my $maint, '<', "${lk_path}MAINTAINERS")
270 or die "$P: Can't open MAINTAINERS: $!\n"; 270 or die "$P: Can't open MAINTAINERS: $!\n";
271 while (<$maint>) { 271 while (<$maint>) {
272 my $line = $_; 272 my $line = $_;
273 273
274 if ($line =~ m/^(\C):\s*(.*)/) { 274 if ($line =~ m/^(\C):\s*(.*)/) {
275 my $type = $1; 275 my $type = $1;
276 my $value = $2; 276 my $value = $2;
277 277
278 ##Filename pattern matching 278 ##Filename pattern matching
279 if ($type eq "F" || $type eq "X") { 279 if ($type eq "F" || $type eq "X") {
280 $value =~ s@\.@\\\.@g; ##Convert . to \. 280 $value =~ s@\.@\\\.@g; ##Convert . to \.
281 $value =~ s/\*/\.\*/g; ##Convert * to .* 281 $value =~ s/\*/\.\*/g; ##Convert * to .*
282 $value =~ s/\?/\./g; ##Convert ? to . 282 $value =~ s/\?/\./g; ##Convert ? to .
283 ##if pattern is a directory and it lacks a trailing slash, add one 283 ##if pattern is a directory and it lacks a trailing slash, add one
284 if ((-d $value)) { 284 if ((-d $value)) {
285 $value =~ s@([^/])$@$1/@; 285 $value =~ s@([^/])$@$1/@;
286 } 286 }
287 } elsif ($type eq "K") { 287 } elsif ($type eq "K") {
288 $keyword_hash{@typevalue} = $value; 288 $keyword_hash{@typevalue} = $value;
289 } 289 }
290 push(@typevalue, "$type:$value"); 290 push(@typevalue, "$type:$value");
291 } elsif (!/^(\s)*$/) { 291 } elsif (!/^(\s)*$/) {
292 $line =~ s/\n$//g; 292 $line =~ s/\n$//g;
293 push(@typevalue, $line); 293 push(@typevalue, $line);
294 } 294 }
295 } 295 }
296 close($maint); 296 close($maint);
297 297
298 my %mailmap;
299 298
300 if ($email_remove_duplicates) { 299 #
301 open(my $mailmap, '<', "${lk_path}.mailmap") 300 # Read mail address map
301 #
302
303 my $mailmap = read_mailmap();
304
305 sub read_mailmap {
306 my $mailmap = {
307 names => {},
308 addresses => {}
309 };
310
311 if (!$email_remove_duplicates) {
312 return $mailmap;
313 }
314
315 open(my $mailmap_file, '<', "${lk_path}.mailmap")
302 or warn "$P: Can't open .mailmap: $!\n"; 316 or warn "$P: Can't open .mailmap: $!\n";
303 while (<$mailmap>) {
304 my $line = $_;
305 317
306 next if ($line =~ m/^\s*#/); 318 while (<$mailmap_file>) {
307 next if ($line =~ m/^\s*$/); 319 s/#.*$//; #strip comments
320 s/^\s+|\s+$//g; #trim
308 321
309 my ($name, $address) = parse_email($line); 322 next if (/^\s*$/); #skip empty lines
310 $line = format_email($name, $address, $email_usename); 323 #entries have one of the following formats:
324 # name1 <mail1>
325 # <mail1> <mail2>
326 # name1 <mail1> <mail2>
327 # name1 <mail1> name2 <mail2>
328 # (see man git-shortlog)
329 if (/^(.+)<(.+)>$/) {
330 my $real_name = $1;
331 my $address = $2;
311 332
312 next if ($line =~ m/^\s*$/); 333 $real_name =~ s/\s+$//;
334 $mailmap->{names}->{$address} = $real_name;
313 335
314 if (exists($mailmap{$name})) { 336 } elsif (/^<([^\s]+)>\s*<([^\s]+)>$/) {
315 my $obj = $mailmap{$name}; 337 my $real_address = $1;
316 push(@$obj, $address); 338 my $wrong_address = $2;
317 } else { 339
318 my @arr = ($address); 340 $mailmap->{addresses}->{$wrong_address} = $real_address;
319 $mailmap{$name} = \@arr; 341
342 } elsif (/^(.+)<([^\s]+)>\s*<([^\s]+)>$/) {
343 my $real_name= $1;
344 my $real_address = $2;
345 my $wrong_address = $3;
346
347 $real_name =~ s/\s+$//;
348
349 $mailmap->{names}->{$wrong_address} = $real_name;
350 $mailmap->{addresses}->{$wrong_address} = $real_address;
351
352 } elsif (/^(.+)<([^\s]+)>\s*([^\s].*)<([^\s]+)>$/) {
353 my $real_name = $1;
354 my $real_address = $2;
355 my $wrong_name = $3;
356 my $wrong_address = $4;
357
358 $real_name =~ s/\s+$//;
359 $wrong_name =~ s/\s+$//;
360
361 $mailmap->{names}->{format_email($wrong_name,$wrong_address,1)} = $real_name;
362 $mailmap->{addresses}->{format_email($wrong_name,$wrong_address,1)} = $real_address;
320 } 363 }
321 } 364 }
322 close($mailmap); 365 close($mailmap_file);
366
367 return $mailmap;
323 } 368 }
324 369
325 ## use the filenames on the command line or find the filenames in the patchfiles 370 ## use the filenames on the command line or find the filenames in the patchfiles
326 371
327 my @files = (); 372 my @files = ();
328 my @range = (); 373 my @range = ();
329 my @keyword_tvi = (); 374 my @keyword_tvi = ();
330 my @file_emails = (); 375 my @file_emails = ();
331 376
332 if (!@ARGV) { 377 if (!@ARGV) {
333 push(@ARGV, "&STDIN"); 378 push(@ARGV, "&STDIN");
334 } 379 }
335 380
336 foreach my $file (@ARGV) { 381 foreach my $file (@ARGV) {
337 if ($file ne "&STDIN") { 382 if ($file ne "&STDIN") {
338 ##if $file is a directory and it lacks a trailing slash, add one 383 ##if $file is a directory and it lacks a trailing slash, add one
339 if ((-d $file)) { 384 if ((-d $file)) {
340 $file =~ s@([^/])$@$1/@; 385 $file =~ s@([^/])$@$1/@;
341 } elsif (!(-f $file)) { 386 } elsif (!(-f $file)) {
342 die "$P: file '${file}' not found\n"; 387 die "$P: file '${file}' not found\n";
343 } 388 }
344 } 389 }
345 if ($from_filename) { 390 if ($from_filename) {
346 push(@files, $file); 391 push(@files, $file);
347 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) { 392 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
348 open(my $f, '<', $file) 393 open(my $f, '<', $file)
349 or die "$P: Can't open $file: $!\n"; 394 or die "$P: Can't open $file: $!\n";
350 my $text = do { local($/) ; <$f> }; 395 my $text = do { local($/) ; <$f> };
351 close($f); 396 close($f);
352 if ($keywords) { 397 if ($keywords) {
353 foreach my $line (keys %keyword_hash) { 398 foreach my $line (keys %keyword_hash) {
354 if ($text =~ m/$keyword_hash{$line}/x) { 399 if ($text =~ m/$keyword_hash{$line}/x) {
355 push(@keyword_tvi, $line); 400 push(@keyword_tvi, $line);
356 } 401 }
357 } 402 }
358 } 403 }
359 if ($file_emails) { 404 if ($file_emails) {
360 my @poss_addr = $text =~ m$[A-Za-zÀ-ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g; 405 my @poss_addr = $text =~ m$[A-Za-zÀ-ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
361 push(@file_emails, clean_file_emails(@poss_addr)); 406 push(@file_emails, clean_file_emails(@poss_addr));
362 } 407 }
363 } 408 }
364 } else { 409 } else {
365 my $file_cnt = @files; 410 my $file_cnt = @files;
366 my $lastfile; 411 my $lastfile;
367 412
368 open(my $patch, "< $file") 413 open(my $patch, "< $file")
369 or die "$P: Can't open $file: $!\n"; 414 or die "$P: Can't open $file: $!\n";
370 while (<$patch>) { 415 while (<$patch>) {
371 my $patch_line = $_; 416 my $patch_line = $_;
372 if (m/^\+\+\+\s+(\S+)/) { 417 if (m/^\+\+\+\s+(\S+)/) {
373 my $filename = $1; 418 my $filename = $1;
374 $filename =~ s@^[^/]*/@@; 419 $filename =~ s@^[^/]*/@@;
375 $filename =~ s@\n@@; 420 $filename =~ s@\n@@;
376 $lastfile = $filename; 421 $lastfile = $filename;
377 push(@files, $filename); 422 push(@files, $filename);
378 } elsif (m/^\@\@ -(\d+),(\d+)/) { 423 } elsif (m/^\@\@ -(\d+),(\d+)/) {
379 if ($email_git_blame) { 424 if ($email_git_blame) {
380 push(@range, "$lastfile:$1:$2"); 425 push(@range, "$lastfile:$1:$2");
381 } 426 }
382 } elsif ($keywords) { 427 } elsif ($keywords) {
383 foreach my $line (keys %keyword_hash) { 428 foreach my $line (keys %keyword_hash) {
384 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) { 429 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
385 push(@keyword_tvi, $line); 430 push(@keyword_tvi, $line);
386 } 431 }
387 } 432 }
388 } 433 }
389 } 434 }
390 close($patch); 435 close($patch);
391 436
392 if ($file_cnt == @files) { 437 if ($file_cnt == @files) {
393 warn "$P: file '${file}' doesn't appear to be a patch. " 438 warn "$P: file '${file}' doesn't appear to be a patch. "
394 . "Add -f to options?\n"; 439 . "Add -f to options?\n";
395 } 440 }
396 @files = sort_and_uniq(@files); 441 @files = sort_and_uniq(@files);
397 } 442 }
398 } 443 }
399 444
400 @file_emails = uniq(@file_emails); 445 @file_emails = uniq(@file_emails);
401 446
402 my %email_hash_name; 447 my %email_hash_name;
403 my %email_hash_address; 448 my %email_hash_address;
404 my @email_to = (); 449 my @email_to = ();
405 my %hash_list_to; 450 my %hash_list_to;
406 my @list_to = (); 451 my @list_to = ();
407 my @scm = (); 452 my @scm = ();
408 my @web = (); 453 my @web = ();
409 my @subsystem = (); 454 my @subsystem = ();
410 my @status = (); 455 my @status = ();
411 my @interactive_to = (); 456 my @interactive_to = ();
412 my $signature_pattern; 457 my $signature_pattern;
413 458
414 my @maintainers = get_maintainers(); 459 my @maintainers = get_maintainers();
415 460
416 if (@maintainers) { 461 if (@maintainers) {
417 @maintainers = merge_email(@maintainers); 462 @maintainers = merge_email(@maintainers);
418 output(@maintainers); 463 output(@maintainers);
419 } 464 }
420 465
421 if ($scm) { 466 if ($scm) {
422 @scm = uniq(@scm); 467 @scm = uniq(@scm);
423 output(@scm); 468 output(@scm);
424 } 469 }
425 470
426 if ($status) { 471 if ($status) {
427 @status = uniq(@status); 472 @status = uniq(@status);
428 output(@status); 473 output(@status);
429 } 474 }
430 475
431 if ($subsystem) { 476 if ($subsystem) {
432 @subsystem = uniq(@subsystem); 477 @subsystem = uniq(@subsystem);
433 output(@subsystem); 478 output(@subsystem);
434 } 479 }
435 480
436 if ($web) { 481 if ($web) {
437 @web = uniq(@web); 482 @web = uniq(@web);
438 output(@web); 483 output(@web);
439 } 484 }
440 485
441 exit($exit); 486 exit($exit);
442 487
443 sub get_maintainers { 488 sub get_maintainers {
444 %email_hash_name = (); 489 %email_hash_name = ();
445 %email_hash_address = (); 490 %email_hash_address = ();
446 %commit_author_hash = (); 491 %commit_author_hash = ();
447 %commit_signer_hash = (); 492 %commit_signer_hash = ();
448 @email_to = (); 493 @email_to = ();
449 %hash_list_to = (); 494 %hash_list_to = ();
450 @list_to = (); 495 @list_to = ();
451 @scm = (); 496 @scm = ();
452 @web = (); 497 @web = ();
453 @subsystem = (); 498 @subsystem = ();
454 @status = (); 499 @status = ();
455 @interactive_to = (); 500 @interactive_to = ();
456 if ($email_git_all_signature_types) { 501 if ($email_git_all_signature_types) {
457 $signature_pattern = "(.+?)[Bb][Yy]:"; 502 $signature_pattern = "(.+?)[Bb][Yy]:";
458 } else { 503 } else {
459 $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 504 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
460 } 505 }
461 506
462 # Find responsible parties 507 # Find responsible parties
463 508
464 my %exact_pattern_match_hash; 509 my %exact_pattern_match_hash;
465 510
466 foreach my $file (@files) { 511 foreach my $file (@files) {
467 512
468 my %hash; 513 my %hash;
469 my $tvi = find_first_section(); 514 my $tvi = find_first_section();
470 while ($tvi < @typevalue) { 515 while ($tvi < @typevalue) {
471 my $start = find_starting_index($tvi); 516 my $start = find_starting_index($tvi);
472 my $end = find_ending_index($tvi); 517 my $end = find_ending_index($tvi);
473 my $exclude = 0; 518 my $exclude = 0;
474 my $i; 519 my $i;
475 520
476 #Do not match excluded file patterns 521 #Do not match excluded file patterns
477 522
478 for ($i = $start; $i < $end; $i++) { 523 for ($i = $start; $i < $end; $i++) {
479 my $line = $typevalue[$i]; 524 my $line = $typevalue[$i];
480 if ($line =~ m/^(\C):\s*(.*)/) { 525 if ($line =~ m/^(\C):\s*(.*)/) {
481 my $type = $1; 526 my $type = $1;
482 my $value = $2; 527 my $value = $2;
483 if ($type eq 'X') { 528 if ($type eq 'X') {
484 if (file_match_pattern($file, $value)) { 529 if (file_match_pattern($file, $value)) {
485 $exclude = 1; 530 $exclude = 1;
486 last; 531 last;
487 } 532 }
488 } 533 }
489 } 534 }
490 } 535 }
491 536
492 if (!$exclude) { 537 if (!$exclude) {
493 for ($i = $start; $i < $end; $i++) { 538 for ($i = $start; $i < $end; $i++) {
494 my $line = $typevalue[$i]; 539 my $line = $typevalue[$i];
495 if ($line =~ m/^(\C):\s*(.*)/) { 540 if ($line =~ m/^(\C):\s*(.*)/) {
496 my $type = $1; 541 my $type = $1;
497 my $value = $2; 542 my $value = $2;
498 if ($type eq 'F') { 543 if ($type eq 'F') {
499 if (file_match_pattern($file, $value)) { 544 if (file_match_pattern($file, $value)) {
500 my $value_pd = ($value =~ tr@/@@); 545 my $value_pd = ($value =~ tr@/@@);
501 my $file_pd = ($file =~ tr@/@@); 546 my $file_pd = ($file =~ tr@/@@);
502 $value_pd++ if (substr($value,-1,1) ne "/"); 547 $value_pd++ if (substr($value,-1,1) ne "/");
503 $value_pd = -1 if ($value =~ /^\.\*/); 548 $value_pd = -1 if ($value =~ /^\.\*/);
504 if ($value_pd >= $file_pd) { 549 if ($value_pd >= $file_pd) {
505 $exact_pattern_match_hash{$file} = 1; 550 $exact_pattern_match_hash{$file} = 1;
506 } 551 }
507 if ($pattern_depth == 0 || 552 if ($pattern_depth == 0 ||
508 (($file_pd - $value_pd) < $pattern_depth)) { 553 (($file_pd - $value_pd) < $pattern_depth)) {
509 $hash{$tvi} = $value_pd; 554 $hash{$tvi} = $value_pd;
510 } 555 }
511 } 556 }
512 } 557 }
513 } 558 }
514 } 559 }
515 } 560 }
516 $tvi = $end + 1; 561 $tvi = $end + 1;
517 } 562 }
518 563
519 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 564 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
520 add_categories($line); 565 add_categories($line);
521 if ($sections) { 566 if ($sections) {
522 my $i; 567 my $i;
523 my $start = find_starting_index($line); 568 my $start = find_starting_index($line);
524 my $end = find_ending_index($line); 569 my $end = find_ending_index($line);
525 for ($i = $start; $i < $end; $i++) { 570 for ($i = $start; $i < $end; $i++) {
526 my $line = $typevalue[$i]; 571 my $line = $typevalue[$i];
527 if ($line =~ /^[FX]:/) { ##Restore file patterns 572 if ($line =~ /^[FX]:/) { ##Restore file patterns
528 $line =~ s/([^\\])\.([^\*])/$1\?$2/g; 573 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
529 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ? 574 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
530 $line =~ s/\\\./\./g; ##Convert \. to . 575 $line =~ s/\\\./\./g; ##Convert \. to .
531 $line =~ s/\.\*/\*/g; ##Convert .* to * 576 $line =~ s/\.\*/\*/g; ##Convert .* to *
532 } 577 }
533 $line =~ s/^([A-Z]):/$1:\t/g; 578 $line =~ s/^([A-Z]):/$1:\t/g;
534 print("$line\n"); 579 print("$line\n");
535 } 580 }
536 print("\n"); 581 print("\n");
537 } 582 }
538 } 583 }
539 } 584 }
540 585
541 if ($keywords) { 586 if ($keywords) {
542 @keyword_tvi = sort_and_uniq(@keyword_tvi); 587 @keyword_tvi = sort_and_uniq(@keyword_tvi);
543 foreach my $line (@keyword_tvi) { 588 foreach my $line (@keyword_tvi) {
544 add_categories($line); 589 add_categories($line);
545 } 590 }
546 } 591 }
547 592
548 @interactive_to = (@email_to, @list_to); 593 @interactive_to = (@email_to, @list_to);
549 594
550 foreach my $file (@files) { 595 foreach my $file (@files) {
551 if ($email && 596 if ($email &&
552 ($email_git || ($email_git_fallback && 597 ($email_git || ($email_git_fallback &&
553 !$exact_pattern_match_hash{$file}))) { 598 !$exact_pattern_match_hash{$file}))) {
554 vcs_file_signoffs($file); 599 vcs_file_signoffs($file);
555 } 600 }
556 if ($email && $email_git_blame) { 601 if ($email && $email_git_blame) {
557 vcs_file_blame($file); 602 vcs_file_blame($file);
558 } 603 }
559 } 604 }
560 605
561 if ($email) { 606 if ($email) {
562 foreach my $chief (@penguin_chief) { 607 foreach my $chief (@penguin_chief) {
563 if ($chief =~ m/^(.*):(.*)/) { 608 if ($chief =~ m/^(.*):(.*)/) {
564 my $email_address; 609 my $email_address;
565 610
566 $email_address = format_email($1, $2, $email_usename); 611 $email_address = format_email($1, $2, $email_usename);
567 if ($email_git_penguin_chiefs) { 612 if ($email_git_penguin_chiefs) {
568 push(@email_to, [$email_address, 'chief penguin']); 613 push(@email_to, [$email_address, 'chief penguin']);
569 } else { 614 } else {
570 @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 615 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
571 } 616 }
572 } 617 }
573 } 618 }
574 619
575 foreach my $email (@file_emails) { 620 foreach my $email (@file_emails) {
576 my ($name, $address) = parse_email($email); 621 my ($name, $address) = parse_email($email);
577 622
578 my $tmp_email = format_email($name, $address, $email_usename); 623 my $tmp_email = format_email($name, $address, $email_usename);
579 push_email_address($tmp_email, ''); 624 push_email_address($tmp_email, '');
580 add_role($tmp_email, 'in file'); 625 add_role($tmp_email, 'in file');
581 } 626 }
582 } 627 }
583 628
584 my @to = (); 629 my @to = ();
585 if ($email || $email_list) { 630 if ($email || $email_list) {
586 if ($email) { 631 if ($email) {
587 @to = (@to, @email_to); 632 @to = (@to, @email_to);
588 } 633 }
589 if ($email_list) { 634 if ($email_list) {
590 @to = (@to, @list_to); 635 @to = (@to, @list_to);
591 } 636 }
592 } 637 }
593 638
594 if ($interactive) { 639 if ($interactive) {
595 @interactive_to = @to; 640 @interactive_to = @to;
596 @to = interactive_get_maintainers(\@interactive_to); 641 @to = interactive_get_maintainers(\@interactive_to);
597 } 642 }
598 643
599 return @to; 644 return @to;
600 } 645 }
601 646
602 sub file_match_pattern { 647 sub file_match_pattern {
603 my ($file, $pattern) = @_; 648 my ($file, $pattern) = @_;
604 if (substr($pattern, -1) eq "/") { 649 if (substr($pattern, -1) eq "/") {
605 if ($file =~ m@^$pattern@) { 650 if ($file =~ m@^$pattern@) {
606 return 1; 651 return 1;
607 } 652 }
608 } else { 653 } else {
609 if ($file =~ m@^$pattern@) { 654 if ($file =~ m@^$pattern@) {
610 my $s1 = ($file =~ tr@/@@); 655 my $s1 = ($file =~ tr@/@@);
611 my $s2 = ($pattern =~ tr@/@@); 656 my $s2 = ($pattern =~ tr@/@@);
612 if ($s1 == $s2) { 657 if ($s1 == $s2) {
613 return 1; 658 return 1;
614 } 659 }
615 } 660 }
616 } 661 }
617 return 0; 662 return 0;
618 } 663 }
619 664
620 sub usage { 665 sub usage {
621 print <<EOT; 666 print <<EOT;
622 usage: $P [options] patchfile 667 usage: $P [options] patchfile
623 $P [options] -f file|directory 668 $P [options] -f file|directory
624 version: $V 669 version: $V
625 670
626 MAINTAINER field selection options: 671 MAINTAINER field selection options:
627 --email => print email address(es) if any 672 --email => print email address(es) if any
628 --git => include recent git \*-by: signers 673 --git => include recent git \*-by: signers
629 --git-all-signature-types => include signers regardless of signature type 674 --git-all-signature-types => include signers regardless of signature type
630 or use only ${signature_pattern} signers (default: $email_git_all_signature_types) 675 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
631 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback) 676 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
632 --git-chief-penguins => include ${penguin_chiefs} 677 --git-chief-penguins => include ${penguin_chiefs}
633 --git-min-signatures => number of signatures required (default: $email_git_min_signatures) 678 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
634 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers) 679 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
635 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent) 680 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
636 --git-blame => use git blame to find modified commits for patch or file 681 --git-blame => use git blame to find modified commits for patch or file
637 --git-since => git history to use (default: $email_git_since) 682 --git-since => git history to use (default: $email_git_since)
638 --hg-since => hg history to use (default: $email_hg_since) 683 --hg-since => hg history to use (default: $email_hg_since)
639 --interactive => display a menu (mostly useful if used with the --git option) 684 --interactive => display a menu (mostly useful if used with the --git option)
640 --m => include maintainer(s) if any 685 --m => include maintainer(s) if any
641 --n => include name 'Full Name <addr\@domain.tld>' 686 --n => include name 'Full Name <addr\@domain.tld>'
642 --l => include list(s) if any 687 --l => include list(s) if any
643 --s => include subscriber only list(s) if any 688 --s => include subscriber only list(s) if any
644 --remove-duplicates => minimize duplicate email names/addresses 689 --remove-duplicates => minimize duplicate email names/addresses
645 --roles => show roles (status:subsystem, git-signer, list, etc...) 690 --roles => show roles (status:subsystem, git-signer, list, etc...)
646 --rolestats => show roles and statistics (commits/total_commits, %) 691 --rolestats => show roles and statistics (commits/total_commits, %)
647 --file-emails => add email addresses found in -f file (default: 0 (off)) 692 --file-emails => add email addresses found in -f file (default: 0 (off))
648 --scm => print SCM tree(s) if any 693 --scm => print SCM tree(s) if any
649 --status => print status if any 694 --status => print status if any
650 --subsystem => print subsystem name if any 695 --subsystem => print subsystem name if any
651 --web => print website(s) if any 696 --web => print website(s) if any
652 697
653 Output type options: 698 Output type options:
654 --separator [, ] => separator for multiple entries on 1 line 699 --separator [, ] => separator for multiple entries on 1 line
655 using --separator also sets --nomultiline if --separator is not [, ] 700 using --separator also sets --nomultiline if --separator is not [, ]
656 --multiline => print 1 entry per line 701 --multiline => print 1 entry per line
657 702
658 Other options: 703 Other options:
659 --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 704 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
660 --keywords => scan patch for keywords (default: 1 (on)) 705 --keywords => scan patch for keywords (default: 1 (on))
661 --sections => print the entire subsystem sections with pattern matches 706 --sections => print the entire subsystem sections with pattern matches
662 --version => show version 707 --version => show version
663 --help => show this help information 708 --help => show this help information
664 709
665 Default options: 710 Default options:
666 [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates] 711 [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
667 712
668 Notes: 713 Notes:
669 Using "-f directory" may give unexpected results: 714 Using "-f directory" may give unexpected results:
670 Used with "--git", git signators for _all_ files in and below 715 Used with "--git", git signators for _all_ files in and below
671 directory are examined as git recurses directories. 716 directory are examined as git recurses directories.
672 Any specified X: (exclude) pattern matches are _not_ ignored. 717 Any specified X: (exclude) pattern matches are _not_ ignored.
673 Used with "--nogit", directory is used as a pattern match, 718 Used with "--nogit", directory is used as a pattern match,
674 no individual file within the directory or subdirectory 719 no individual file within the directory or subdirectory
675 is matched. 720 is matched.
676 Used with "--git-blame", does not iterate all files in directory 721 Used with "--git-blame", does not iterate all files in directory
677 Using "--git-blame" is slow and may add old committers and authors 722 Using "--git-blame" is slow and may add old committers and authors
678 that are no longer active maintainers to the output. 723 that are no longer active maintainers to the output.
679 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 724 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
680 other automated tools that expect only ["name"] <email address> 725 other automated tools that expect only ["name"] <email address>
681 may not work because of additional output after <email address>. 726 may not work because of additional output after <email address>.
682 Using "--rolestats" and "--git-blame" shows the #/total=% commits, 727 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
683 not the percentage of the entire file authored. # of commits is 728 not the percentage of the entire file authored. # of commits is
684 not a good measure of amount of code authored. 1 major commit may 729 not a good measure of amount of code authored. 1 major commit may
685 contain a thousand lines, 5 trivial commits may modify a single line. 730 contain a thousand lines, 5 trivial commits may modify a single line.
686 If git is not installed, but mercurial (hg) is installed and an .hg 731 If git is not installed, but mercurial (hg) is installed and an .hg
687 repository exists, the following options apply to mercurial: 732 repository exists, the following options apply to mercurial:
688 --git, 733 --git,
689 --git-min-signatures, --git-max-maintainers, --git-min-percent, and 734 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
690 --git-blame 735 --git-blame
691 Use --hg-since not --git-since to control date selection 736 Use --hg-since not --git-since to control date selection
692 File ".get_maintainer.conf", if it exists in the linux kernel source root 737 File ".get_maintainer.conf", if it exists in the linux kernel source root
693 directory, can change whatever get_maintainer defaults are desired. 738 directory, can change whatever get_maintainer defaults are desired.
694 Entries in this file can be any command line argument. 739 Entries in this file can be any command line argument.
695 This file is prepended to any additional command line arguments. 740 This file is prepended to any additional command line arguments.
696 Multiple lines and # comments are allowed. 741 Multiple lines and # comments are allowed.
697 EOT 742 EOT
698 } 743 }
699 744
700 sub top_of_kernel_tree { 745 sub top_of_kernel_tree {
701 my ($lk_path) = @_; 746 my ($lk_path) = @_;
702 747
703 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 748 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
704 $lk_path .= "/"; 749 $lk_path .= "/";
705 } 750 }
706 if ( (-f "${lk_path}COPYING") 751 if ( (-f "${lk_path}COPYING")
707 && (-f "${lk_path}CREDITS") 752 && (-f "${lk_path}CREDITS")
708 && (-f "${lk_path}Kbuild") 753 && (-f "${lk_path}Kbuild")
709 && (-f "${lk_path}MAINTAINERS") 754 && (-f "${lk_path}MAINTAINERS")
710 && (-f "${lk_path}Makefile") 755 && (-f "${lk_path}Makefile")
711 && (-f "${lk_path}README") 756 && (-f "${lk_path}README")
712 && (-d "${lk_path}Documentation") 757 && (-d "${lk_path}Documentation")
713 && (-d "${lk_path}arch") 758 && (-d "${lk_path}arch")
714 && (-d "${lk_path}include") 759 && (-d "${lk_path}include")
715 && (-d "${lk_path}drivers") 760 && (-d "${lk_path}drivers")
716 && (-d "${lk_path}fs") 761 && (-d "${lk_path}fs")
717 && (-d "${lk_path}init") 762 && (-d "${lk_path}init")
718 && (-d "${lk_path}ipc") 763 && (-d "${lk_path}ipc")
719 && (-d "${lk_path}kernel") 764 && (-d "${lk_path}kernel")
720 && (-d "${lk_path}lib") 765 && (-d "${lk_path}lib")
721 && (-d "${lk_path}scripts")) { 766 && (-d "${lk_path}scripts")) {
722 return 1; 767 return 1;
723 } 768 }
724 return 0; 769 return 0;
725 } 770 }
726 771
727 sub parse_email { 772 sub parse_email {
728 my ($formatted_email) = @_; 773 my ($formatted_email) = @_;
729 774
730 my $name = ""; 775 my $name = "";
731 my $address = ""; 776 my $address = "";
732 777
733 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 778 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
734 $name = $1; 779 $name = $1;
735 $address = $2; 780 $address = $2;
736 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 781 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
737 $address = $1; 782 $address = $1;
738 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 783 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
739 $address = $1; 784 $address = $1;
740 } 785 }
741 786
742 $name =~ s/^\s+|\s+$//g; 787 $name =~ s/^\s+|\s+$//g;
743 $name =~ s/^\"|\"$//g; 788 $name =~ s/^\"|\"$//g;
744 $address =~ s/^\s+|\s+$//g; 789 $address =~ s/^\s+|\s+$//g;
745 790
746 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 791 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
747 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 792 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
748 $name = "\"$name\""; 793 $name = "\"$name\"";
749 } 794 }
750 795
751 return ($name, $address); 796 return ($name, $address);
752 } 797 }
753 798
754 sub format_email { 799 sub format_email {
755 my ($name, $address, $usename) = @_; 800 my ($name, $address, $usename) = @_;
756 801
757 my $formatted_email; 802 my $formatted_email;
758 803
759 $name =~ s/^\s+|\s+$//g; 804 $name =~ s/^\s+|\s+$//g;
760 $name =~ s/^\"|\"$//g; 805 $name =~ s/^\"|\"$//g;
761 $address =~ s/^\s+|\s+$//g; 806 $address =~ s/^\s+|\s+$//g;
762 807
763 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 808 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
764 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 809 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
765 $name = "\"$name\""; 810 $name = "\"$name\"";
766 } 811 }
767 812
768 if ($usename) { 813 if ($usename) {
769 if ("$name" eq "") { 814 if ("$name" eq "") {
770 $formatted_email = "$address"; 815 $formatted_email = "$address";
771 } else { 816 } else {
772 $formatted_email = "$name <$address>"; 817 $formatted_email = "$name <$address>";
773 } 818 }
774 } else { 819 } else {
775 $formatted_email = $address; 820 $formatted_email = $address;
776 } 821 }
777 822
778 return $formatted_email; 823 return $formatted_email;
779 } 824 }
780 825
781 sub find_first_section { 826 sub find_first_section {
782 my $index = 0; 827 my $index = 0;
783 828
784 while ($index < @typevalue) { 829 while ($index < @typevalue) {
785 my $tv = $typevalue[$index]; 830 my $tv = $typevalue[$index];
786 if (($tv =~ m/^(\C):\s*(.*)/)) { 831 if (($tv =~ m/^(\C):\s*(.*)/)) {
787 last; 832 last;
788 } 833 }
789 $index++; 834 $index++;
790 } 835 }
791 836
792 return $index; 837 return $index;
793 } 838 }
794 839
795 sub find_starting_index { 840 sub find_starting_index {
796 my ($index) = @_; 841 my ($index) = @_;
797 842
798 while ($index > 0) { 843 while ($index > 0) {
799 my $tv = $typevalue[$index]; 844 my $tv = $typevalue[$index];
800 if (!($tv =~ m/^(\C):\s*(.*)/)) { 845 if (!($tv =~ m/^(\C):\s*(.*)/)) {
801 last; 846 last;
802 } 847 }
803 $index--; 848 $index--;
804 } 849 }
805 850
806 return $index; 851 return $index;
807 } 852 }
808 853
809 sub find_ending_index { 854 sub find_ending_index {
810 my ($index) = @_; 855 my ($index) = @_;
811 856
812 while ($index < @typevalue) { 857 while ($index < @typevalue) {
813 my $tv = $typevalue[$index]; 858 my $tv = $typevalue[$index];
814 if (!($tv =~ m/^(\C):\s*(.*)/)) { 859 if (!($tv =~ m/^(\C):\s*(.*)/)) {
815 last; 860 last;
816 } 861 }
817 $index++; 862 $index++;
818 } 863 }
819 864
820 return $index; 865 return $index;
821 } 866 }
822 867
823 sub get_maintainer_role { 868 sub get_maintainer_role {
824 my ($index) = @_; 869 my ($index) = @_;
825 870
826 my $i; 871 my $i;
827 my $start = find_starting_index($index); 872 my $start = find_starting_index($index);
828 my $end = find_ending_index($index); 873 my $end = find_ending_index($index);
829 874
830 my $role; 875 my $role;
831 my $subsystem = $typevalue[$start]; 876 my $subsystem = $typevalue[$start];
832 if (length($subsystem) > 20) { 877 if (length($subsystem) > 20) {
833 $subsystem = substr($subsystem, 0, 17); 878 $subsystem = substr($subsystem, 0, 17);
834 $subsystem =~ s/\s*$//; 879 $subsystem =~ s/\s*$//;
835 $subsystem = $subsystem . "..."; 880 $subsystem = $subsystem . "...";
836 } 881 }
837 882
838 for ($i = $start + 1; $i < $end; $i++) { 883 for ($i = $start + 1; $i < $end; $i++) {
839 my $tv = $typevalue[$i]; 884 my $tv = $typevalue[$i];
840 if ($tv =~ m/^(\C):\s*(.*)/) { 885 if ($tv =~ m/^(\C):\s*(.*)/) {
841 my $ptype = $1; 886 my $ptype = $1;
842 my $pvalue = $2; 887 my $pvalue = $2;
843 if ($ptype eq "S") { 888 if ($ptype eq "S") {
844 $role = $pvalue; 889 $role = $pvalue;
845 } 890 }
846 } 891 }
847 } 892 }
848 893
849 $role = lc($role); 894 $role = lc($role);
850 if ($role eq "supported") { 895 if ($role eq "supported") {
851 $role = "supporter"; 896 $role = "supporter";
852 } elsif ($role eq "maintained") { 897 } elsif ($role eq "maintained") {
853 $role = "maintainer"; 898 $role = "maintainer";
854 } elsif ($role eq "odd fixes") { 899 } elsif ($role eq "odd fixes") {
855 $role = "odd fixer"; 900 $role = "odd fixer";
856 } elsif ($role eq "orphan") { 901 } elsif ($role eq "orphan") {
857 $role = "orphan minder"; 902 $role = "orphan minder";
858 } elsif ($role eq "obsolete") { 903 } elsif ($role eq "obsolete") {
859 $role = "obsolete minder"; 904 $role = "obsolete minder";
860 } elsif ($role eq "buried alive in reporters") { 905 } elsif ($role eq "buried alive in reporters") {
861 $role = "chief penguin"; 906 $role = "chief penguin";
862 } 907 }
863 908
864 return $role . ":" . $subsystem; 909 return $role . ":" . $subsystem;
865 } 910 }
866 911
867 sub get_list_role { 912 sub get_list_role {
868 my ($index) = @_; 913 my ($index) = @_;
869 914
870 my $i; 915 my $i;
871 my $start = find_starting_index($index); 916 my $start = find_starting_index($index);
872 my $end = find_ending_index($index); 917 my $end = find_ending_index($index);
873 918
874 my $subsystem = $typevalue[$start]; 919 my $subsystem = $typevalue[$start];
875 if (length($subsystem) > 20) { 920 if (length($subsystem) > 20) {
876 $subsystem = substr($subsystem, 0, 17); 921 $subsystem = substr($subsystem, 0, 17);
877 $subsystem =~ s/\s*$//; 922 $subsystem =~ s/\s*$//;
878 $subsystem = $subsystem . "..."; 923 $subsystem = $subsystem . "...";
879 } 924 }
880 925
881 if ($subsystem eq "THE REST") { 926 if ($subsystem eq "THE REST") {
882 $subsystem = ""; 927 $subsystem = "";
883 } 928 }
884 929
885 return $subsystem; 930 return $subsystem;
886 } 931 }
887 932
888 sub add_categories { 933 sub add_categories {
889 my ($index) = @_; 934 my ($index) = @_;
890 935
891 my $i; 936 my $i;
892 my $start = find_starting_index($index); 937 my $start = find_starting_index($index);
893 my $end = find_ending_index($index); 938 my $end = find_ending_index($index);
894 939
895 push(@subsystem, $typevalue[$start]); 940 push(@subsystem, $typevalue[$start]);
896 941
897 for ($i = $start + 1; $i < $end; $i++) { 942 for ($i = $start + 1; $i < $end; $i++) {
898 my $tv = $typevalue[$i]; 943 my $tv = $typevalue[$i];
899 if ($tv =~ m/^(\C):\s*(.*)/) { 944 if ($tv =~ m/^(\C):\s*(.*)/) {
900 my $ptype = $1; 945 my $ptype = $1;
901 my $pvalue = $2; 946 my $pvalue = $2;
902 if ($ptype eq "L") { 947 if ($ptype eq "L") {
903 my $list_address = $pvalue; 948 my $list_address = $pvalue;
904 my $list_additional = ""; 949 my $list_additional = "";
905 my $list_role = get_list_role($i); 950 my $list_role = get_list_role($i);
906 951
907 if ($list_role ne "") { 952 if ($list_role ne "") {
908 $list_role = ":" . $list_role; 953 $list_role = ":" . $list_role;
909 } 954 }
910 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 955 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
911 $list_address = $1; 956 $list_address = $1;
912 $list_additional = $2; 957 $list_additional = $2;
913 } 958 }
914 if ($list_additional =~ m/subscribers-only/) { 959 if ($list_additional =~ m/subscribers-only/) {
915 if ($email_subscriber_list) { 960 if ($email_subscriber_list) {
916 if (!$hash_list_to{lc($list_address)}) { 961 if (!$hash_list_to{lc($list_address)}) {
917 $hash_list_to{lc($list_address)} = 1; 962 $hash_list_to{lc($list_address)} = 1;
918 push(@list_to, [$list_address, 963 push(@list_to, [$list_address,
919 "subscriber list${list_role}"]); 964 "subscriber list${list_role}"]);
920 } 965 }
921 } 966 }
922 } else { 967 } else {
923 if ($email_list) { 968 if ($email_list) {
924 if (!$hash_list_to{lc($list_address)}) { 969 if (!$hash_list_to{lc($list_address)}) {
925 $hash_list_to{lc($list_address)} = 1; 970 $hash_list_to{lc($list_address)} = 1;
926 push(@list_to, [$list_address, 971 push(@list_to, [$list_address,
927 "open list${list_role}"]); 972 "open list${list_role}"]);
928 } 973 }
929 } 974 }
930 } 975 }
931 } elsif ($ptype eq "M") { 976 } elsif ($ptype eq "M") {
932 my ($name, $address) = parse_email($pvalue); 977 my ($name, $address) = parse_email($pvalue);
933 if ($name eq "") { 978 if ($name eq "") {
934 if ($i > 0) { 979 if ($i > 0) {
935 my $tv = $typevalue[$i - 1]; 980 my $tv = $typevalue[$i - 1];
936 if ($tv =~ m/^(\C):\s*(.*)/) { 981 if ($tv =~ m/^(\C):\s*(.*)/) {
937 if ($1 eq "P") { 982 if ($1 eq "P") {
938 $name = $2; 983 $name = $2;
939 $pvalue = format_email($name, $address, $email_usename); 984 $pvalue = format_email($name, $address, $email_usename);
940 } 985 }
941 } 986 }
942 } 987 }
943 } 988 }
944 if ($email_maintainer) { 989 if ($email_maintainer) {
945 my $role = get_maintainer_role($i); 990 my $role = get_maintainer_role($i);
946 push_email_addresses($pvalue, $role); 991 push_email_addresses($pvalue, $role);
947 } 992 }
948 } elsif ($ptype eq "T") { 993 } elsif ($ptype eq "T") {
949 push(@scm, $pvalue); 994 push(@scm, $pvalue);
950 } elsif ($ptype eq "W") { 995 } elsif ($ptype eq "W") {
951 push(@web, $pvalue); 996 push(@web, $pvalue);
952 } elsif ($ptype eq "S") { 997 } elsif ($ptype eq "S") {
953 push(@status, $pvalue); 998 push(@status, $pvalue);
954 } 999 }
955 } 1000 }
956 } 1001 }
957 } 1002 }
958 1003
959 sub email_inuse { 1004 sub email_inuse {
960 my ($name, $address) = @_; 1005 my ($name, $address) = @_;
961 1006
962 return 1 if (($name eq "") && ($address eq "")); 1007 return 1 if (($name eq "") && ($address eq ""));
963 return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 1008 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
964 return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 1009 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
965 1010
966 return 0; 1011 return 0;
967 } 1012 }
968 1013
969 sub push_email_address { 1014 sub push_email_address {
970 my ($line, $role) = @_; 1015 my ($line, $role) = @_;
971 1016
972 my ($name, $address) = parse_email($line); 1017 my ($name, $address) = parse_email($line);
973 1018
974 if ($address eq "") { 1019 if ($address eq "") {
975 return 0; 1020 return 0;
976 } 1021 }
977 1022
978 if (!$email_remove_duplicates) { 1023 if (!$email_remove_duplicates) {
979 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1024 push(@email_to, [format_email($name, $address, $email_usename), $role]);
980 } elsif (!email_inuse($name, $address)) { 1025 } elsif (!email_inuse($name, $address)) {
981 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1026 push(@email_to, [format_email($name, $address, $email_usename), $role]);
982 $email_hash_name{lc($name)}++; 1027 $email_hash_name{lc($name)}++;
983 $email_hash_address{lc($address)}++; 1028 $email_hash_address{lc($address)}++;
984 } 1029 }
985 1030
986 return 1; 1031 return 1;
987 } 1032 }
988 1033
989 sub push_email_addresses { 1034 sub push_email_addresses {
990 my ($address, $role) = @_; 1035 my ($address, $role) = @_;
991 1036
992 my @address_list = (); 1037 my @address_list = ();
993 1038
994 if (rfc822_valid($address)) { 1039 if (rfc822_valid($address)) {
995 push_email_address($address, $role); 1040 push_email_address($address, $role);
996 } elsif (@address_list = rfc822_validlist($address)) { 1041 } elsif (@address_list = rfc822_validlist($address)) {
997 my $array_count = shift(@address_list); 1042 my $array_count = shift(@address_list);
998 while (my $entry = shift(@address_list)) { 1043 while (my $entry = shift(@address_list)) {
999 push_email_address($entry, $role); 1044 push_email_address($entry, $role);
1000 } 1045 }
1001 } else { 1046 } else {
1002 if (!push_email_address($address, $role)) { 1047 if (!push_email_address($address, $role)) {
1003 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 1048 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1004 } 1049 }
1005 } 1050 }
1006 } 1051 }
1007 1052
1008 sub add_role { 1053 sub add_role {
1009 my ($line, $role) = @_; 1054 my ($line, $role) = @_;
1010 1055
1011 my ($name, $address) = parse_email($line); 1056 my ($name, $address) = parse_email($line);
1012 my $email = format_email($name, $address, $email_usename); 1057 my $email = format_email($name, $address, $email_usename);
1013 1058
1014 foreach my $entry (@email_to) { 1059 foreach my $entry (@email_to) {
1015 if ($email_remove_duplicates) { 1060 if ($email_remove_duplicates) {
1016 my ($entry_name, $entry_address) = parse_email($entry->[0]); 1061 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1017 if (($name eq $entry_name || $address eq $entry_address) 1062 if (($name eq $entry_name || $address eq $entry_address)
1018 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1063 && ($role eq "" || !($entry->[1] =~ m/$role/))
1019 ) { 1064 ) {
1020 if ($entry->[1] eq "") { 1065 if ($entry->[1] eq "") {
1021 $entry->[1] = "$role"; 1066 $entry->[1] = "$role";
1022 } else { 1067 } else {
1023 $entry->[1] = "$entry->[1],$role"; 1068 $entry->[1] = "$entry->[1],$role";
1024 } 1069 }
1025 } 1070 }
1026 } else { 1071 } else {
1027 if ($email eq $entry->[0] 1072 if ($email eq $entry->[0]
1028 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1073 && ($role eq "" || !($entry->[1] =~ m/$role/))
1029 ) { 1074 ) {
1030 if ($entry->[1] eq "") { 1075 if ($entry->[1] eq "") {
1031 $entry->[1] = "$role"; 1076 $entry->[1] = "$role";
1032 } else { 1077 } else {
1033 $entry->[1] = "$entry->[1],$role"; 1078 $entry->[1] = "$entry->[1],$role";
1034 } 1079 }
1035 } 1080 }
1036 } 1081 }
1037 } 1082 }
1038 } 1083 }
1039 1084
1040 sub which { 1085 sub which {
1041 my ($bin) = @_; 1086 my ($bin) = @_;
1042 1087
1043 foreach my $path (split(/:/, $ENV{PATH})) { 1088 foreach my $path (split(/:/, $ENV{PATH})) {
1044 if (-e "$path/$bin") { 1089 if (-e "$path/$bin") {
1045 return "$path/$bin"; 1090 return "$path/$bin";
1046 } 1091 }
1047 } 1092 }
1048 1093
1049 return ""; 1094 return "";
1050 } 1095 }
1051 1096
1052 sub which_conf { 1097 sub which_conf {
1053 my ($conf) = @_; 1098 my ($conf) = @_;
1054 1099
1055 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1100 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1056 if (-e "$path/$conf") { 1101 if (-e "$path/$conf") {
1057 return "$path/$conf"; 1102 return "$path/$conf";
1058 } 1103 }
1059 } 1104 }
1060 1105
1061 return ""; 1106 return "";
1062 } 1107 }
1063 1108
1064 sub mailmap { 1109 sub mailmap_email {
1065 my (@lines) = @_; 1110 my $line = shift;
1066 my %hash;
1067 1111
1068 foreach my $line (@lines) {
1069 my ($name, $address) = parse_email($line); 1112 my ($name, $address) = parse_email($line);
1070 if (!exists($hash{$name})) { 1113 my $email = format_email($name, $address, 1);
1071 $hash{$name} = $address; 1114 my $real_name = $name;
1072 } elsif ($address ne $hash{$name}) { 1115 my $real_address = $address;
1073 $address = $hash{$name}; 1116
1074 $line = format_email($name, $address, $email_usename); 1117 if (exists $mailmap->{names}->{$email} || exists $mailmap->{addresses}->{$email}) {
1075 } 1118 if (exists $mailmap->{names}->{$email}) {
1076 if (exists($mailmap{$name})) { 1119 $real_name = $mailmap->{names}->{$email};
1077 my $obj = $mailmap{$name};
1078 foreach my $map_address (@$obj) {
1079 if (($map_address eq $address) &&
1080 ($map_address ne $hash{$name})) {
1081 $line = format_email($name, $hash{$name}, $email_usename);
1082 } 1120 }
1083 } 1121 if (exists $mailmap->{addresses}->{$email}) {
1122 $real_address = $mailmap->{addresses}->{$email};
1123 }
1124 } else {
1125 if (exists $mailmap->{names}->{$address}) {
1126 $real_name = $mailmap->{names}->{$address};
1127 }
1128 if (exists $mailmap->{addresses}->{$address}) {
1129 $real_address = $mailmap->{addresses}->{$address};
1130 }
1084 } 1131 }
1132 return format_email($real_name, $real_address, 1);
1133 }
1134
1135 sub mailmap {
1136 my (@addresses) = @_;
1137
1138 my @ret = ();
1139 foreach my $line (@addresses) {
1140 push(@ret, mailmap_email($line), 1);
1085 } 1141 }
1086 1142
1087 return @lines; 1143 merge_by_realname(@ret) if $email_remove_duplicates;
1144
1145 return @ret;
1088 } 1146 }
1089 1147
1148 sub merge_by_realname {
1149 my %address_map;
1150 my (@emails) = @_;
1151 foreach my $email (@emails) {
1152 my ($name, $address) = parse_email($email);
1153 if (!exists $address_map{$name}) {
1154 $address_map{$name} = $address;
1155 } else {
1156 $address = $address_map{$name};
1157 $email = format_email($name,$address,1);
1158 }
1159 }
1160
1161 }
1162
1090 sub git_execute_cmd { 1163 sub git_execute_cmd {
1091 my ($cmd) = @_; 1164 my ($cmd) = @_;
1092 my @lines = (); 1165 my @lines = ();
1093 1166
1094 my $output = `$cmd`; 1167 my $output = `$cmd`;
1095 $output =~ s/^\s*//gm; 1168 $output =~ s/^\s*//gm;
1096 @lines = split("\n", $output); 1169 @lines = split("\n", $output);
1097 1170
1098 return @lines; 1171 return @lines;
1099 } 1172 }
1100 1173
1101 sub hg_execute_cmd { 1174 sub hg_execute_cmd {
1102 my ($cmd) = @_; 1175 my ($cmd) = @_;
1103 my @lines = (); 1176 my @lines = ();
1104 1177
1105 my $output = `$cmd`; 1178 my $output = `$cmd`;
1106 @lines = split("\n", $output); 1179 @lines = split("\n", $output);
1107 1180
1108 return @lines; 1181 return @lines;
1109 } 1182 }
1110 1183
1111 sub extract_formatted_signatures { 1184 sub extract_formatted_signatures {
1112 my (@signature_lines) = @_; 1185 my (@signature_lines) = @_;
1113 1186
1114 my @type = @signature_lines; 1187 my @type = @signature_lines;
1115 1188
1116 s/\s*(.*):.*/$1/ for (@type); 1189 s/\s*(.*):.*/$1/ for (@type);
1117 1190
1118 # cut -f2- -d":" 1191 # cut -f2- -d":"
1119 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1192 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1120 1193
1121 ## Reformat email addresses (with names) to avoid badly written signatures 1194 ## Reformat email addresses (with names) to avoid badly written signatures
1122 1195
1123 foreach my $signer (@signature_lines) { 1196 foreach my $signer (@signature_lines) {
1124 my ($name, $address) = parse_email($signer); 1197 my ($name, $address) = parse_email($signer);
1125 $signer = format_email($name, $address, 1); 1198 $signer = format_email($name, $address, 1);
1126 } 1199 }
1127 1200
1128 return (\@type, \@signature_lines); 1201 return (\@type, \@signature_lines);
1129 } 1202 }
1130 1203
1131 sub vcs_find_signers { 1204 sub vcs_find_signers {
1132 my ($cmd) = @_; 1205 my ($cmd) = @_;
1133 my $commits; 1206 my $commits;
1134 my @lines = (); 1207 my @lines = ();
1135 my @signatures = (); 1208 my @signatures = ();
1136 1209
1137 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1210 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1138 1211
1139 my $pattern = $VCS_cmds{"commit_pattern"}; 1212 my $pattern = $VCS_cmds{"commit_pattern"};
1140 1213
1141 $commits = grep(/$pattern/, @lines); # of commits 1214 $commits = grep(/$pattern/, @lines); # of commits
1142 1215
1143 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1216 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1144 1217
1145 return (0, @signatures) if !@signatures; 1218 return (0, @signatures) if !@signatures;
1146 1219
1147 save_commits_by_author(@lines) if ($interactive); 1220 save_commits_by_author(@lines) if ($interactive);
1148 save_commits_by_signer(@lines) if ($interactive); 1221 save_commits_by_signer(@lines) if ($interactive);
1149 1222
1150 if (!$email_git_penguin_chiefs) { 1223 if (!$email_git_penguin_chiefs) {
1151 @signatures = grep(!/${penguin_chiefs}/i, @signatures); 1224 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1152 } 1225 }
1153 1226
1154 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1227 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1155 1228
1156 return ($commits, @$signers_ref); 1229 return ($commits, @$signers_ref);
1157 } 1230 }
1158 1231
1159 sub vcs_find_author { 1232 sub vcs_find_author {
1160 my ($cmd) = @_; 1233 my ($cmd) = @_;
1161 my @lines = (); 1234 my @lines = ();
1162 1235
1163 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1236 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1164 1237
1165 if (!$email_git_penguin_chiefs) { 1238 if (!$email_git_penguin_chiefs) {
1166 @lines = grep(!/${penguin_chiefs}/i, @lines); 1239 @lines = grep(!/${penguin_chiefs}/i, @lines);
1167 } 1240 }
1168 1241
1169 return @lines if !@lines; 1242 return @lines if !@lines;
1170 1243
1171 my @authors = (); 1244 my @authors = ();
1172 foreach my $line (@lines) { 1245 foreach my $line (@lines) {
1173 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1246 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1174 my $author = $1; 1247 my $author = $1;
1175 my ($name, $address) = parse_email($author); 1248 my ($name, $address) = parse_email($author);
1176 $author = format_email($name, $address, 1); 1249 $author = format_email($name, $address, 1);
1177 push(@authors, $author); 1250 push(@authors, $author);
1178 } 1251 }
1179 } 1252 }
1180 1253
1181 save_commits_by_author(@lines) if ($interactive); 1254 save_commits_by_author(@lines) if ($interactive);
1182 save_commits_by_signer(@lines) if ($interactive); 1255 save_commits_by_signer(@lines) if ($interactive);
1183 1256
1184 return @authors; 1257 return @authors;
1185 } 1258 }
1186 1259
1187 sub vcs_save_commits { 1260 sub vcs_save_commits {
1188 my ($cmd) = @_; 1261 my ($cmd) = @_;
1189 my @lines = (); 1262 my @lines = ();
1190 my @commits = (); 1263 my @commits = ();
1191 1264
1192 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1265 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1193 1266
1194 foreach my $line (@lines) { 1267 foreach my $line (@lines) {
1195 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 1268 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1196 push(@commits, $1); 1269 push(@commits, $1);
1197 } 1270 }
1198 } 1271 }
1199 1272
1200 return @commits; 1273 return @commits;
1201 } 1274 }
1202 1275
1203 sub vcs_blame { 1276 sub vcs_blame {
1204 my ($file) = @_; 1277 my ($file) = @_;
1205 my $cmd; 1278 my $cmd;
1206 my @commits = (); 1279 my @commits = ();
1207 1280
1208 return @commits if (!(-f $file)); 1281 return @commits if (!(-f $file));
1209 1282
1210 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1283 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1211 my @all_commits = (); 1284 my @all_commits = ();
1212 1285
1213 $cmd = $VCS_cmds{"blame_file_cmd"}; 1286 $cmd = $VCS_cmds{"blame_file_cmd"};
1214 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1287 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1215 @all_commits = vcs_save_commits($cmd); 1288 @all_commits = vcs_save_commits($cmd);
1216 1289
1217 foreach my $file_range_diff (@range) { 1290 foreach my $file_range_diff (@range) {
1218 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1291 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1219 my $diff_file = $1; 1292 my $diff_file = $1;
1220 my $diff_start = $2; 1293 my $diff_start = $2;
1221 my $diff_length = $3; 1294 my $diff_length = $3;
1222 next if ("$file" ne "$diff_file"); 1295 next if ("$file" ne "$diff_file");
1223 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1296 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1224 push(@commits, $all_commits[$i]); 1297 push(@commits, $all_commits[$i]);
1225 } 1298 }
1226 } 1299 }
1227 } elsif (@range) { 1300 } elsif (@range) {
1228 foreach my $file_range_diff (@range) { 1301 foreach my $file_range_diff (@range) {
1229 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1302 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1230 my $diff_file = $1; 1303 my $diff_file = $1;
1231 my $diff_start = $2; 1304 my $diff_start = $2;
1232 my $diff_length = $3; 1305 my $diff_length = $3;
1233 next if ("$file" ne "$diff_file"); 1306 next if ("$file" ne "$diff_file");
1234 $cmd = $VCS_cmds{"blame_range_cmd"}; 1307 $cmd = $VCS_cmds{"blame_range_cmd"};
1235 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1308 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1236 push(@commits, vcs_save_commits($cmd)); 1309 push(@commits, vcs_save_commits($cmd));
1237 } 1310 }
1238 } else { 1311 } else {
1239 $cmd = $VCS_cmds{"blame_file_cmd"}; 1312 $cmd = $VCS_cmds{"blame_file_cmd"};
1240 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1313 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1241 @commits = vcs_save_commits($cmd); 1314 @commits = vcs_save_commits($cmd);
1242 } 1315 }
1243 1316
1244 foreach my $commit (@commits) { 1317 foreach my $commit (@commits) {
1245 $commit =~ s/^\^//g; 1318 $commit =~ s/^\^//g;
1246 } 1319 }
1247 1320
1248 return @commits; 1321 return @commits;
1249 } 1322 }
1250 1323
1251 my $printed_novcs = 0; 1324 my $printed_novcs = 0;
1252 sub vcs_exists { 1325 sub vcs_exists {
1253 %VCS_cmds = %VCS_cmds_git; 1326 %VCS_cmds = %VCS_cmds_git;
1254 return 1 if eval $VCS_cmds{"available"}; 1327 return 1 if eval $VCS_cmds{"available"};
1255 %VCS_cmds = %VCS_cmds_hg; 1328 %VCS_cmds = %VCS_cmds_hg;
1256 return 2 if eval $VCS_cmds{"available"}; 1329 return 2 if eval $VCS_cmds{"available"};
1257 %VCS_cmds = (); 1330 %VCS_cmds = ();
1258 if (!$printed_novcs) { 1331 if (!$printed_novcs) {
1259 warn("$P: No supported VCS found. Add --nogit to options?\n"); 1332 warn("$P: No supported VCS found. Add --nogit to options?\n");
1260 warn("Using a git repository produces better results.\n"); 1333 warn("Using a git repository produces better results.\n");
1261 warn("Try Linus Torvalds' latest git repository using:\n"); 1334 warn("Try Linus Torvalds' latest git repository using:\n");
1262 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n"); 1335 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n");
1263 $printed_novcs = 1; 1336 $printed_novcs = 1;
1264 } 1337 }
1265 return 0; 1338 return 0;
1266 } 1339 }
1267 1340
1268 sub vcs_is_git { 1341 sub vcs_is_git {
1269 return $vcs_used == 1; 1342 return $vcs_used == 1;
1270 } 1343 }
1271 1344
1272 sub vcs_is_hg { 1345 sub vcs_is_hg {
1273 return $vcs_used == 2; 1346 return $vcs_used == 2;
1274 } 1347 }
1275 1348
1276 sub interactive_get_maintainers { 1349 sub interactive_get_maintainers {
1277 my ($list_ref) = @_; 1350 my ($list_ref) = @_;
1278 my @list = @$list_ref; 1351 my @list = @$list_ref;
1279 1352
1280 vcs_exists(); 1353 vcs_exists();
1281 1354
1282 my %selected; 1355 my %selected;
1283 my %authored; 1356 my %authored;
1284 my %signed; 1357 my %signed;
1285 my $count = 0; 1358 my $count = 0;
1286 my $maintained = 0; 1359 my $maintained = 0;
1287 #select maintainers by default 1360 #select maintainers by default
1288 foreach my $entry (@list) { 1361 foreach my $entry (@list) {
1289 my $role = $entry->[1]; 1362 my $role = $entry->[1];
1290 $selected{$count} = ($role =~ /^(maintainer|supporter|open list)/i); 1363 $selected{$count} = ($role =~ /^(maintainer|supporter|open list)/i);
1291 $maintained = 1 if ($role =~ /^(maintainer|supporter)/i); 1364 $maintained = 1 if ($role =~ /^(maintainer|supporter)/i);
1292 $authored{$count} = 0; 1365 $authored{$count} = 0;
1293 $signed{$count} = 0; 1366 $signed{$count} = 0;
1294 $count++; 1367 $count++;
1295 } 1368 }
1296 1369
1297 #menu loop 1370 #menu loop
1298 my $done = 0; 1371 my $done = 0;
1299 my $print_options = 0; 1372 my $print_options = 0;
1300 my $redraw = 1; 1373 my $redraw = 1;
1301 while (!$done) { 1374 while (!$done) {
1302 $count = 0; 1375 $count = 0;
1303 if ($redraw) { 1376 if ($redraw) {
1304 printf STDERR "\n%1s %2s %-65s", 1377 printf STDERR "\n%1s %2s %-65s",
1305 "*", "#", "email/list and role:stats"; 1378 "*", "#", "email/list and role:stats";
1306 if ($email_git || 1379 if ($email_git ||
1307 ($email_git_fallback && !$maintained) || 1380 ($email_git_fallback && !$maintained) ||
1308 $email_git_blame) { 1381 $email_git_blame) {
1309 print STDERR "auth sign"; 1382 print STDERR "auth sign";
1310 } 1383 }
1311 print STDERR "\n"; 1384 print STDERR "\n";
1312 foreach my $entry (@list) { 1385 foreach my $entry (@list) {
1313 my $email = $entry->[0]; 1386 my $email = $entry->[0];
1314 my $role = $entry->[1]; 1387 my $role = $entry->[1];
1315 my $sel = ""; 1388 my $sel = "";
1316 $sel = "*" if ($selected{$count}); 1389 $sel = "*" if ($selected{$count});
1317 my $commit_author = $commit_author_hash{$email}; 1390 my $commit_author = $commit_author_hash{$email};
1318 my $commit_signer = $commit_signer_hash{$email}; 1391 my $commit_signer = $commit_signer_hash{$email};
1319 my $authored = 0; 1392 my $authored = 0;
1320 my $signed = 0; 1393 my $signed = 0;
1321 $authored++ for (@{$commit_author}); 1394 $authored++ for (@{$commit_author});
1322 $signed++ for (@{$commit_signer}); 1395 $signed++ for (@{$commit_signer});
1323 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1396 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1324 printf STDERR "%4d %4d", $authored, $signed 1397 printf STDERR "%4d %4d", $authored, $signed
1325 if ($authored > 0 || $signed > 0); 1398 if ($authored > 0 || $signed > 0);
1326 printf STDERR "\n %s\n", $role; 1399 printf STDERR "\n %s\n", $role;
1327 if ($authored{$count}) { 1400 if ($authored{$count}) {
1328 my $commit_author = $commit_author_hash{$email}; 1401 my $commit_author = $commit_author_hash{$email};
1329 foreach my $ref (@{$commit_author}) { 1402 foreach my $ref (@{$commit_author}) {
1330 print STDERR " Author: @{$ref}[1]\n"; 1403 print STDERR " Author: @{$ref}[1]\n";
1331 } 1404 }
1332 } 1405 }
1333 if ($signed{$count}) { 1406 if ($signed{$count}) {
1334 my $commit_signer = $commit_signer_hash{$email}; 1407 my $commit_signer = $commit_signer_hash{$email};
1335 foreach my $ref (@{$commit_signer}) { 1408 foreach my $ref (@{$commit_signer}) {
1336 print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1409 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1337 } 1410 }
1338 } 1411 }
1339 1412
1340 $count++; 1413 $count++;
1341 } 1414 }
1342 } 1415 }
1343 my $date_ref = \$email_git_since; 1416 my $date_ref = \$email_git_since;
1344 $date_ref = \$email_hg_since if (vcs_is_hg()); 1417 $date_ref = \$email_hg_since if (vcs_is_hg());
1345 if ($print_options) { 1418 if ($print_options) {
1346 $print_options = 0; 1419 $print_options = 0;
1347 if (vcs_exists()) { 1420 if (vcs_exists()) {
1348 print STDERR 1421 print STDERR
1349 "\nVersion Control options:\n" . 1422 "\nVersion Control options:\n" .
1350 "g use git history [$email_git]\n" . 1423 "g use git history [$email_git]\n" .
1351 "gf use git-fallback [$email_git_fallback]\n" . 1424 "gf use git-fallback [$email_git_fallback]\n" .
1352 "b use git blame [$email_git_blame]\n" . 1425 "b use git blame [$email_git_blame]\n" .
1353 "bs use blame signatures [$email_git_blame_signatures]\n" . 1426 "bs use blame signatures [$email_git_blame_signatures]\n" .
1354 "c# minimum commits [$email_git_min_signatures]\n" . 1427 "c# minimum commits [$email_git_min_signatures]\n" .
1355 "%# min percent [$email_git_min_percent]\n" . 1428 "%# min percent [$email_git_min_percent]\n" .
1356 "d# history to use [$$date_ref]\n" . 1429 "d# history to use [$$date_ref]\n" .
1357 "x# max maintainers [$email_git_max_maintainers]\n" . 1430 "x# max maintainers [$email_git_max_maintainers]\n" .
1358 "t all signature types [$email_git_all_signature_types]\n"; 1431 "t all signature types [$email_git_all_signature_types]\n";
1359 } 1432 }
1360 print STDERR "\nAdditional options:\n" . 1433 print STDERR "\nAdditional options:\n" .
1361 "0 toggle all\n" . 1434 "0 toggle all\n" .
1362 "f emails in file [$file_emails]\n" . 1435 "f emails in file [$file_emails]\n" .
1363 "k keywords in file [$keywords]\n" . 1436 "k keywords in file [$keywords]\n" .
1364 "r remove duplicates [$email_remove_duplicates]\n" . 1437 "r remove duplicates [$email_remove_duplicates]\n" .
1365 "p# pattern match depth [$pattern_depth]\n"; 1438 "p# pattern match depth [$pattern_depth]\n";
1366 } 1439 }
1367 print STDERR 1440 print STDERR
1368 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1441 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1369 1442
1370 my $input = <STDIN>; 1443 my $input = <STDIN>;
1371 chomp($input); 1444 chomp($input);
1372 1445
1373 $redraw = 1; 1446 $redraw = 1;
1374 my $rerun = 0; 1447 my $rerun = 0;
1375 my @wish = split(/[, ]+/, $input); 1448 my @wish = split(/[, ]+/, $input);
1376 foreach my $nr (@wish) { 1449 foreach my $nr (@wish) {
1377 $nr = lc($nr); 1450 $nr = lc($nr);
1378 my $sel = substr($nr, 0, 1); 1451 my $sel = substr($nr, 0, 1);
1379 my $str = substr($nr, 1); 1452 my $str = substr($nr, 1);
1380 my $val = 0; 1453 my $val = 0;
1381 $val = $1 if $str =~ /^(\d+)$/; 1454 $val = $1 if $str =~ /^(\d+)$/;
1382 1455
1383 if ($sel eq "y") { 1456 if ($sel eq "y") {
1384 $interactive = 0; 1457 $interactive = 0;
1385 $done = 1; 1458 $done = 1;
1386 $output_rolestats = 0; 1459 $output_rolestats = 0;
1387 $output_roles = 0; 1460 $output_roles = 0;
1388 last; 1461 last;
1389 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1462 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1390 $selected{$nr - 1} = !$selected{$nr - 1}; 1463 $selected{$nr - 1} = !$selected{$nr - 1};
1391 } elsif ($sel eq "*" || $sel eq '^') { 1464 } elsif ($sel eq "*" || $sel eq '^') {
1392 my $toggle = 0; 1465 my $toggle = 0;
1393 $toggle = 1 if ($sel eq '*'); 1466 $toggle = 1 if ($sel eq '*');
1394 for (my $i = 0; $i < $count; $i++) { 1467 for (my $i = 0; $i < $count; $i++) {
1395 $selected{$i} = $toggle; 1468 $selected{$i} = $toggle;
1396 } 1469 }
1397 } elsif ($sel eq "0") { 1470 } elsif ($sel eq "0") {
1398 for (my $i = 0; $i < $count; $i++) { 1471 for (my $i = 0; $i < $count; $i++) {
1399 $selected{$i} = !$selected{$i}; 1472 $selected{$i} = !$selected{$i};
1400 } 1473 }
1401 } elsif ($sel eq "a") { 1474 } elsif ($sel eq "a") {
1402 if ($val > 0 && $val <= $count) { 1475 if ($val > 0 && $val <= $count) {
1403 $authored{$val - 1} = !$authored{$val - 1}; 1476 $authored{$val - 1} = !$authored{$val - 1};
1404 } elsif ($str eq '*' || $str eq '^') { 1477 } elsif ($str eq '*' || $str eq '^') {
1405 my $toggle = 0; 1478 my $toggle = 0;
1406 $toggle = 1 if ($str eq '*'); 1479 $toggle = 1 if ($str eq '*');
1407 for (my $i = 0; $i < $count; $i++) { 1480 for (my $i = 0; $i < $count; $i++) {
1408 $authored{$i} = $toggle; 1481 $authored{$i} = $toggle;
1409 } 1482 }
1410 } 1483 }
1411 } elsif ($sel eq "s") { 1484 } elsif ($sel eq "s") {
1412 if ($val > 0 && $val <= $count) { 1485 if ($val > 0 && $val <= $count) {
1413 $signed{$val - 1} = !$signed{$val - 1}; 1486 $signed{$val - 1} = !$signed{$val - 1};
1414 } elsif ($str eq '*' || $str eq '^') { 1487 } elsif ($str eq '*' || $str eq '^') {
1415 my $toggle = 0; 1488 my $toggle = 0;
1416 $toggle = 1 if ($str eq '*'); 1489 $toggle = 1 if ($str eq '*');
1417 for (my $i = 0; $i < $count; $i++) { 1490 for (my $i = 0; $i < $count; $i++) {
1418 $signed{$i} = $toggle; 1491 $signed{$i} = $toggle;
1419 } 1492 }
1420 } 1493 }
1421 } elsif ($sel eq "o") { 1494 } elsif ($sel eq "o") {
1422 $print_options = 1; 1495 $print_options = 1;
1423 $redraw = 1; 1496 $redraw = 1;
1424 } elsif ($sel eq "g") { 1497 } elsif ($sel eq "g") {
1425 if ($str eq "f") { 1498 if ($str eq "f") {
1426 bool_invert(\$email_git_fallback); 1499 bool_invert(\$email_git_fallback);
1427 } else { 1500 } else {
1428 bool_invert(\$email_git); 1501 bool_invert(\$email_git);
1429 } 1502 }
1430 $rerun = 1; 1503 $rerun = 1;
1431 } elsif ($sel eq "b") { 1504 } elsif ($sel eq "b") {
1432 if ($str eq "s") { 1505 if ($str eq "s") {
1433 bool_invert(\$email_git_blame_signatures); 1506 bool_invert(\$email_git_blame_signatures);
1434 } else { 1507 } else {
1435 bool_invert(\$email_git_blame); 1508 bool_invert(\$email_git_blame);
1436 } 1509 }
1437 $rerun = 1; 1510 $rerun = 1;
1438 } elsif ($sel eq "c") { 1511 } elsif ($sel eq "c") {
1439 if ($val > 0) { 1512 if ($val > 0) {
1440 $email_git_min_signatures = $val; 1513 $email_git_min_signatures = $val;
1441 $rerun = 1; 1514 $rerun = 1;
1442 } 1515 }
1443 } elsif ($sel eq "x") { 1516 } elsif ($sel eq "x") {
1444 if ($val > 0) { 1517 if ($val > 0) {
1445 $email_git_max_maintainers = $val; 1518 $email_git_max_maintainers = $val;
1446 $rerun = 1; 1519 $rerun = 1;
1447 } 1520 }
1448 } elsif ($sel eq "%") { 1521 } elsif ($sel eq "%") {
1449 if ($str ne "" && $val >= 0) { 1522 if ($str ne "" && $val >= 0) {
1450 $email_git_min_percent = $val; 1523 $email_git_min_percent = $val;
1451 $rerun = 1; 1524 $rerun = 1;
1452 } 1525 }
1453 } elsif ($sel eq "d") { 1526 } elsif ($sel eq "d") {
1454 if (vcs_is_git()) { 1527 if (vcs_is_git()) {
1455 $email_git_since = $str; 1528 $email_git_since = $str;
1456 } elsif (vcs_is_hg()) { 1529 } elsif (vcs_is_hg()) {
1457 $email_hg_since = $str; 1530 $email_hg_since = $str;
1458 } 1531 }
1459 $rerun = 1; 1532 $rerun = 1;
1460 } elsif ($sel eq "t") { 1533 } elsif ($sel eq "t") {
1461 bool_invert(\$email_git_all_signature_types); 1534 bool_invert(\$email_git_all_signature_types);
1462 $rerun = 1; 1535 $rerun = 1;
1463 } elsif ($sel eq "f") { 1536 } elsif ($sel eq "f") {
1464 bool_invert(\$file_emails); 1537 bool_invert(\$file_emails);
1465 $rerun = 1; 1538 $rerun = 1;
1466 } elsif ($sel eq "r") { 1539 } elsif ($sel eq "r") {
1467 bool_invert(\$email_remove_duplicates); 1540 bool_invert(\$email_remove_duplicates);
1468 $rerun = 1; 1541 $rerun = 1;
1469 } elsif ($sel eq "k") { 1542 } elsif ($sel eq "k") {
1470 bool_invert(\$keywords); 1543 bool_invert(\$keywords);
1471 $rerun = 1; 1544 $rerun = 1;
1472 } elsif ($sel eq "p") { 1545 } elsif ($sel eq "p") {
1473 if ($str ne "" && $val >= 0) { 1546 if ($str ne "" && $val >= 0) {
1474 $pattern_depth = $val; 1547 $pattern_depth = $val;
1475 $rerun = 1; 1548 $rerun = 1;
1476 } 1549 }
1477 } elsif ($sel eq "h" || $sel eq "?") { 1550 } elsif ($sel eq "h" || $sel eq "?") {
1478 print STDERR <<EOT 1551 print STDERR <<EOT
1479 1552
1480 Interactive mode allows you to select the various maintainers, submitters, 1553 Interactive mode allows you to select the various maintainers, submitters,
1481 commit signers and mailing lists that could be CC'd on a patch. 1554 commit signers and mailing lists that could be CC'd on a patch.
1482 1555
1483 Any *'d entry is selected. 1556 Any *'d entry is selected.
1484 1557
1485 If you have git or hg installed, You can choose to summarize the commit 1558 If you have git or hg installed, You can choose to summarize the commit
1486 history of files in the patch. Also, each line of the current file can 1559 history of files in the patch. Also, each line of the current file can
1487 be matched to its commit author and that commits signers with blame. 1560 be matched to its commit author and that commits signers with blame.
1488 1561
1489 Various knobs exist to control the length of time for active commit 1562 Various knobs exist to control the length of time for active commit
1490 tracking, the maximum number of commit authors and signers to add, 1563 tracking, the maximum number of commit authors and signers to add,
1491 and such. 1564 and such.
1492 1565
1493 Enter selections at the prompt until you are satisfied that the selected 1566 Enter selections at the prompt until you are satisfied that the selected
1494 maintainers are appropriate. You may enter multiple selections separated 1567 maintainers are appropriate. You may enter multiple selections separated
1495 by either commas or spaces. 1568 by either commas or spaces.
1496 1569
1497 EOT 1570 EOT
1498 } else { 1571 } else {
1499 print STDERR "invalid option: '$nr'\n"; 1572 print STDERR "invalid option: '$nr'\n";
1500 $redraw = 0; 1573 $redraw = 0;
1501 } 1574 }
1502 } 1575 }
1503 if ($rerun) { 1576 if ($rerun) {
1504 print STDERR "git-blame can be very slow, please have patience..." 1577 print STDERR "git-blame can be very slow, please have patience..."
1505 if ($email_git_blame); 1578 if ($email_git_blame);
1506 goto &get_maintainers; 1579 goto &get_maintainers;
1507 } 1580 }
1508 } 1581 }
1509 1582
1510 #drop not selected entries 1583 #drop not selected entries
1511 $count = 0; 1584 $count = 0;
1512 my @new_emailto = (); 1585 my @new_emailto = ();
1513 foreach my $entry (@list) { 1586 foreach my $entry (@list) {
1514 if ($selected{$count}) { 1587 if ($selected{$count}) {
1515 push(@new_emailto, $list[$count]); 1588 push(@new_emailto, $list[$count]);
1516 } 1589 }
1517 $count++; 1590 $count++;
1518 } 1591 }
1519 return @new_emailto; 1592 return @new_emailto;
1520 } 1593 }
1521 1594
1522 sub bool_invert { 1595 sub bool_invert {
1523 my ($bool_ref) = @_; 1596 my ($bool_ref) = @_;
1524 1597
1525 if ($$bool_ref) { 1598 if ($$bool_ref) {
1526 $$bool_ref = 0; 1599 $$bool_ref = 0;
1527 } else { 1600 } else {
1528 $$bool_ref = 1; 1601 $$bool_ref = 1;
1529 } 1602 }
1530 } 1603 }
1531 1604
1532 sub save_commits_by_author { 1605 sub save_commits_by_author {
1533 my (@lines) = @_; 1606 my (@lines) = @_;
1534 1607
1535 my @authors = (); 1608 my @authors = ();
1536 my @commits = (); 1609 my @commits = ();
1537 my @subjects = (); 1610 my @subjects = ();
1538 1611
1539 foreach my $line (@lines) { 1612 foreach my $line (@lines) {
1540 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1613 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1541 my $matched = 0; 1614 my $matched = 0;
1542 my $author = $1; 1615 my $author = $1;
1543 my ($name, $address) = parse_email($author); 1616 my ($name, $address) = parse_email($author);
1544 foreach my $to (@interactive_to) { 1617 foreach my $to (@interactive_to) {
1545 my ($to_name, $to_address) = parse_email($to->[0]); 1618 my ($to_name, $to_address) = parse_email($to->[0]);
1546 if ($email_remove_duplicates && 1619 if ($email_remove_duplicates &&
1547 ((lc($name) eq lc($to_name)) || 1620 ((lc($name) eq lc($to_name)) ||
1548 (lc($address) eq lc($to_address)))) { 1621 (lc($address) eq lc($to_address)))) {
1549 $author = $to->[0]; 1622 $author = $to->[0];
1550 $matched = 1; 1623 $matched = 1;
1551 last; 1624 last;
1552 } 1625 }
1553 } 1626 }
1554 $author = format_email($name, $address, 1) if (!$matched); 1627 $author = format_email($name, $address, 1) if (!$matched);
1555 push(@authors, $author); 1628 push(@authors, $author);
1556 } 1629 }
1557 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1630 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1558 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1631 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1559 } 1632 }
1560 1633
1561 for (my $i = 0; $i < @authors; $i++) { 1634 for (my $i = 0; $i < @authors; $i++) {
1562 my $exists = 0; 1635 my $exists = 0;
1563 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 1636 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1564 if (@{$ref}[0] eq $commits[$i] && 1637 if (@{$ref}[0] eq $commits[$i] &&
1565 @{$ref}[1] eq $subjects[$i]) { 1638 @{$ref}[1] eq $subjects[$i]) {
1566 $exists = 1; 1639 $exists = 1;
1567 last; 1640 last;
1568 } 1641 }
1569 } 1642 }
1570 if (!$exists) { 1643 if (!$exists) {
1571 push(@{$commit_author_hash{$authors[$i]}}, 1644 push(@{$commit_author_hash{$authors[$i]}},
1572 [ ($commits[$i], $subjects[$i]) ]); 1645 [ ($commits[$i], $subjects[$i]) ]);
1573 } 1646 }
1574 } 1647 }
1575 } 1648 }
1576 1649
1577 sub save_commits_by_signer { 1650 sub save_commits_by_signer {
1578 my (@lines) = @_; 1651 my (@lines) = @_;
1579 1652
1580 my $commit = ""; 1653 my $commit = "";
1581 my $subject = ""; 1654 my $subject = "";
1582 1655
1583 foreach my $line (@lines) { 1656 foreach my $line (@lines) {
1584 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1657 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1585 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1658 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1586 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 1659 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1587 my @signatures = ($line); 1660 my @signatures = ($line);
1588 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1661 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1589 my @types = @$types_ref; 1662 my @types = @$types_ref;
1590 my @signers = @$signers_ref; 1663 my @signers = @$signers_ref;
1591 1664
1592 my $type = $types[0]; 1665 my $type = $types[0];
1593 my $signer = $signers[0]; 1666 my $signer = $signers[0];
1594 1667
1595 my $matched = 0; 1668 my $matched = 0;
1596 my ($name, $address) = parse_email($signer); 1669 my ($name, $address) = parse_email($signer);
1597 foreach my $to (@interactive_to) { 1670 foreach my $to (@interactive_to) {
1598 my ($to_name, $to_address) = parse_email($to->[0]); 1671 my ($to_name, $to_address) = parse_email($to->[0]);
1599 if ($email_remove_duplicates && 1672 if ($email_remove_duplicates &&
1600 ((lc($name) eq lc($to_name)) || 1673 ((lc($name) eq lc($to_name)) ||
1601 (lc($address) eq lc($to_address)))) { 1674 (lc($address) eq lc($to_address)))) {
1602 $signer = $to->[0]; 1675 $signer = $to->[0];
1603 $matched = 1; 1676 $matched = 1;
1604 last; 1677 last;
1605 } 1678 }
1606 $signer = format_email($name, $address, 1) if (!$matched); 1679 $signer = format_email($name, $address, 1) if (!$matched);
1607 } 1680 }
1608 1681
1609 my $exists = 0; 1682 my $exists = 0;
1610 foreach my $ref(@{$commit_signer_hash{$signer}}) { 1683 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1611 if (@{$ref}[0] eq $commit && 1684 if (@{$ref}[0] eq $commit &&
1612 @{$ref}[1] eq $subject && 1685 @{$ref}[1] eq $subject &&
1613 @{$ref}[2] eq $type) { 1686 @{$ref}[2] eq $type) {
1614 $exists = 1; 1687 $exists = 1;
1615 last; 1688 last;
1616 } 1689 }
1617 } 1690 }
1618 if (!$exists) { 1691 if (!$exists) {
1619 push(@{$commit_signer_hash{$signer}}, 1692 push(@{$commit_signer_hash{$signer}},
1620 [ ($commit, $subject, $type) ]); 1693 [ ($commit, $subject, $type) ]);
1621 } 1694 }
1622 } 1695 }
1623 } 1696 }
1624 } 1697 }
1625 1698
1626 sub vcs_assign { 1699 sub vcs_assign {
1627 my ($role, $divisor, @lines) = @_; 1700 my ($role, $divisor, @lines) = @_;
1628 1701
1629 my %hash; 1702 my %hash;
1630 my $count = 0; 1703 my $count = 0;
1631 1704
1632 return if (@lines <= 0); 1705 return if (@lines <= 0);
1633 1706
1634 if ($divisor <= 0) { 1707 if ($divisor <= 0) {
1635 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 1708 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1636 $divisor = 1; 1709 $divisor = 1;
1637 } 1710 }
1638 1711
1639 if ($email_remove_duplicates) { 1712 @lines = mailmap(@lines);
1640 @lines = mailmap(@lines);
1641 }
1642 1713
1643 return if (@lines <= 0); 1714 return if (@lines <= 0);
1644 1715
1645 @lines = sort(@lines); 1716 @lines = sort(@lines);
1646 1717
1647 # uniq -c 1718 # uniq -c
1648 $hash{$_}++ for @lines; 1719 $hash{$_}++ for @lines;
1649 1720
1650 # sort -rn 1721 # sort -rn
1651 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 1722 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1652 my $sign_offs = $hash{$line}; 1723 my $sign_offs = $hash{$line};
1653 my $percent = $sign_offs * 100 / $divisor; 1724 my $percent = $sign_offs * 100 / $divisor;
1654 1725
1655 $percent = 100 if ($percent > 100); 1726 $percent = 100 if ($percent > 100);
1656 $count++; 1727 $count++;
1657 last if ($sign_offs < $email_git_min_signatures || 1728 last if ($sign_offs < $email_git_min_signatures ||
1658 $count > $email_git_max_maintainers || 1729 $count > $email_git_max_maintainers ||
1659 $percent < $email_git_min_percent); 1730 $percent < $email_git_min_percent);
1660 push_email_address($line, ''); 1731 push_email_address($line, '');
1661 if ($output_rolestats) { 1732 if ($output_rolestats) {
1662 my $fmt_percent = sprintf("%.0f", $percent); 1733 my $fmt_percent = sprintf("%.0f", $percent);
1663 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1734 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1664 } else { 1735 } else {
1665 add_role($line, $role); 1736 add_role($line, $role);
1666 } 1737 }
1667 } 1738 }
1668 } 1739 }
1669 1740
1670 sub vcs_file_signoffs { 1741 sub vcs_file_signoffs {
1671 my ($file) = @_; 1742 my ($file) = @_;
1672 1743
1673 my @signers = (); 1744 my @signers = ();
1674 my $commits; 1745 my $commits;
1675 1746
1676 $vcs_used = vcs_exists(); 1747 $vcs_used = vcs_exists();
1677 return if (!$vcs_used); 1748 return if (!$vcs_used);
1678 1749
1679 my $cmd = $VCS_cmds{"find_signers_cmd"}; 1750 my $cmd = $VCS_cmds{"find_signers_cmd"};
1680 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1751 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1681 1752
1682 ($commits, @signers) = vcs_find_signers($cmd); 1753 ($commits, @signers) = vcs_find_signers($cmd);
1683 vcs_assign("commit_signer", $commits, @signers); 1754 vcs_assign("commit_signer", $commits, @signers);
1684 } 1755 }
1685 1756
1686 sub vcs_file_blame { 1757 sub vcs_file_blame {
1687 my ($file) = @_; 1758 my ($file) = @_;
1688 1759
1689 my @signers = (); 1760 my @signers = ();
1690 my @all_commits = (); 1761 my @all_commits = ();
1691 my @commits = (); 1762 my @commits = ();
1692 my $total_commits; 1763 my $total_commits;
1693 my $total_lines; 1764 my $total_lines;
1694 1765
1695 $vcs_used = vcs_exists(); 1766 $vcs_used = vcs_exists();
1696 return if (!$vcs_used); 1767 return if (!$vcs_used);
1697 1768
1698 @all_commits = vcs_blame($file); 1769 @all_commits = vcs_blame($file);
1699 @commits = uniq(@all_commits); 1770 @commits = uniq(@all_commits);
1700 $total_commits = @commits; 1771 $total_commits = @commits;
1701 $total_lines = @all_commits; 1772 $total_lines = @all_commits;
1702 1773
1703 if ($email_git_blame_signatures) { 1774 if ($email_git_blame_signatures) {
1704 if (vcs_is_hg()) { 1775 if (vcs_is_hg()) {
1705 my $commit_count; 1776 my $commit_count;
1706 my @commit_signers = (); 1777 my @commit_signers = ();
1707 my $commit = join(" -r ", @commits); 1778 my $commit = join(" -r ", @commits);
1708 my $cmd; 1779 my $cmd;
1709 1780
1710 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1781 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1711 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1782 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1712 1783
1713 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1784 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1714 1785
1715 push(@signers, @commit_signers); 1786 push(@signers, @commit_signers);
1716 } else { 1787 } else {
1717 foreach my $commit (@commits) { 1788 foreach my $commit (@commits) {
1718 my $commit_count; 1789 my $commit_count;
1719 my @commit_signers = (); 1790 my @commit_signers = ();
1720 my $cmd; 1791 my $cmd;
1721 1792
1722 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1793 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1723 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1794 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1724 1795
1725 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1796 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1726 1797
1727 push(@signers, @commit_signers); 1798 push(@signers, @commit_signers);
1728 } 1799 }
1729 } 1800 }
1730 } 1801 }
1731 1802
1732 if ($from_filename) { 1803 if ($from_filename) {
1733 if ($output_rolestats) { 1804 if ($output_rolestats) {
1734 my @blame_signers; 1805 my @blame_signers;
1735 if (vcs_is_hg()) {{ # Double brace for last exit 1806 if (vcs_is_hg()) {{ # Double brace for last exit
1736 my $commit_count; 1807 my $commit_count;
1737 my @commit_signers = (); 1808 my @commit_signers = ();
1738 @commits = uniq(@commits); 1809 @commits = uniq(@commits);
1739 @commits = sort(@commits); 1810 @commits = sort(@commits);
1740 my $commit = join(" -r ", @commits); 1811 my $commit = join(" -r ", @commits);
1741 my $cmd; 1812 my $cmd;
1742 1813
1743 $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1814 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1744 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1815 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1745 1816
1746 my @lines = (); 1817 my @lines = ();
1747 1818
1748 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1819 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1749 1820
1750 if (!$email_git_penguin_chiefs) { 1821 if (!$email_git_penguin_chiefs) {
1751 @lines = grep(!/${penguin_chiefs}/i, @lines); 1822 @lines = grep(!/${penguin_chiefs}/i, @lines);
1752 } 1823 }
1753 1824
1754 last if !@lines; 1825 last if !@lines;
1755 1826
1756 my @authors = (); 1827 my @authors = ();
1757 foreach my $line (@lines) { 1828 foreach my $line (@lines) {
1758 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1829 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1759 my $author = $1; 1830 my $author = $1;
1760 my ($name, $address) = parse_email($author); 1831 my ($name, $address) = parse_email($author);
1761 $author = format_email($name, $address, 1); 1832 $author = format_email($name, $address, 1);
1762 push(@authors, $1); 1833 push(@authors, $1);
1763 } 1834 }
1764 } 1835 }
1765 1836
1766 save_commits_by_author(@lines) if ($interactive); 1837 save_commits_by_author(@lines) if ($interactive);
1767 save_commits_by_signer(@lines) if ($interactive); 1838 save_commits_by_signer(@lines) if ($interactive);
1768 1839
1769 push(@signers, @authors); 1840 push(@signers, @authors);
1770 }} 1841 }}
1771 else { 1842 else {
1772 foreach my $commit (@commits) { 1843 foreach my $commit (@commits) {
1773 my $i; 1844 my $i;
1774 my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1845 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1775 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1846 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1776 my @author = vcs_find_author($cmd); 1847 my @author = vcs_find_author($cmd);
1777 next if !@author; 1848 next if !@author;
1778 my $count = grep(/$commit/, @all_commits); 1849 my $count = grep(/$commit/, @all_commits);
1779 for ($i = 0; $i < $count ; $i++) { 1850 for ($i = 0; $i < $count ; $i++) {
1780 push(@blame_signers, $author[0]); 1851 push(@blame_signers, $author[0]);
1781 } 1852 }
1782 } 1853 }
1783 } 1854 }
1784 if (@blame_signers) { 1855 if (@blame_signers) {
1785 vcs_assign("authored lines", $total_lines, @blame_signers); 1856 vcs_assign("authored lines", $total_lines, @blame_signers);
1786 } 1857 }
1787 } 1858 }
1788 vcs_assign("commits", $total_commits, @signers); 1859 vcs_assign("commits", $total_commits, @signers);
1789 } else { 1860 } else {
1790 vcs_assign("modified commits", $total_commits, @signers); 1861 vcs_assign("modified commits", $total_commits, @signers);
1791 } 1862 }
1792 } 1863 }
1793 1864
1794 sub uniq { 1865 sub uniq {
1795 my (@parms) = @_; 1866 my (@parms) = @_;
1796 1867
1797 my %saw; 1868 my %saw;
1798 @parms = grep(!$saw{$_}++, @parms); 1869 @parms = grep(!$saw{$_}++, @parms);
1799 return @parms; 1870 return @parms;
1800 } 1871 }
1801 1872
1802 sub sort_and_uniq { 1873 sub sort_and_uniq {
1803 my (@parms) = @_; 1874 my (@parms) = @_;
1804 1875
1805 my %saw; 1876 my %saw;
1806 @parms = sort @parms; 1877 @parms = sort @parms;
1807 @parms = grep(!$saw{$_}++, @parms); 1878 @parms = grep(!$saw{$_}++, @parms);
1808 return @parms; 1879 return @parms;
1809 } 1880 }
1810 1881
1811 sub clean_file_emails { 1882 sub clean_file_emails {
1812 my (@file_emails) = @_; 1883 my (@file_emails) = @_;
1813 my @fmt_emails = (); 1884 my @fmt_emails = ();
1814 1885
1815 foreach my $email (@file_emails) { 1886 foreach my $email (@file_emails) {
1816 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 1887 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1817 my ($name, $address) = parse_email($email); 1888 my ($name, $address) = parse_email($email);
1818 if ($name eq '"[,\.]"') { 1889 if ($name eq '"[,\.]"') {
1819 $name = ""; 1890 $name = "";
1820 } 1891 }
1821 1892
1822 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 1893 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1823 if (@nw > 2) { 1894 if (@nw > 2) {
1824 my $first = $nw[@nw - 3]; 1895 my $first = $nw[@nw - 3];
1825 my $middle = $nw[@nw - 2]; 1896 my $middle = $nw[@nw - 2];
1826 my $last = $nw[@nw - 1]; 1897 my $last = $nw[@nw - 1];
1827 1898
1828 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 1899 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1829 (length($first) == 2 && substr($first, -1) eq ".")) || 1900 (length($first) == 2 && substr($first, -1) eq ".")) ||
1830 (length($middle) == 1 || 1901 (length($middle) == 1 ||
1831 (length($middle) == 2 && substr($middle, -1) eq "."))) { 1902 (length($middle) == 2 && substr($middle, -1) eq "."))) {
1832 $name = "$first $middle $last"; 1903 $name = "$first $middle $last";
1833 } else { 1904 } else {
1834 $name = "$middle $last"; 1905 $name = "$middle $last";
1835 } 1906 }
1836 } 1907 }
1837 1908
1838 if (substr($name, -1) =~ /[,\.]/) { 1909 if (substr($name, -1) =~ /[,\.]/) {
1839 $name = substr($name, 0, length($name) - 1); 1910 $name = substr($name, 0, length($name) - 1);
1840 } elsif (substr($name, -2) =~ /[,\.]"/) { 1911 } elsif (substr($name, -2) =~ /[,\.]"/) {
1841 $name = substr($name, 0, length($name) - 2) . '"'; 1912 $name = substr($name, 0, length($name) - 2) . '"';
1842 } 1913 }
1843 1914
1844 if (substr($name, 0, 1) =~ /[,\.]/) { 1915 if (substr($name, 0, 1) =~ /[,\.]/) {
1845 $name = substr($name, 1, length($name) - 1); 1916 $name = substr($name, 1, length($name) - 1);
1846 } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 1917 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
1847 $name = '"' . substr($name, 2, length($name) - 2); 1918 $name = '"' . substr($name, 2, length($name) - 2);
1848 } 1919 }
1849 1920
1850 my $fmt_email = format_email($name, $address, $email_usename); 1921 my $fmt_email = format_email($name, $address, $email_usename);
1851 push(@fmt_emails, $fmt_email); 1922 push(@fmt_emails, $fmt_email);
1852 } 1923 }
1853 return @fmt_emails; 1924 return @fmt_emails;
1854 } 1925 }
1855 1926
1856 sub merge_email { 1927 sub merge_email {
1857 my @lines; 1928 my @lines;
1858 my %saw; 1929 my %saw;
1859 1930
1860 for (@_) { 1931 for (@_) {
1861 my ($address, $role) = @$_; 1932 my ($address, $role) = @$_;
1862 if (!$saw{$address}) { 1933 if (!$saw{$address}) {
1863 if ($output_roles) { 1934 if ($output_roles) {
1864 push(@lines, "$address ($role)"); 1935 push(@lines, "$address ($role)");
1865 } else { 1936 } else {
1866 push(@lines, $address); 1937 push(@lines, $address);
1867 } 1938 }
1868 $saw{$address} = 1; 1939 $saw{$address} = 1;
1869 } 1940 }
1870 } 1941 }
1871 1942
1872 return @lines; 1943 return @lines;
1873 } 1944 }
1874 1945
1875 sub output { 1946 sub output {
1876 my (@parms) = @_; 1947 my (@parms) = @_;
1877 1948
1878 if ($output_multiline) { 1949 if ($output_multiline) {
1879 foreach my $line (@parms) { 1950 foreach my $line (@parms) {
1880 print("${line}\n"); 1951 print("${line}\n");
1881 } 1952 }
1882 } else { 1953 } else {
1883 print(join($output_separator, @parms)); 1954 print(join($output_separator, @parms));
1884 print("\n"); 1955 print("\n");
1885 } 1956 }
1886 } 1957 }
1887 1958
1888 my $rfc822re; 1959 my $rfc822re;
1889 1960
1890 sub make_rfc822re { 1961 sub make_rfc822re {
1891 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 1962 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
1892 # comment. We must allow for rfc822_lwsp (or comments) after each of these. 1963 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
1893 # This regexp will only work on addresses which have had comments stripped 1964 # This regexp will only work on addresses which have had comments stripped
1894 # and replaced with rfc822_lwsp. 1965 # and replaced with rfc822_lwsp.
1895 1966
1896 my $specials = '()<>@,;:\\\\".\\[\\]'; 1967 my $specials = '()<>@,;:\\\\".\\[\\]';
1897 my $controls = '\\000-\\037\\177'; 1968 my $controls = '\\000-\\037\\177';
1898 1969
1899 my $dtext = "[^\\[\\]\\r\\\\]"; 1970 my $dtext = "[^\\[\\]\\r\\\\]";
1900 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 1971 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
1901 1972
1902 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 1973 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
1903 1974
1904 # Use zero-width assertion to spot the limit of an atom. A simple 1975 # Use zero-width assertion to spot the limit of an atom. A simple
1905 # $rfc822_lwsp* causes the regexp engine to hang occasionally. 1976 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
1906 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 1977 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
1907 my $word = "(?:$atom|$quoted_string)"; 1978 my $word = "(?:$atom|$quoted_string)";
1908 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 1979 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
1909 1980
1910 my $sub_domain = "(?:$atom|$domain_literal)"; 1981 my $sub_domain = "(?:$atom|$domain_literal)";
1911 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 1982 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
1912 1983
1913 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 1984 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
1914 1985
1915 my $phrase = "$word*"; 1986 my $phrase = "$word*";
1916 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 1987 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
1917 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 1988 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
1918 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 1989 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
1919 1990
1920 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 1991 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
1921 my $address = "(?:$mailbox|$group)"; 1992 my $address = "(?:$mailbox|$group)";
1922 1993
1923 return "$rfc822_lwsp*$address"; 1994 return "$rfc822_lwsp*$address";
1924 } 1995 }
1925 1996
1926 sub rfc822_strip_comments { 1997 sub rfc822_strip_comments {
1927 my $s = shift; 1998 my $s = shift;
1928 # Recursively remove comments, and replace with a single space. The simpler 1999 # Recursively remove comments, and replace with a single space. The simpler
1929 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped 2000 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
1930 # chars in atoms, for example. 2001 # chars in atoms, for example.
1931 2002
1932 while ($s =~ s/^((?:[^"\\]|\\.)* 2003 while ($s =~ s/^((?:[^"\\]|\\.)*
1933 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 2004 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
1934 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 2005 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
1935 return $s; 2006 return $s;
1936 } 2007 }
1937 2008
1938 # valid: returns true if the parameter is an RFC822 valid address 2009 # valid: returns true if the parameter is an RFC822 valid address
1939 # 2010 #
1940 sub rfc822_valid { 2011 sub rfc822_valid {
1941 my $s = rfc822_strip_comments(shift); 2012 my $s = rfc822_strip_comments(shift);
1942 2013
1943 if (!$rfc822re) { 2014 if (!$rfc822re) {
1944 $rfc822re = make_rfc822re(); 2015 $rfc822re = make_rfc822re();
1945 } 2016 }
1946 2017
1947 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 2018 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
1948 } 2019 }
1949 2020
1950 # validlist: In scalar context, returns true if the parameter is an RFC822 2021 # validlist: In scalar context, returns true if the parameter is an RFC822
1951 # valid list of addresses. 2022 # valid list of addresses.
1952 # 2023 #
1953 # In list context, returns an empty list on failure (an invalid 2024 # In list context, returns an empty list on failure (an invalid
1954 # address was found); otherwise a list whose first element is the 2025 # address was found); otherwise a list whose first element is the
1955 # number of addresses found and whose remaining elements are the 2026 # number of addresses found and whose remaining elements are the
1956 # addresses. This is needed to disambiguate failure (invalid) 2027 # addresses. This is needed to disambiguate failure (invalid)
1957 # from success with no addresses found, because an empty string is 2028 # from success with no addresses found, because an empty string is
1958 # a valid list. 2029 # a valid list.
1959 2030
1960 sub rfc822_validlist { 2031 sub rfc822_validlist {
1961 my $s = rfc822_strip_comments(shift); 2032 my $s = rfc822_strip_comments(shift);
1962 2033
1963 if (!$rfc822re) { 2034 if (!$rfc822re) {
1964 $rfc822re = make_rfc822re(); 2035 $rfc822re = make_rfc822re();
1965 } 2036 }
1966 # * null list items are valid according to the RFC 2037 # * null list items are valid according to the RFC
1967 # * the '1' business is to aid in distinguishing failure from no results 2038 # * the '1' business is to aid in distinguishing failure from no results