powerpc/mm/book3s64/radix: Remove unused code.
[linux-2.6-block.git] / scripts / get_maintainer.pl
CommitLineData
cb77f0d6 1#!/usr/bin/env perl
882ea1d6
JP
2# SPDX-License-Identifier: GPL-2.0
3#
cb7301c7
JP
4# (c) 2007, Joe Perches <joe@perches.com>
5# created from checkpatch.pl
6#
7# Print selected MAINTAINERS information for
8# the files modified in a patch or for a file
9#
3bd7bf5f
RK
10# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
11# perl scripts/get_maintainer.pl [OPTIONS] -f <file>
cb7301c7 12
cb77f0d6 13use warnings;
cb7301c7
JP
14use strict;
15
16my $P = $0;
7e1863af 17my $V = '0.26';
cb7301c7
JP
18
19use Getopt::Long qw(:config no_auto_abbrev);
be17bddc 20use Cwd;
6f7d98ec 21use File::Find;
cb7301c7 22
be17bddc 23my $cur_path = fastgetcwd() . '/';
cb7301c7
JP
24my $lk_path = "./";
25my $email = 1;
26my $email_usename = 1;
27my $email_maintainer = 1;
c1c3f2c9 28my $email_reviewer = 1;
cb7301c7 29my $email_list = 1;
49662503 30my $email_moderated_list = 1;
cb7301c7 31my $email_subscriber_list = 0;
cb7301c7 32my $email_git_penguin_chiefs = 0;
e3e9d114 33my $email_git = 0;
0fa05599 34my $email_git_all_signature_types = 0;
60db31ac 35my $email_git_blame = 0;
683c6f8f 36my $email_git_blame_signatures = 1;
e3e9d114 37my $email_git_fallback = 1;
cb7301c7
JP
38my $email_git_min_signatures = 1;
39my $email_git_max_maintainers = 5;
afa81ee1 40my $email_git_min_percent = 5;
cb7301c7 41my $email_git_since = "1-year-ago";
60db31ac 42my $email_hg_since = "-365";
dace8e30 43my $interactive = 0;
11ecf53c 44my $email_remove_duplicates = 1;
b9e2331d 45my $email_use_mailmap = 1;
cb7301c7
JP
46my $output_multiline = 1;
47my $output_separator = ", ";
3c7385b8 48my $output_roles = 0;
7e1863af 49my $output_rolestats = 1;
364f68dc 50my $output_section_maxlen = 50;
cb7301c7 51my $scm = 0;
31bb82c9 52my $tree = 1;
cb7301c7
JP
53my $web = 0;
54my $subsystem = 0;
55my $status = 0;
03aed214 56my $letters = "";
dcf36a92 57my $keywords = 1;
4b76c9da 58my $sections = 0;
03372dbb 59my $file_emails = 0;
4a7fdb5f 60my $from_filename = 0;
3fb55652 61my $pattern_depth = 0;
083bf9c5 62my $self_test = undef;
cb7301c7
JP
63my $version = 0;
64my $help = 0;
6f7d98ec 65my $find_maintainer_files = 0;
5f0baf95 66my $maintainer_path;
683c6f8f
JP
67my $vcs_used = 0;
68
cb7301c7
JP
69my $exit = 0;
70
683c6f8f
JP
71my %commit_author_hash;
72my %commit_signer_hash;
dace8e30 73
cb7301c7 74my @penguin_chief = ();
e4d26b02 75push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
cb7301c7 76#Andrew wants in on most everything - 2009/01/14
e4d26b02 77#push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
cb7301c7
JP
78
79my @penguin_chief_names = ();
80foreach my $chief (@penguin_chief) {
81 if ($chief =~ m/^(.*):(.*)/) {
82 my $chief_name = $1;
83 my $chief_addr = $2;
84 push(@penguin_chief_names, $chief_name);
85 }
86}
e4d26b02
JP
87my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
88
89# Signature types of people who are either
90# a) responsible for the code in question, or
91# b) familiar enough with it to give relevant feedback
92my @signature_tags = ();
93push(@signature_tags, "Signed-off-by:");
94push(@signature_tags, "Reviewed-by:");
95push(@signature_tags, "Acked-by:");
cb7301c7 96
7dea2681
JP
97my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
98
5f2441e9 99# rfc822 email address - preloaded methods go here.
1b5e1cf6 100my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
df4cc036 101my $rfc822_char = '[\\000-\\377]';
1b5e1cf6 102
60db31ac
JP
103# VCS command support: class-like functions and strings
104
105my %VCS_cmds;
106
107my %VCS_cmds_git = (
108 "execute_cmd" => \&git_execute_cmd,
ec83b616 109 "available" => '(which("git") ne "") && (-e ".git")',
683c6f8f 110 "find_signers_cmd" =>
ed128fea 111 "git log --no-color --follow --since=\$email_git_since " .
c9ecefea 112 '--numstat --no-merges ' .
683c6f8f
JP
113 '--format="GitCommit: %H%n' .
114 'GitAuthor: %an <%ae>%n' .
115 'GitDate: %aD%n' .
116 'GitSubject: %s%n' .
117 '%b%n"' .
118 " -- \$file",
119 "find_commit_signers_cmd" =>
120 "git log --no-color " .
c9ecefea 121 '--numstat ' .
683c6f8f
JP
122 '--format="GitCommit: %H%n' .
123 'GitAuthor: %an <%ae>%n' .
124 'GitDate: %aD%n' .
125 'GitSubject: %s%n' .
126 '%b%n"' .
127 " -1 \$commit",
128 "find_commit_author_cmd" =>
129 "git log --no-color " .
c9ecefea 130 '--numstat ' .
683c6f8f
JP
131 '--format="GitCommit: %H%n' .
132 'GitAuthor: %an <%ae>%n' .
133 'GitDate: %aD%n' .
134 'GitSubject: %s%n"' .
135 " -1 \$commit",
60db31ac
JP
136 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
137 "blame_file_cmd" => "git blame -l \$file",
683c6f8f 138 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
dace8e30 139 "blame_commit_pattern" => "^([0-9a-f]+) ",
683c6f8f
JP
140 "author_pattern" => "^GitAuthor: (.*)",
141 "subject_pattern" => "^GitSubject: (.*)",
c9ecefea 142 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
4cad35a7 143 "file_exists_cmd" => "git ls-files \$file",
e1f75904 144 "list_files_cmd" => "git ls-files \$file",
60db31ac
JP
145);
146
147my %VCS_cmds_hg = (
148 "execute_cmd" => \&hg_execute_cmd,
149 "available" => '(which("hg") ne "") && (-d ".hg")',
150 "find_signers_cmd" =>
683c6f8f
JP
151 "hg log --date=\$email_hg_since " .
152 "--template='HgCommit: {node}\\n" .
153 "HgAuthor: {author}\\n" .
154 "HgSubject: {desc}\\n'" .
155 " -- \$file",
156 "find_commit_signers_cmd" =>
157 "hg log " .
158 "--template='HgSubject: {desc}\\n'" .
159 " -r \$commit",
160 "find_commit_author_cmd" =>
161 "hg log " .
162 "--template='HgCommit: {node}\\n" .
163 "HgAuthor: {author}\\n" .
164 "HgSubject: {desc|firstline}\\n'" .
165 " -r \$commit",
60db31ac 166 "blame_range_cmd" => "", # not supported
683c6f8f
JP
167 "blame_file_cmd" => "hg blame -n \$file",
168 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
169 "blame_commit_pattern" => "^([ 0-9a-f]+):",
170 "author_pattern" => "^HgAuthor: (.*)",
171 "subject_pattern" => "^HgSubject: (.*)",
c9ecefea 172 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
4cad35a7 173 "file_exists_cmd" => "hg files \$file",
e1f75904 174 "list_files_cmd" => "hg manifest -R \$file",
60db31ac
JP
175);
176
bcde44ed
JP
177my $conf = which_conf(".get_maintainer.conf");
178if (-f $conf) {
368669da 179 my @conf_args;
bcde44ed
JP
180 open(my $conffile, '<', "$conf")
181 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
182
368669da
JP
183 while (<$conffile>) {
184 my $line = $_;
185
186 $line =~ s/\s*\n?$//g;
187 $line =~ s/^\s*//g;
188 $line =~ s/\s+/ /g;
189
190 next if ($line =~ m/^\s*#/);
191 next if ($line =~ m/^\s*$/);
192
193 my @words = split(" ", $line);
194 foreach my $word (@words) {
195 last if ($word =~ m/^#/);
196 push (@conf_args, $word);
197 }
198 }
199 close($conffile);
200 unshift(@ARGV, @conf_args) if @conf_args;
201}
202
435de078
JP
203my @ignore_emails = ();
204my $ignore_file = which_conf(".get_maintainer.ignore");
205if (-f $ignore_file) {
206 open(my $ignore, '<', "$ignore_file")
207 or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
208 while (<$ignore>) {
209 my $line = $_;
210
211 $line =~ s/\s*\n?$//;
212 $line =~ s/^\s*//;
213 $line =~ s/\s+$//;
214 $line =~ s/#.*$//;
215
216 next if ($line =~ m/^\s*$/);
217 if (rfc822_valid($line)) {
218 push(@ignore_emails, $line);
219 }
220 }
221 close($ignore);
222}
223
e1f75904
TS
224if ($#ARGV > 0) {
225 foreach (@ARGV) {
083bf9c5 226 if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
e1f75904
TS
227 die "$P: using --self-test does not allow any other option or argument\n";
228 }
229 }
230}
231
cb7301c7
JP
232if (!GetOptions(
233 'email!' => \$email,
234 'git!' => \$email_git,
e4d26b02 235 'git-all-signature-types!' => \$email_git_all_signature_types,
60db31ac 236 'git-blame!' => \$email_git_blame,
683c6f8f 237 'git-blame-signatures!' => \$email_git_blame_signatures,
e3e9d114 238 'git-fallback!' => \$email_git_fallback,
cb7301c7
JP
239 'git-chief-penguins!' => \$email_git_penguin_chiefs,
240 'git-min-signatures=i' => \$email_git_min_signatures,
241 'git-max-maintainers=i' => \$email_git_max_maintainers,
afa81ee1 242 'git-min-percent=i' => \$email_git_min_percent,
cb7301c7 243 'git-since=s' => \$email_git_since,
60db31ac 244 'hg-since=s' => \$email_hg_since,
dace8e30 245 'i|interactive!' => \$interactive,
11ecf53c 246 'remove-duplicates!' => \$email_remove_duplicates,
b9e2331d 247 'mailmap!' => \$email_use_mailmap,
cb7301c7 248 'm!' => \$email_maintainer,
c1c3f2c9 249 'r!' => \$email_reviewer,
cb7301c7
JP
250 'n!' => \$email_usename,
251 'l!' => \$email_list,
49662503 252 'moderated!' => \$email_moderated_list,
cb7301c7
JP
253 's!' => \$email_subscriber_list,
254 'multiline!' => \$output_multiline,
3c7385b8
JP
255 'roles!' => \$output_roles,
256 'rolestats!' => \$output_rolestats,
cb7301c7
JP
257 'separator=s' => \$output_separator,
258 'subsystem!' => \$subsystem,
259 'status!' => \$status,
260 'scm!' => \$scm,
31bb82c9 261 'tree!' => \$tree,
cb7301c7 262 'web!' => \$web,
03aed214 263 'letters=s' => \$letters,
3fb55652 264 'pattern-depth=i' => \$pattern_depth,
dcf36a92 265 'k|keywords!' => \$keywords,
4b76c9da 266 'sections!' => \$sections,
03372dbb 267 'fe|file-emails!' => \$file_emails,
4a7fdb5f 268 'f|file' => \$from_filename,
6f7d98ec 269 'find-maintainer-files' => \$find_maintainer_files,
5f0baf95 270 'mpath|maintainer-path=s' => \$maintainer_path,
083bf9c5 271 'self-test:s' => \$self_test,
cb7301c7 272 'v|version' => \$version,
64f77f31 273 'h|help|usage' => \$help,
cb7301c7 274 )) {
3c7385b8 275 die "$P: invalid argument - use --help if necessary\n";
cb7301c7
JP
276}
277
278if ($help != 0) {
279 usage();
280 exit 0;
281}
282
283if ($version != 0) {
284 print("${P} ${V}\n");
285 exit 0;
286}
287
083bf9c5 288if (defined $self_test) {
e1f75904 289 read_all_maintainer_files();
083bf9c5 290 self_test();
e1f75904
TS
291 exit 0;
292}
293
64f77f31
JP
294if (-t STDIN && !@ARGV) {
295 # We're talking to a terminal, but have no command line arguments.
296 die "$P: missing patchfile or -f file - use --help if necessary\n";
cb7301c7
JP
297}
298
683c6f8f
JP
299$output_multiline = 0 if ($output_separator ne ", ");
300$output_rolestats = 1 if ($interactive);
301$output_roles = 1 if ($output_rolestats);
3c7385b8 302
03aed214
JP
303if ($sections || $letters ne "") {
304 $sections = 1;
4b76c9da
JP
305 $email = 0;
306 $email_list = 0;
307 $scm = 0;
308 $status = 0;
309 $subsystem = 0;
310 $web = 0;
311 $keywords = 0;
6ef1c52e 312 $interactive = 0;
4b76c9da
JP
313} else {
314 my $selections = $email + $scm + $status + $subsystem + $web;
315 if ($selections == 0) {
4b76c9da
JP
316 die "$P: Missing required option: email, scm, status, subsystem or web\n";
317 }
cb7301c7
JP
318}
319
f5492666 320if ($email &&
c1c3f2c9
JP
321 ($email_maintainer + $email_reviewer +
322 $email_list + $email_subscriber_list +
f5492666 323 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
cb7301c7
JP
324 die "$P: Please select at least 1 email option\n";
325}
326
31bb82c9 327if ($tree && !top_of_kernel_tree($lk_path)) {
cb7301c7
JP
328 die "$P: The current directory does not appear to be "
329 . "a linux kernel source tree.\n";
330}
331
332## Read MAINTAINERS for type/value pairs
333
334my @typevalue = ();
dcf36a92 335my %keyword_hash;
6f7d98ec 336my @mfiles = ();
083bf9c5 337my @self_test_info = ();
dcf36a92 338
6f7d98ec
JP
339sub read_maintainer_file {
340 my ($file) = @_;
341
342 open (my $maint, '<', "$file")
343 or die "$P: Can't open MAINTAINERS file '$file': $!\n";
e1f75904 344 my $i = 1;
6f7d98ec
JP
345 while (<$maint>) {
346 my $line = $_;
083bf9c5 347 chomp $line;
6f7d98ec
JP
348
349 if ($line =~ m/^([A-Z]):\s*(.*)/) {
350 my $type = $1;
351 my $value = $2;
352
353 ##Filename pattern matching
354 if ($type eq "F" || $type eq "X") {
355 $value =~ s@\.@\\\.@g; ##Convert . to \.
356 $value =~ s/\*/\.\*/g; ##Convert * to .*
357 $value =~ s/\?/\./g; ##Convert ? to .
358 ##if pattern is a directory and it lacks a trailing slash, add one
359 if ((-d $value)) {
360 $value =~ s@([^/])$@$1/@;
361 }
362 } elsif ($type eq "K") {
363 $keyword_hash{@typevalue} = $value;
870020f9 364 }
6f7d98ec
JP
365 push(@typevalue, "$type:$value");
366 } elsif (!(/^\s*$/ || /^\s*\#/)) {
6f7d98ec 367 push(@typevalue, $line);
cb7301c7 368 }
083bf9c5
JP
369 if (defined $self_test) {
370 push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
371 }
e1f75904 372 $i++;
6f7d98ec
JP
373 }
374 close($maint);
375}
376
377sub find_is_maintainer_file {
378 my ($file) = $_;
379 return if ($file !~ m@/MAINTAINERS$@);
380 $file = $File::Find::name;
381 return if (! -f $file);
382 push(@mfiles, $file);
383}
384
385sub find_ignore_git {
386 return grep { $_ !~ /^\.git$/; } @_;
387}
388
e1f75904
TS
389read_all_maintainer_files();
390
391sub read_all_maintainer_files {
5f0baf95
JP
392 my $path = "${lk_path}MAINTAINERS";
393 if (defined $maintainer_path) {
394 $path = $maintainer_path;
395 # Perl Cookbook tilde expansion if necessary
396 $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
cb7301c7 397 }
cb7301c7 398
5f0baf95
JP
399 if (-d $path) {
400 $path .= '/' if ($path !~ m@/$@);
0fbd75fd
JP
401 if ($find_maintainer_files) {
402 find( { wanted => \&find_is_maintainer_file,
403 preprocess => \&find_ignore_git,
404 no_chdir => 1,
405 }, "$path");
406 } else {
5f0baf95
JP
407 opendir(DIR, "$path") or die $!;
408 my @files = readdir(DIR);
409 closedir(DIR);
410 foreach my $file (@files) {
411 push(@mfiles, "$path$file") if ($file !~ /^\./);
412 }
413 }
5f0baf95
JP
414 } elsif (-f "$path") {
415 push(@mfiles, "$path");
e1f75904 416 } else {
5f0baf95 417 die "$P: MAINTAINER file not found '$path'\n";
e1f75904 418 }
5f0baf95 419 die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
e1f75904 420 foreach my $file (@mfiles) {
5f0baf95 421 read_maintainer_file("$file");
e1f75904 422 }
6f7d98ec 423}
8cbb3a77 424
7fa8ff2e
FM
425#
426# Read mail address map
427#
428
b9e2331d
JP
429my $mailmap;
430
431read_mailmap();
7fa8ff2e
FM
432
433sub read_mailmap {
b9e2331d 434 $mailmap = {
7fa8ff2e
FM
435 names => {},
436 addresses => {}
47abc722 437 };
7fa8ff2e 438
b9e2331d 439 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
7fa8ff2e
FM
440
441 open(my $mailmap_file, '<', "${lk_path}.mailmap")
22dd5b0c 442 or warn "$P: Can't open .mailmap: $!\n";
8cbb3a77 443
7fa8ff2e
FM
444 while (<$mailmap_file>) {
445 s/#.*$//; #strip comments
446 s/^\s+|\s+$//g; #trim
8cbb3a77 447
7fa8ff2e
FM
448 next if (/^\s*$/); #skip empty lines
449 #entries have one of the following formats:
450 # name1 <mail1>
451 # <mail1> <mail2>
452 # name1 <mail1> <mail2>
453 # name1 <mail1> name2 <mail2>
454 # (see man git-shortlog)
0334b382
JP
455
456 if (/^([^<]+)<([^>]+)>$/) {
47abc722
JP
457 my $real_name = $1;
458 my $address = $2;
8cbb3a77 459
47abc722 460 $real_name =~ s/\s+$//;
b9e2331d 461 ($real_name, $address) = parse_email("$real_name <$address>");
47abc722 462 $mailmap->{names}->{$address} = $real_name;
8cbb3a77 463
0334b382 464 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
47abc722
JP
465 my $real_address = $1;
466 my $wrong_address = $2;
7fa8ff2e 467
47abc722 468 $mailmap->{addresses}->{$wrong_address} = $real_address;
7fa8ff2e 469
0334b382 470 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
b9e2331d 471 my $real_name = $1;
47abc722
JP
472 my $real_address = $2;
473 my $wrong_address = $3;
7fa8ff2e 474
47abc722 475 $real_name =~ s/\s+$//;
b9e2331d
JP
476 ($real_name, $real_address) =
477 parse_email("$real_name <$real_address>");
47abc722
JP
478 $mailmap->{names}->{$wrong_address} = $real_name;
479 $mailmap->{addresses}->{$wrong_address} = $real_address;
7fa8ff2e 480
0334b382 481 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
47abc722
JP
482 my $real_name = $1;
483 my $real_address = $2;
484 my $wrong_name = $3;
485 my $wrong_address = $4;
7fa8ff2e 486
47abc722 487 $real_name =~ s/\s+$//;
b9e2331d
JP
488 ($real_name, $real_address) =
489 parse_email("$real_name <$real_address>");
490
47abc722 491 $wrong_name =~ s/\s+$//;
b9e2331d
JP
492 ($wrong_name, $wrong_address) =
493 parse_email("$wrong_name <$wrong_address>");
7fa8ff2e 494
b9e2331d
JP
495 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
496 $mailmap->{names}->{$wrong_email} = $real_name;
497 $mailmap->{addresses}->{$wrong_email} = $real_address;
11ecf53c 498 }
8cbb3a77 499 }
7fa8ff2e 500 close($mailmap_file);
8cbb3a77
JP
501}
502
4a7fdb5f 503## use the filenames on the command line or find the filenames in the patchfiles
cb7301c7
JP
504
505my @files = ();
f5492666 506my @range = ();
dcf36a92 507my @keyword_tvi = ();
03372dbb 508my @file_emails = ();
cb7301c7 509
64f77f31
JP
510if (!@ARGV) {
511 push(@ARGV, "&STDIN");
512}
513
4a7fdb5f 514foreach my $file (@ARGV) {
64f77f31
JP
515 if ($file ne "&STDIN") {
516 ##if $file is a directory and it lacks a trailing slash, add one
517 if ((-d $file)) {
518 $file =~ s@([^/])$@$1/@;
519 } elsif (!(-f $file)) {
520 die "$P: file '${file}' not found\n";
521 }
cb7301c7 522 }
aec742e8 523 if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
be17bddc
JP
524 $file =~ s/^\Q${cur_path}\E//; #strip any absolute path
525 $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree
4a7fdb5f 526 push(@files, $file);
fab9ed12 527 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
22dd5b0c
SH
528 open(my $f, '<', $file)
529 or die "$P: Can't open $file: $!\n";
530 my $text = do { local($/) ; <$f> };
531 close($f);
03372dbb
JP
532 if ($keywords) {
533 foreach my $line (keys %keyword_hash) {
534 if ($text =~ m/$keyword_hash{$line}/x) {
535 push(@keyword_tvi, $line);
536 }
dcf36a92
JP
537 }
538 }
03372dbb
JP
539 if ($file_emails) {
540 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;
541 push(@file_emails, clean_file_emails(@poss_addr));
542 }
dcf36a92 543 }
4a7fdb5f
JP
544 } else {
545 my $file_cnt = @files;
f5492666 546 my $lastfile;
22dd5b0c 547
3a4df13d 548 open(my $patch, "< $file")
22dd5b0c 549 or die "$P: Can't open $file: $!\n";
7764dcb5
JP
550
551 # We can check arbitrary information before the patch
552 # like the commit message, mail headers, etc...
553 # This allows us to match arbitrary keywords against any part
554 # of a git format-patch generated file (subject tags, etc...)
555
556 my $patch_prefix = ""; #Parsing the intro
557
22dd5b0c 558 while (<$patch>) {
dcf36a92 559 my $patch_line = $_;
0455c747
JP
560 if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
561 my $filename = $1;
562 push(@files, $filename);
563 } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
564 my $filename = $1;
565 push(@files, $filename);
566 } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
567 my $filename1 = $1;
568 my $filename2 = $2;
569 push(@files, $filename1);
570 push(@files, $filename2);
571 } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
4a7fdb5f
JP
572 my $filename = $1;
573 $filename =~ s@^[^/]*/@@;
574 $filename =~ s@\n@@;
f5492666 575 $lastfile = $filename;
4a7fdb5f 576 push(@files, $filename);
7764dcb5 577 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
f5492666
JP
578 } elsif (m/^\@\@ -(\d+),(\d+)/) {
579 if ($email_git_blame) {
580 push(@range, "$lastfile:$1:$2");
581 }
dcf36a92
JP
582 } elsif ($keywords) {
583 foreach my $line (keys %keyword_hash) {
7764dcb5 584 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
dcf36a92
JP
585 push(@keyword_tvi, $line);
586 }
587 }
4a7fdb5f 588 }
cb7301c7 589 }
22dd5b0c
SH
590 close($patch);
591
4a7fdb5f 592 if ($file_cnt == @files) {
7f29fd27 593 warn "$P: file '${file}' doesn't appear to be a patch. "
4a7fdb5f
JP
594 . "Add -f to options?\n";
595 }
596 @files = sort_and_uniq(@files);
cb7301c7 597 }
cb7301c7
JP
598}
599
03372dbb
JP
600@file_emails = uniq(@file_emails);
601
683c6f8f
JP
602my %email_hash_name;
603my %email_hash_address;
cb7301c7 604my @email_to = ();
683c6f8f 605my %hash_list_to;
290603c1 606my @list_to = ();
cb7301c7
JP
607my @scm = ();
608my @web = ();
609my @subsystem = ();
610my @status = ();
b9e2331d
JP
611my %deduplicate_name_hash = ();
612my %deduplicate_address_hash = ();
cb7301c7 613
6ef1c52e 614my @maintainers = get_maintainers();
cb7301c7 615
6ef1c52e
JP
616if (@maintainers) {
617 @maintainers = merge_email(@maintainers);
618 output(@maintainers);
619}
683c6f8f
JP
620
621if ($scm) {
622 @scm = uniq(@scm);
623 output(@scm);
624}
625
626if ($status) {
627 @status = uniq(@status);
628 output(@status);
629}
630
631if ($subsystem) {
632 @subsystem = uniq(@subsystem);
633 output(@subsystem);
634}
635
636if ($web) {
637 @web = uniq(@web);
638 output(@web);
639}
640
641exit($exit);
642
083bf9c5 643sub self_test {
e1f75904 644 my @lsfiles = ();
083bf9c5
JP
645 my @good_links = ();
646 my @bad_links = ();
647 my @section_headers = ();
648 my $index = 0;
e1f75904
TS
649
650 @lsfiles = vcs_list_files($lk_path);
651
083bf9c5
JP
652 for my $x (@self_test_info) {
653 $index++;
654
655 ## Section header duplication and missing section content
656 if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
657 $x->{line} =~ /^\S[^:]/ &&
658 defined $self_test_info[$index] &&
659 $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
660 my $has_S = 0;
661 my $has_F = 0;
662 my $has_ML = 0;
663 my $status = "";
664 if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
665 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
666 } else {
667 push(@section_headers, $x->{line});
668 }
669 my $nextline = $index;
670 while (defined $self_test_info[$nextline] &&
671 $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
672 my $type = $1;
673 my $value = $2;
674 if ($type eq "S") {
675 $has_S = 1;
676 $status = $value;
677 } elsif ($type eq "F" || $type eq "N") {
678 $has_F = 1;
679 } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
680 $has_ML = 1;
681 }
682 $nextline++;
683 }
684 if (!$has_ML && $status !~ /orphan|obsolete/i) {
685 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
686 }
687 if (!$has_S) {
688 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
689 }
690 if (!$has_F) {
691 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
692 }
693 }
694
695 next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
696
697 my $type = $1;
698 my $value = $2;
699
700 ## Filename pattern matching
701 if (($type eq "F" || $type eq "X") &&
702 ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
703 $value =~ s@\.@\\\.@g; ##Convert . to \.
704 $value =~ s/\*/\.\*/g; ##Convert * to .*
705 $value =~ s/\?/\./g; ##Convert ? to .
706 ##if pattern is a directory and it lacks a trailing slash, add one
707 if ((-d $value)) {
708 $value =~ s@([^/])$@$1/@;
709 }
710 if (!grep(m@^$value@, @lsfiles)) {
711 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
712 }
713
714 ## Link reachability
715 } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
716 $value =~ /^https?:/ &&
717 ($self_test eq "" || $self_test =~ /\blinks\b/)) {
718 next if (grep(m@^\Q$value\E$@, @good_links));
719 my $isbad = 0;
720 if (grep(m@^\Q$value\E$@, @bad_links)) {
721 $isbad = 1;
722 } else {
723 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
724 if ($? == 0) {
725 push(@good_links, $value);
726 } else {
727 push(@bad_links, $value);
728 $isbad = 1;
729 }
730 }
731 if ($isbad) {
732 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
733 }
734
735 ## SCM reachability
736 } elsif ($type eq "T" &&
737 ($self_test eq "" || $self_test =~ /\bscm\b/)) {
738 next if (grep(m@^\Q$value\E$@, @good_links));
739 my $isbad = 0;
740 if (grep(m@^\Q$value\E$@, @bad_links)) {
741 $isbad = 1;
742 } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
743 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
744 } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
745 my $url = $1;
746 my $branch = "";
747 $branch = $3 if $3;
748 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
749 if ($? == 0) {
750 push(@good_links, $value);
751 } else {
752 push(@bad_links, $value);
753 $isbad = 1;
754 }
755 } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
756 my $url = $1;
757 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
758 if ($? == 0) {
759 push(@good_links, $value);
760 } else {
761 push(@bad_links, $value);
762 $isbad = 1;
763 }
764 }
765 if ($isbad) {
766 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
767 }
768 }
e1f75904
TS
769 }
770}
771
435de078
JP
772sub ignore_email_address {
773 my ($address) = @_;
774
775 foreach my $ignore (@ignore_emails) {
776 return 1 if ($ignore eq $address);
777 }
778
779 return 0;
780}
781
ab6c937d
JP
782sub range_is_maintained {
783 my ($start, $end) = @_;
784
785 for (my $i = $start; $i < $end; $i++) {
786 my $line = $typevalue[$i];
ce8155f7 787 if ($line =~ m/^([A-Z]):\s*(.*)/) {
ab6c937d
JP
788 my $type = $1;
789 my $value = $2;
790 if ($type eq 'S') {
791 if ($value =~ /(maintain|support)/i) {
792 return 1;
793 }
794 }
795 }
796 }
797 return 0;
798}
799
800sub range_has_maintainer {
801 my ($start, $end) = @_;
802
803 for (my $i = $start; $i < $end; $i++) {
804 my $line = $typevalue[$i];
ce8155f7 805 if ($line =~ m/^([A-Z]):\s*(.*)/) {
ab6c937d
JP
806 my $type = $1;
807 my $value = $2;
808 if ($type eq 'M') {
809 return 1;
810 }
811 }
812 }
813 return 0;
814}
815
6ef1c52e 816sub get_maintainers {
683c6f8f
JP
817 %email_hash_name = ();
818 %email_hash_address = ();
819 %commit_author_hash = ();
820 %commit_signer_hash = ();
821 @email_to = ();
822 %hash_list_to = ();
823 @list_to = ();
824 @scm = ();
825 @web = ();
826 @subsystem = ();
827 @status = ();
b9e2331d
JP
828 %deduplicate_name_hash = ();
829 %deduplicate_address_hash = ();
683c6f8f
JP
830 if ($email_git_all_signature_types) {
831 $signature_pattern = "(.+?)[Bb][Yy]:";
832 } else {
833 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
834 }
835
836 # Find responsible parties
837
b9e2331d 838 my %exact_pattern_match_hash = ();
6ef1c52e 839
683c6f8f
JP
840 foreach my $file (@files) {
841
842 my %hash;
683c6f8f
JP
843 my $tvi = find_first_section();
844 while ($tvi < @typevalue) {
845 my $start = find_starting_index($tvi);
846 my $end = find_ending_index($tvi);
847 my $exclude = 0;
848 my $i;
849
850 #Do not match excluded file patterns
272a8979 851
272a8979
JP
852 for ($i = $start; $i < $end; $i++) {
853 my $line = $typevalue[$i];
ce8155f7 854 if ($line =~ m/^([A-Z]):\s*(.*)/) {
272a8979
JP
855 my $type = $1;
856 my $value = $2;
683c6f8f 857 if ($type eq 'X') {
272a8979 858 if (file_match_pattern($file, $value)) {
683c6f8f
JP
859 $exclude = 1;
860 last;
861 }
862 }
863 }
864 }
865
866 if (!$exclude) {
867 for ($i = $start; $i < $end; $i++) {
868 my $line = $typevalue[$i];
ce8155f7 869 if ($line =~ m/^([A-Z]):\s*(.*)/) {
683c6f8f
JP
870 my $type = $1;
871 my $value = $2;
872 if ($type eq 'F') {
873 if (file_match_pattern($file, $value)) {
874 my $value_pd = ($value =~ tr@/@@);
875 my $file_pd = ($file =~ tr@/@@);
876 $value_pd++ if (substr($value,-1,1) ne "/");
877 $value_pd = -1 if ($value =~ /^\.\*/);
ab6c937d
JP
878 if ($value_pd >= $file_pd &&
879 range_is_maintained($start, $end) &&
880 range_has_maintainer($start, $end)) {
6ef1c52e
JP
881 $exact_pattern_match_hash{$file} = 1;
882 }
683c6f8f
JP
883 if ($pattern_depth == 0 ||
884 (($file_pd - $value_pd) < $pattern_depth)) {
885 $hash{$tvi} = $value_pd;
886 }
272a8979 887 }
bbbe96ed 888 } elsif ($type eq 'N') {
eb90d085
SW
889 if ($file =~ m/$value/x) {
890 $hash{$tvi} = 0;
891 }
272a8979
JP
892 }
893 }
894 }
895 }
683c6f8f 896 $tvi = $end + 1;
1d606b4e 897 }
272a8979 898
683c6f8f
JP
899 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
900 add_categories($line);
901 if ($sections) {
902 my $i;
903 my $start = find_starting_index($line);
904 my $end = find_ending_index($line);
905 for ($i = $start; $i < $end; $i++) {
906 my $line = $typevalue[$i];
907 if ($line =~ /^[FX]:/) { ##Restore file patterns
908 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
909 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
910 $line =~ s/\\\./\./g; ##Convert \. to .
911 $line =~ s/\.\*/\*/g; ##Convert .* to *
912 }
03aed214
JP
913 my $count = $line =~ s/^([A-Z]):/$1:\t/g;
914 if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
915 print("$line\n");
916 }
4b76c9da 917 }
683c6f8f 918 print("\n");
4b76c9da 919 }
6ffd9485 920 }
dace8e30 921 }
cb7301c7 922
683c6f8f
JP
923 if ($keywords) {
924 @keyword_tvi = sort_and_uniq(@keyword_tvi);
925 foreach my $line (@keyword_tvi) {
926 add_categories($line);
927 }
dcf36a92 928 }
dcf36a92 929
b9e2331d
JP
930 foreach my $email (@email_to, @list_to) {
931 $email->[0] = deduplicate_email($email->[0]);
932 }
6ef1c52e
JP
933
934 foreach my $file (@files) {
935 if ($email &&
936 ($email_git || ($email_git_fallback &&
937 !$exact_pattern_match_hash{$file}))) {
938 vcs_file_signoffs($file);
939 }
940 if ($email && $email_git_blame) {
941 vcs_file_blame($file);
942 }
943 }
944
683c6f8f
JP
945 if ($email) {
946 foreach my $chief (@penguin_chief) {
947 if ($chief =~ m/^(.*):(.*)/) {
948 my $email_address;
0e70e83d 949
683c6f8f
JP
950 $email_address = format_email($1, $2, $email_usename);
951 if ($email_git_penguin_chiefs) {
952 push(@email_to, [$email_address, 'chief penguin']);
953 } else {
954 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
955 }
cb7301c7
JP
956 }
957 }
03372dbb 958
683c6f8f
JP
959 foreach my $email (@file_emails) {
960 my ($name, $address) = parse_email($email);
03372dbb 961
683c6f8f
JP
962 my $tmp_email = format_email($name, $address, $email_usename);
963 push_email_address($tmp_email, '');
964 add_role($tmp_email, 'in file');
965 }
03372dbb 966 }
cb7301c7 967
290603c1 968 my @to = ();
683c6f8f
JP
969 if ($email || $email_list) {
970 if ($email) {
971 @to = (@to, @email_to);
972 }
973 if ($email_list) {
974 @to = (@to, @list_to);
dace8e30 975 }
290603c1 976 }
cb7301c7 977
6ef1c52e 978 if ($interactive) {
b9e2331d 979 @to = interactive_get_maintainers(\@to);
6ef1c52e 980 }
cb7301c7 981
683c6f8f 982 return @to;
cb7301c7
JP
983}
984
cb7301c7
JP
985sub file_match_pattern {
986 my ($file, $pattern) = @_;
987 if (substr($pattern, -1) eq "/") {
988 if ($file =~ m@^$pattern@) {
989 return 1;
990 }
991 } else {
992 if ($file =~ m@^$pattern@) {
993 my $s1 = ($file =~ tr@/@@);
994 my $s2 = ($pattern =~ tr@/@@);
995 if ($s1 == $s2) {
996 return 1;
997 }
998 }
999 }
1000 return 0;
1001}
1002
1003sub usage {
1004 print <<EOT;
1005usage: $P [options] patchfile
870020f9 1006 $P [options] -f file|directory
cb7301c7
JP
1007version: $V
1008
1009MAINTAINER field selection options:
1010 --email => print email address(es) if any
1011 --git => include recent git \*-by: signers
e4d26b02 1012 --git-all-signature-types => include signers regardless of signature type
683c6f8f 1013 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
e3e9d114 1014 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
cb7301c7 1015 --git-chief-penguins => include ${penguin_chiefs}
e4d26b02
JP
1016 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1017 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1018 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
f5492666 1019 --git-blame => use git blame to find modified commits for patch or file
3cbcca8a 1020 --git-blame-signatures => when used with --git-blame, also include all commit signers
e4d26b02
JP
1021 --git-since => git history to use (default: $email_git_since)
1022 --hg-since => hg history to use (default: $email_hg_since)
dace8e30 1023 --interactive => display a menu (mostly useful if used with the --git option)
cb7301c7 1024 --m => include maintainer(s) if any
c1c3f2c9 1025 --r => include reviewer(s) if any
cb7301c7
JP
1026 --n => include name 'Full Name <addr\@domain.tld>'
1027 --l => include list(s) if any
49662503
JP
1028 --moderated => include moderated lists(s) if any (default: true)
1029 --s => include subscriber only list(s) if any (default: false)
11ecf53c 1030 --remove-duplicates => minimize duplicate email names/addresses
3c7385b8
JP
1031 --roles => show roles (status:subsystem, git-signer, list, etc...)
1032 --rolestats => show roles and statistics (commits/total_commits, %)
03372dbb 1033 --file-emails => add email addresses found in -f file (default: 0 (off))
cb7301c7
JP
1034 --scm => print SCM tree(s) if any
1035 --status => print status if any
1036 --subsystem => print subsystem name if any
1037 --web => print website(s) if any
1038
1039Output type options:
1040 --separator [, ] => separator for multiple entries on 1 line
42498316 1041 using --separator also sets --nomultiline if --separator is not [, ]
cb7301c7
JP
1042 --multiline => print 1 entry per line
1043
cb7301c7 1044Other options:
3fb55652 1045 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
b9e2331d
JP
1046 --keywords => scan patch for keywords (default: $keywords)
1047 --sections => print all of the subsystem sections with pattern matches
03aed214 1048 --letters => print all matching 'letter' types from all matching sections
b9e2331d 1049 --mailmap => use .mailmap file (default: $email_use_mailmap)
31bb82c9 1050 --no-tree => run without a kernel tree
e1f75904 1051 --self-test => show potential issues with MAINTAINERS file content
f5f5078d 1052 --version => show version
cb7301c7
JP
1053 --help => show this help information
1054
3fb55652 1055Default options:
31bb82c9
AND
1056 [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1057 --pattern-depth=0 --remove-duplicates --rolestats]
3fb55652 1058
870020f9
JP
1059Notes:
1060 Using "-f directory" may give unexpected results:
f5492666
JP
1061 Used with "--git", git signators for _all_ files in and below
1062 directory are examined as git recurses directories.
1063 Any specified X: (exclude) pattern matches are _not_ ignored.
1064 Used with "--nogit", directory is used as a pattern match,
60db31ac
JP
1065 no individual file within the directory or subdirectory
1066 is matched.
f5492666
JP
1067 Used with "--git-blame", does not iterate all files in directory
1068 Using "--git-blame" is slow and may add old committers and authors
1069 that are no longer active maintainers to the output.
3c7385b8
JP
1070 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1071 other automated tools that expect only ["name"] <email address>
1072 may not work because of additional output after <email address>.
1073 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1074 not the percentage of the entire file authored. # of commits is
1075 not a good measure of amount of code authored. 1 major commit may
1076 contain a thousand lines, 5 trivial commits may modify a single line.
60db31ac
JP
1077 If git is not installed, but mercurial (hg) is installed and an .hg
1078 repository exists, the following options apply to mercurial:
1079 --git,
1080 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1081 --git-blame
1082 Use --hg-since not --git-since to control date selection
368669da
JP
1083 File ".get_maintainer.conf", if it exists in the linux kernel source root
1084 directory, can change whatever get_maintainer defaults are desired.
1085 Entries in this file can be any command line argument.
1086 This file is prepended to any additional command line arguments.
1087 Multiple lines and # comments are allowed.
b1312bfe
BN
1088 Most options have both positive and negative forms.
1089 The negative forms for --<foo> are --no<foo> and --no-<foo>.
1090
cb7301c7
JP
1091EOT
1092}
1093
1094sub top_of_kernel_tree {
47abc722 1095 my ($lk_path) = @_;
cb7301c7 1096
47abc722
JP
1097 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1098 $lk_path .= "/";
1099 }
1100 if ( (-f "${lk_path}COPYING")
1101 && (-f "${lk_path}CREDITS")
1102 && (-f "${lk_path}Kbuild")
6f7d98ec 1103 && (-e "${lk_path}MAINTAINERS")
47abc722
JP
1104 && (-f "${lk_path}Makefile")
1105 && (-f "${lk_path}README")
1106 && (-d "${lk_path}Documentation")
1107 && (-d "${lk_path}arch")
1108 && (-d "${lk_path}include")
1109 && (-d "${lk_path}drivers")
1110 && (-d "${lk_path}fs")
1111 && (-d "${lk_path}init")
1112 && (-d "${lk_path}ipc")
1113 && (-d "${lk_path}kernel")
1114 && (-d "${lk_path}lib")
1115 && (-d "${lk_path}scripts")) {
1116 return 1;
1117 }
1118 return 0;
cb7301c7
JP
1119}
1120
0e70e83d
JP
1121sub parse_email {
1122 my ($formatted_email) = @_;
1123
1124 my $name = "";
1125 my $address = "";
1126
11ecf53c 1127 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
0e70e83d
JP
1128 $name = $1;
1129 $address = $2;
11ecf53c 1130 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
0e70e83d 1131 $address = $1;
b781655a 1132 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
0e70e83d
JP
1133 $address = $1;
1134 }
cb7301c7
JP
1135
1136 $name =~ s/^\s+|\s+$//g;
d789504a 1137 $name =~ s/^\"|\"$//g;
0e70e83d 1138 $address =~ s/^\s+|\s+$//g;
cb7301c7 1139
a63ceb4c 1140 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
0e70e83d
JP
1141 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
1142 $name = "\"$name\"";
1143 }
1144
1145 return ($name, $address);
1146}
1147
1148sub format_email {
a8af2430 1149 my ($name, $address, $usename) = @_;
0e70e83d
JP
1150
1151 my $formatted_email;
1152
1153 $name =~ s/^\s+|\s+$//g;
1154 $name =~ s/^\"|\"$//g;
1155 $address =~ s/^\s+|\s+$//g;
cb7301c7 1156
a63ceb4c 1157 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
cb7301c7 1158 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
0e70e83d
JP
1159 $name = "\"$name\"";
1160 }
1161
a8af2430 1162 if ($usename) {
0e70e83d
JP
1163 if ("$name" eq "") {
1164 $formatted_email = "$address";
1165 } else {
a8af2430 1166 $formatted_email = "$name <$address>";
0e70e83d 1167 }
cb7301c7 1168 } else {
0e70e83d 1169 $formatted_email = $address;
cb7301c7 1170 }
0e70e83d 1171
cb7301c7
JP
1172 return $formatted_email;
1173}
1174
272a8979
JP
1175sub find_first_section {
1176 my $index = 0;
1177
1178 while ($index < @typevalue) {
1179 my $tv = $typevalue[$index];
ce8155f7 1180 if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
272a8979
JP
1181 last;
1182 }
1183 $index++;
1184 }
1185
1186 return $index;
1187}
1188
b781655a 1189sub find_starting_index {
b781655a
JP
1190 my ($index) = @_;
1191
1192 while ($index > 0) {
1193 my $tv = $typevalue[$index];
ce8155f7 1194 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
b781655a
JP
1195 last;
1196 }
1197 $index--;
1198 }
1199
1200 return $index;
1201}
1202
1203sub find_ending_index {
cb7301c7
JP
1204 my ($index) = @_;
1205
b781655a 1206 while ($index < @typevalue) {
cb7301c7 1207 my $tv = $typevalue[$index];
ce8155f7 1208 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
b781655a
JP
1209 last;
1210 }
1211 $index++;
1212 }
1213
1214 return $index;
1215}
1216
2a7cb1dc 1217sub get_subsystem_name {
3c7385b8
JP
1218 my ($index) = @_;
1219
3c7385b8 1220 my $start = find_starting_index($index);
3c7385b8 1221
3c7385b8 1222 my $subsystem = $typevalue[$start];
364f68dc
JP
1223 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1224 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
3c7385b8
JP
1225 $subsystem =~ s/\s*$//;
1226 $subsystem = $subsystem . "...";
1227 }
2a7cb1dc
JP
1228 return $subsystem;
1229}
1230
1231sub get_maintainer_role {
1232 my ($index) = @_;
1233
1234 my $i;
1235 my $start = find_starting_index($index);
1236 my $end = find_ending_index($index);
1237
1238 my $role = "unknown";
1239 my $subsystem = get_subsystem_name($index);
3c7385b8
JP
1240
1241 for ($i = $start + 1; $i < $end; $i++) {
1242 my $tv = $typevalue[$i];
ce8155f7 1243 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
3c7385b8
JP
1244 my $ptype = $1;
1245 my $pvalue = $2;
1246 if ($ptype eq "S") {
1247 $role = $pvalue;
1248 }
1249 }
1250 }
1251
1252 $role = lc($role);
1253 if ($role eq "supported") {
1254 $role = "supporter";
1255 } elsif ($role eq "maintained") {
1256 $role = "maintainer";
1257 } elsif ($role eq "odd fixes") {
1258 $role = "odd fixer";
1259 } elsif ($role eq "orphan") {
1260 $role = "orphan minder";
1261 } elsif ($role eq "obsolete") {
1262 $role = "obsolete minder";
1263 } elsif ($role eq "buried alive in reporters") {
1264 $role = "chief penguin";
1265 }
1266
1267 return $role . ":" . $subsystem;
1268}
1269
1270sub get_list_role {
1271 my ($index) = @_;
1272
2a7cb1dc 1273 my $subsystem = get_subsystem_name($index);
3c7385b8
JP
1274
1275 if ($subsystem eq "THE REST") {
1276 $subsystem = "";
1277 }
1278
1279 return $subsystem;
1280}
1281
b781655a
JP
1282sub add_categories {
1283 my ($index) = @_;
1284
1285 my $i;
1286 my $start = find_starting_index($index);
1287 my $end = find_ending_index($index);
1288
1289 push(@subsystem, $typevalue[$start]);
1290
1291 for ($i = $start + 1; $i < $end; $i++) {
1292 my $tv = $typevalue[$i];
ce8155f7 1293 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
cb7301c7
JP
1294 my $ptype = $1;
1295 my $pvalue = $2;
1296 if ($ptype eq "L") {
290603c1
JP
1297 my $list_address = $pvalue;
1298 my $list_additional = "";
3c7385b8
JP
1299 my $list_role = get_list_role($i);
1300
1301 if ($list_role ne "") {
1302 $list_role = ":" . $list_role;
1303 }
290603c1
JP
1304 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1305 $list_address = $1;
1306 $list_additional = $2;
1307 }
bdf7c685 1308 if ($list_additional =~ m/subscribers-only/) {
cb7301c7 1309 if ($email_subscriber_list) {
6ef1c52e
JP
1310 if (!$hash_list_to{lc($list_address)}) {
1311 $hash_list_to{lc($list_address)} = 1;
683c6f8f
JP
1312 push(@list_to, [$list_address,
1313 "subscriber list${list_role}"]);
1314 }
cb7301c7
JP
1315 }
1316 } else {
1317 if ($email_list) {
6ef1c52e 1318 if (!$hash_list_to{lc($list_address)}) {
728f5a94 1319 if ($list_additional =~ m/moderated/) {
49662503
JP
1320 if ($email_moderated_list) {
1321 $hash_list_to{lc($list_address)} = 1;
1322 push(@list_to, [$list_address,
1323 "moderated list${list_role}"]);
1324 }
728f5a94 1325 } else {
49662503 1326 $hash_list_to{lc($list_address)} = 1;
728f5a94
RW
1327 push(@list_to, [$list_address,
1328 "open list${list_role}"]);
1329 }
683c6f8f 1330 }
cb7301c7
JP
1331 }
1332 }
1333 } elsif ($ptype eq "M") {
0e70e83d
JP
1334 my ($name, $address) = parse_email($pvalue);
1335 if ($name eq "") {
b781655a
JP
1336 if ($i > 0) {
1337 my $tv = $typevalue[$i - 1];
ce8155f7 1338 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
0e70e83d
JP
1339 if ($1 eq "P") {
1340 $name = $2;
a8af2430 1341 $pvalue = format_email($name, $address, $email_usename);
5f2441e9
JP
1342 }
1343 }
1344 }
1345 }
0e70e83d 1346 if ($email_maintainer) {
3c7385b8
JP
1347 my $role = get_maintainer_role($i);
1348 push_email_addresses($pvalue, $role);
cb7301c7 1349 }
c1c3f2c9
JP
1350 } elsif ($ptype eq "R") {
1351 my ($name, $address) = parse_email($pvalue);
1352 if ($name eq "") {
1353 if ($i > 0) {
1354 my $tv = $typevalue[$i - 1];
ce8155f7 1355 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
c1c3f2c9
JP
1356 if ($1 eq "P") {
1357 $name = $2;
1358 $pvalue = format_email($name, $address, $email_usename);
1359 }
1360 }
1361 }
1362 }
1363 if ($email_reviewer) {
2a7cb1dc
JP
1364 my $subsystem = get_subsystem_name($i);
1365 push_email_addresses($pvalue, "reviewer:$subsystem");
c1c3f2c9 1366 }
cb7301c7
JP
1367 } elsif ($ptype eq "T") {
1368 push(@scm, $pvalue);
1369 } elsif ($ptype eq "W") {
1370 push(@web, $pvalue);
1371 } elsif ($ptype eq "S") {
1372 push(@status, $pvalue);
1373 }
cb7301c7
JP
1374 }
1375 }
1376}
1377
11ecf53c
JP
1378sub email_inuse {
1379 my ($name, $address) = @_;
1380
1381 return 1 if (($name eq "") && ($address eq ""));
6ef1c52e
JP
1382 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1383 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
0e70e83d 1384
0e70e83d
JP
1385 return 0;
1386}
1387
1b5e1cf6 1388sub push_email_address {
3c7385b8 1389 my ($line, $role) = @_;
1b5e1cf6 1390
0e70e83d 1391 my ($name, $address) = parse_email($line);
1b5e1cf6 1392
b781655a
JP
1393 if ($address eq "") {
1394 return 0;
1395 }
1396
11ecf53c 1397 if (!$email_remove_duplicates) {
a8af2430 1398 push(@email_to, [format_email($name, $address, $email_usename), $role]);
11ecf53c 1399 } elsif (!email_inuse($name, $address)) {
a8af2430 1400 push(@email_to, [format_email($name, $address, $email_usename), $role]);
fae99206 1401 $email_hash_name{lc($name)}++ if ($name ne "");
6ef1c52e 1402 $email_hash_address{lc($address)}++;
1b5e1cf6 1403 }
b781655a
JP
1404
1405 return 1;
1b5e1cf6
JP
1406}
1407
1408sub push_email_addresses {
3c7385b8 1409 my ($address, $role) = @_;
1b5e1cf6
JP
1410
1411 my @address_list = ();
1412
5f2441e9 1413 if (rfc822_valid($address)) {
3c7385b8 1414 push_email_address($address, $role);
5f2441e9 1415 } elsif (@address_list = rfc822_validlist($address)) {
1b5e1cf6
JP
1416 my $array_count = shift(@address_list);
1417 while (my $entry = shift(@address_list)) {
3c7385b8 1418 push_email_address($entry, $role);
1b5e1cf6 1419 }
5f2441e9 1420 } else {
3c7385b8 1421 if (!push_email_address($address, $role)) {
b781655a
JP
1422 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1423 }
1b5e1cf6 1424 }
1b5e1cf6
JP
1425}
1426
3c7385b8
JP
1427sub add_role {
1428 my ($line, $role) = @_;
1429
1430 my ($name, $address) = parse_email($line);
a8af2430 1431 my $email = format_email($name, $address, $email_usename);
3c7385b8
JP
1432
1433 foreach my $entry (@email_to) {
1434 if ($email_remove_duplicates) {
1435 my ($entry_name, $entry_address) = parse_email($entry->[0]);
03372dbb
JP
1436 if (($name eq $entry_name || $address eq $entry_address)
1437 && ($role eq "" || !($entry->[1] =~ m/$role/))
1438 ) {
3c7385b8
JP
1439 if ($entry->[1] eq "") {
1440 $entry->[1] = "$role";
1441 } else {
1442 $entry->[1] = "$entry->[1],$role";
1443 }
1444 }
1445 } else {
03372dbb
JP
1446 if ($email eq $entry->[0]
1447 && ($role eq "" || !($entry->[1] =~ m/$role/))
1448 ) {
3c7385b8
JP
1449 if ($entry->[1] eq "") {
1450 $entry->[1] = "$role";
1451 } else {
1452 $entry->[1] = "$entry->[1],$role";
1453 }
1454 }
1455 }
1456 }
1457}
1458
cb7301c7
JP
1459sub which {
1460 my ($bin) = @_;
1461
f5f5078d 1462 foreach my $path (split(/:/, $ENV{PATH})) {
cb7301c7
JP
1463 if (-e "$path/$bin") {
1464 return "$path/$bin";
1465 }
1466 }
1467
1468 return "";
1469}
1470
bcde44ed
JP
1471sub which_conf {
1472 my ($conf) = @_;
1473
1474 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1475 if (-e "$path/$conf") {
1476 return "$path/$conf";
1477 }
1478 }
1479
1480 return "";
1481}
1482
7fa8ff2e 1483sub mailmap_email {
b9e2331d 1484 my ($line) = @_;
7fa8ff2e 1485
47abc722
JP
1486 my ($name, $address) = parse_email($line);
1487 my $email = format_email($name, $address, 1);
1488 my $real_name = $name;
1489 my $real_address = $address;
1490
1491 if (exists $mailmap->{names}->{$email} ||
1492 exists $mailmap->{addresses}->{$email}) {
1493 if (exists $mailmap->{names}->{$email}) {
1494 $real_name = $mailmap->{names}->{$email};
1495 }
1496 if (exists $mailmap->{addresses}->{$email}) {
1497 $real_address = $mailmap->{addresses}->{$email};
1498 }
1499 } else {
1500 if (exists $mailmap->{names}->{$address}) {
1501 $real_name = $mailmap->{names}->{$address};
1502 }
1503 if (exists $mailmap->{addresses}->{$address}) {
1504 $real_address = $mailmap->{addresses}->{$address};
8cbb3a77 1505 }
47abc722
JP
1506 }
1507 return format_email($real_name, $real_address, 1);
7fa8ff2e
FM
1508}
1509
1510sub mailmap {
1511 my (@addresses) = @_;
1512
b9e2331d 1513 my @mapped_emails = ();
7fa8ff2e 1514 foreach my $line (@addresses) {
b9e2331d 1515 push(@mapped_emails, mailmap_email($line));
8cbb3a77 1516 }
b9e2331d
JP
1517 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1518 return @mapped_emails;
7fa8ff2e
FM
1519}
1520
1521sub merge_by_realname {
47abc722
JP
1522 my %address_map;
1523 my (@emails) = @_;
b9e2331d 1524
47abc722
JP
1525 foreach my $email (@emails) {
1526 my ($name, $address) = parse_email($email);
b9e2331d 1527 if (exists $address_map{$name}) {
47abc722 1528 $address = $address_map{$name};
b9e2331d
JP
1529 $email = format_email($name, $address, 1);
1530 } else {
1531 $address_map{$name} = $address;
7fa8ff2e 1532 }
47abc722 1533 }
8cbb3a77
JP
1534}
1535
60db31ac
JP
1536sub git_execute_cmd {
1537 my ($cmd) = @_;
1538 my @lines = ();
cb7301c7 1539
60db31ac
JP
1540 my $output = `$cmd`;
1541 $output =~ s/^\s*//gm;
1542 @lines = split("\n", $output);
1543
1544 return @lines;
a8af2430
JP
1545}
1546
60db31ac 1547sub hg_execute_cmd {
a8af2430 1548 my ($cmd) = @_;
60db31ac
JP
1549 my @lines = ();
1550
1551 my $output = `$cmd`;
1552 @lines = split("\n", $output);
a8af2430 1553
60db31ac
JP
1554 return @lines;
1555}
1556
683c6f8f
JP
1557sub extract_formatted_signatures {
1558 my (@signature_lines) = @_;
1559
1560 my @type = @signature_lines;
1561
1562 s/\s*(.*):.*/$1/ for (@type);
1563
1564 # cut -f2- -d":"
1565 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1566
1567## Reformat email addresses (with names) to avoid badly written signatures
1568
1569 foreach my $signer (@signature_lines) {
b9e2331d 1570 $signer = deduplicate_email($signer);
683c6f8f
JP
1571 }
1572
1573 return (\@type, \@signature_lines);
1574}
1575
60db31ac 1576sub vcs_find_signers {
c9ecefea 1577 my ($cmd, $file) = @_;
a8af2430 1578 my $commits;
683c6f8f
JP
1579 my @lines = ();
1580 my @signatures = ();
c9ecefea
JP
1581 my @authors = ();
1582 my @stats = ();
a8af2430 1583
60db31ac 1584 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
cb7301c7 1585
60db31ac 1586 my $pattern = $VCS_cmds{"commit_pattern"};
c9ecefea
JP
1587 my $author_pattern = $VCS_cmds{"author_pattern"};
1588 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1589
1590 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
cb7301c7 1591
60db31ac 1592 $commits = grep(/$pattern/, @lines); # of commits
afa81ee1 1593
c9ecefea 1594 @authors = grep(/$author_pattern/, @lines);
683c6f8f 1595 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
c9ecefea 1596 @stats = grep(/$stat_pattern/, @lines);
63ab52db 1597
c9ecefea
JP
1598# print("stats: <@stats>\n");
1599
1600 return (0, \@signatures, \@authors, \@stats) if !@signatures;
63ab52db 1601
683c6f8f
JP
1602 save_commits_by_author(@lines) if ($interactive);
1603 save_commits_by_signer(@lines) if ($interactive);
0e70e83d 1604
683c6f8f
JP
1605 if (!$email_git_penguin_chiefs) {
1606 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
a8af2430
JP
1607 }
1608
c9ecefea 1609 my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
683c6f8f
JP
1610 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1611
c9ecefea 1612 return ($commits, $signers_ref, $authors_ref, \@stats);
a8af2430
JP
1613}
1614
63ab52db
JP
1615sub vcs_find_author {
1616 my ($cmd) = @_;
1617 my @lines = ();
1618
1619 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1620
1621 if (!$email_git_penguin_chiefs) {
1622 @lines = grep(!/${penguin_chiefs}/i, @lines);
1623 }
1624
1625 return @lines if !@lines;
1626
683c6f8f 1627 my @authors = ();
63ab52db 1628 foreach my $line (@lines) {
683c6f8f
JP
1629 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1630 my $author = $1;
1631 my ($name, $address) = parse_email($author);
1632 $author = format_email($name, $address, 1);
1633 push(@authors, $author);
1634 }
63ab52db
JP
1635 }
1636
683c6f8f
JP
1637 save_commits_by_author(@lines) if ($interactive);
1638 save_commits_by_signer(@lines) if ($interactive);
1639
1640 return @authors;
63ab52db
JP
1641}
1642
60db31ac
JP
1643sub vcs_save_commits {
1644 my ($cmd) = @_;
1645 my @lines = ();
1646 my @commits = ();
1647
1648 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1649
1650 foreach my $line (@lines) {
1651 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1652 push(@commits, $1);
1653 }
1654 }
1655
1656 return @commits;
1657}
1658
1659sub vcs_blame {
1660 my ($file) = @_;
1661 my $cmd;
1662 my @commits = ();
1663
1664 return @commits if (!(-f $file));
1665
1666 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1667 my @all_commits = ();
1668
1669 $cmd = $VCS_cmds{"blame_file_cmd"};
1670 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1671 @all_commits = vcs_save_commits($cmd);
1672
1673 foreach my $file_range_diff (@range) {
1674 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1675 my $diff_file = $1;
1676 my $diff_start = $2;
1677 my $diff_length = $3;
1678 next if ("$file" ne "$diff_file");
1679 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1680 push(@commits, $all_commits[$i]);
1681 }
1682 }
1683 } elsif (@range) {
1684 foreach my $file_range_diff (@range) {
1685 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1686 my $diff_file = $1;
1687 my $diff_start = $2;
1688 my $diff_length = $3;
1689 next if ("$file" ne "$diff_file");
1690 $cmd = $VCS_cmds{"blame_range_cmd"};
1691 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1692 push(@commits, vcs_save_commits($cmd));
1693 }
1694 } else {
1695 $cmd = $VCS_cmds{"blame_file_cmd"};
1696 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1697 @commits = vcs_save_commits($cmd);
1698 }
1699
63ab52db
JP
1700 foreach my $commit (@commits) {
1701 $commit =~ s/^\^//g;
1702 }
1703
60db31ac
JP
1704 return @commits;
1705}
1706
1707my $printed_novcs = 0;
1708sub vcs_exists {
1709 %VCS_cmds = %VCS_cmds_git;
1710 return 1 if eval $VCS_cmds{"available"};
1711 %VCS_cmds = %VCS_cmds_hg;
683c6f8f 1712 return 2 if eval $VCS_cmds{"available"};
60db31ac
JP
1713 %VCS_cmds = ();
1714 if (!$printed_novcs) {
1715 warn("$P: No supported VCS found. Add --nogit to options?\n");
1716 warn("Using a git repository produces better results.\n");
1717 warn("Try Linus Torvalds' latest git repository using:\n");
3d1c2f72 1718 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
60db31ac
JP
1719 $printed_novcs = 1;
1720 }
1721 return 0;
1722}
1723
683c6f8f 1724sub vcs_is_git {
b9e2331d 1725 vcs_exists();
683c6f8f
JP
1726 return $vcs_used == 1;
1727}
1728
1729sub vcs_is_hg {
1730 return $vcs_used == 2;
1731}
1732
6ef1c52e 1733sub interactive_get_maintainers {
683c6f8f 1734 my ($list_ref) = @_;
dace8e30
FM
1735 my @list = @$list_ref;
1736
683c6f8f 1737 vcs_exists();
dace8e30
FM
1738
1739 my %selected;
683c6f8f
JP
1740 my %authored;
1741 my %signed;
dace8e30 1742 my $count = 0;
6ef1c52e 1743 my $maintained = 0;
6ef1c52e 1744 foreach my $entry (@list) {
b9e2331d
JP
1745 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1746 $selected{$count} = 1;
683c6f8f
JP
1747 $authored{$count} = 0;
1748 $signed{$count} = 0;
1749 $count++;
dace8e30
FM
1750 }
1751
1752 #menu loop
683c6f8f
JP
1753 my $done = 0;
1754 my $print_options = 0;
1755 my $redraw = 1;
1756 while (!$done) {
1757 $count = 0;
1758 if ($redraw) {
6ef1c52e
JP
1759 printf STDERR "\n%1s %2s %-65s",
1760 "*", "#", "email/list and role:stats";
1761 if ($email_git ||
1762 ($email_git_fallback && !$maintained) ||
1763 $email_git_blame) {
1764 print STDERR "auth sign";
1765 }
1766 print STDERR "\n";
683c6f8f
JP
1767 foreach my $entry (@list) {
1768 my $email = $entry->[0];
1769 my $role = $entry->[1];
1770 my $sel = "";
1771 $sel = "*" if ($selected{$count});
1772 my $commit_author = $commit_author_hash{$email};
1773 my $commit_signer = $commit_signer_hash{$email};
1774 my $authored = 0;
1775 my $signed = 0;
1776 $authored++ for (@{$commit_author});
1777 $signed++ for (@{$commit_signer});
1778 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1779 printf STDERR "%4d %4d", $authored, $signed
1780 if ($authored > 0 || $signed > 0);
1781 printf STDERR "\n %s\n", $role;
1782 if ($authored{$count}) {
1783 my $commit_author = $commit_author_hash{$email};
1784 foreach my $ref (@{$commit_author}) {
1785 print STDERR " Author: @{$ref}[1]\n";
dace8e30 1786 }
dace8e30 1787 }
683c6f8f
JP
1788 if ($signed{$count}) {
1789 my $commit_signer = $commit_signer_hash{$email};
1790 foreach my $ref (@{$commit_signer}) {
1791 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1792 }
1793 }
1794
1795 $count++;
1796 }
1797 }
1798 my $date_ref = \$email_git_since;
1799 $date_ref = \$email_hg_since if (vcs_is_hg());
1800 if ($print_options) {
1801 $print_options = 0;
1802 if (vcs_exists()) {
b9e2331d
JP
1803 print STDERR <<EOT
1804
1805Version Control options:
1806g use git history [$email_git]
1807gf use git-fallback [$email_git_fallback]
1808b use git blame [$email_git_blame]
1809bs use blame signatures [$email_git_blame_signatures]
1810c# minimum commits [$email_git_min_signatures]
1811%# min percent [$email_git_min_percent]
1812d# history to use [$$date_ref]
1813x# max maintainers [$email_git_max_maintainers]
1814t all signature types [$email_git_all_signature_types]
1815m use .mailmap [$email_use_mailmap]
1816EOT
dace8e30 1817 }
b9e2331d
JP
1818 print STDERR <<EOT
1819
1820Additional options:
18210 toggle all
1822tm toggle maintainers
1823tg toggle git entries
1824tl toggle open list entries
1825ts toggle subscriber list entries
1826f emails in file [$file_emails]
1827k keywords in file [$keywords]
1828r remove duplicates [$email_remove_duplicates]
1829p# pattern match depth [$pattern_depth]
1830EOT
dace8e30 1831 }
683c6f8f
JP
1832 print STDERR
1833"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1834
1835 my $input = <STDIN>;
dace8e30
FM
1836 chomp($input);
1837
683c6f8f
JP
1838 $redraw = 1;
1839 my $rerun = 0;
1840 my @wish = split(/[, ]+/, $input);
1841 foreach my $nr (@wish) {
1842 $nr = lc($nr);
1843 my $sel = substr($nr, 0, 1);
1844 my $str = substr($nr, 1);
1845 my $val = 0;
1846 $val = $1 if $str =~ /^(\d+)$/;
1847
1848 if ($sel eq "y") {
1849 $interactive = 0;
1850 $done = 1;
1851 $output_rolestats = 0;
1852 $output_roles = 0;
1853 last;
1854 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1855 $selected{$nr - 1} = !$selected{$nr - 1};
1856 } elsif ($sel eq "*" || $sel eq '^') {
1857 my $toggle = 0;
1858 $toggle = 1 if ($sel eq '*');
1859 for (my $i = 0; $i < $count; $i++) {
1860 $selected{$i} = $toggle;
dace8e30 1861 }
683c6f8f
JP
1862 } elsif ($sel eq "0") {
1863 for (my $i = 0; $i < $count; $i++) {
1864 $selected{$i} = !$selected{$i};
1865 }
b9e2331d
JP
1866 } elsif ($sel eq "t") {
1867 if (lc($str) eq "m") {
1868 for (my $i = 0; $i < $count; $i++) {
1869 $selected{$i} = !$selected{$i}
1870 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1871 }
1872 } elsif (lc($str) eq "g") {
1873 for (my $i = 0; $i < $count; $i++) {
1874 $selected{$i} = !$selected{$i}
1875 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1876 }
1877 } elsif (lc($str) eq "l") {
1878 for (my $i = 0; $i < $count; $i++) {
1879 $selected{$i} = !$selected{$i}
1880 if ($list[$i]->[1] =~ /^(open list)/i);
1881 }
1882 } elsif (lc($str) eq "s") {
1883 for (my $i = 0; $i < $count; $i++) {
1884 $selected{$i} = !$selected{$i}
1885 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1886 }
1887 }
683c6f8f
JP
1888 } elsif ($sel eq "a") {
1889 if ($val > 0 && $val <= $count) {
1890 $authored{$val - 1} = !$authored{$val - 1};
1891 } elsif ($str eq '*' || $str eq '^') {
1892 my $toggle = 0;
1893 $toggle = 1 if ($str eq '*');
1894 for (my $i = 0; $i < $count; $i++) {
1895 $authored{$i} = $toggle;
1896 }
1897 }
1898 } elsif ($sel eq "s") {
1899 if ($val > 0 && $val <= $count) {
1900 $signed{$val - 1} = !$signed{$val - 1};
1901 } elsif ($str eq '*' || $str eq '^') {
1902 my $toggle = 0;
1903 $toggle = 1 if ($str eq '*');
1904 for (my $i = 0; $i < $count; $i++) {
1905 $signed{$i} = $toggle;
1906 }
1907 }
1908 } elsif ($sel eq "o") {
1909 $print_options = 1;
1910 $redraw = 1;
1911 } elsif ($sel eq "g") {
1912 if ($str eq "f") {
1913 bool_invert(\$email_git_fallback);
dace8e30 1914 } else {
683c6f8f
JP
1915 bool_invert(\$email_git);
1916 }
1917 $rerun = 1;
1918 } elsif ($sel eq "b") {
1919 if ($str eq "s") {
1920 bool_invert(\$email_git_blame_signatures);
1921 } else {
1922 bool_invert(\$email_git_blame);
1923 }
1924 $rerun = 1;
1925 } elsif ($sel eq "c") {
1926 if ($val > 0) {
1927 $email_git_min_signatures = $val;
1928 $rerun = 1;
1929 }
1930 } elsif ($sel eq "x") {
1931 if ($val > 0) {
1932 $email_git_max_maintainers = $val;
1933 $rerun = 1;
1934 }
1935 } elsif ($sel eq "%") {
1936 if ($str ne "" && $val >= 0) {
1937 $email_git_min_percent = $val;
1938 $rerun = 1;
dace8e30 1939 }
683c6f8f
JP
1940 } elsif ($sel eq "d") {
1941 if (vcs_is_git()) {
1942 $email_git_since = $str;
1943 } elsif (vcs_is_hg()) {
1944 $email_hg_since = $str;
1945 }
1946 $rerun = 1;
1947 } elsif ($sel eq "t") {
1948 bool_invert(\$email_git_all_signature_types);
1949 $rerun = 1;
1950 } elsif ($sel eq "f") {
1951 bool_invert(\$file_emails);
1952 $rerun = 1;
1953 } elsif ($sel eq "r") {
1954 bool_invert(\$email_remove_duplicates);
1955 $rerun = 1;
b9e2331d
JP
1956 } elsif ($sel eq "m") {
1957 bool_invert(\$email_use_mailmap);
1958 read_mailmap();
1959 $rerun = 1;
683c6f8f
JP
1960 } elsif ($sel eq "k") {
1961 bool_invert(\$keywords);
1962 $rerun = 1;
1963 } elsif ($sel eq "p") {
1964 if ($str ne "" && $val >= 0) {
1965 $pattern_depth = $val;
1966 $rerun = 1;
1967 }
6ef1c52e
JP
1968 } elsif ($sel eq "h" || $sel eq "?") {
1969 print STDERR <<EOT
1970
1971Interactive mode allows you to select the various maintainers, submitters,
1972commit signers and mailing lists that could be CC'd on a patch.
1973
1974Any *'d entry is selected.
1975
47abc722 1976If you have git or hg installed, you can choose to summarize the commit
6ef1c52e
JP
1977history of files in the patch. Also, each line of the current file can
1978be matched to its commit author and that commits signers with blame.
1979
1980Various knobs exist to control the length of time for active commit
1981tracking, the maximum number of commit authors and signers to add,
1982and such.
1983
1984Enter selections at the prompt until you are satisfied that the selected
1985maintainers are appropriate. You may enter multiple selections separated
1986by either commas or spaces.
1987
1988EOT
683c6f8f
JP
1989 } else {
1990 print STDERR "invalid option: '$nr'\n";
1991 $redraw = 0;
1992 }
1993 }
1994 if ($rerun) {
1995 print STDERR "git-blame can be very slow, please have patience..."
1996 if ($email_git_blame);
6ef1c52e 1997 goto &get_maintainers;
683c6f8f
JP
1998 }
1999 }
dace8e30
FM
2000
2001 #drop not selected entries
2002 $count = 0;
683c6f8f
JP
2003 my @new_emailto = ();
2004 foreach my $entry (@list) {
2005 if ($selected{$count}) {
2006 push(@new_emailto, $list[$count]);
dace8e30
FM
2007 }
2008 $count++;
2009 }
683c6f8f 2010 return @new_emailto;
dace8e30
FM
2011}
2012
683c6f8f
JP
2013sub bool_invert {
2014 my ($bool_ref) = @_;
2015
2016 if ($$bool_ref) {
2017 $$bool_ref = 0;
2018 } else {
2019 $$bool_ref = 1;
2020 }
dace8e30
FM
2021}
2022
b9e2331d
JP
2023sub deduplicate_email {
2024 my ($email) = @_;
2025
2026 my $matched = 0;
2027 my ($name, $address) = parse_email($email);
2028 $email = format_email($name, $address, 1);
2029 $email = mailmap_email($email);
2030
2031 return $email if (!$email_remove_duplicates);
2032
2033 ($name, $address) = parse_email($email);
2034
fae99206 2035 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
b9e2331d
JP
2036 $name = $deduplicate_name_hash{lc($name)}->[0];
2037 $address = $deduplicate_name_hash{lc($name)}->[1];
2038 $matched = 1;
2039 } elsif ($deduplicate_address_hash{lc($address)}) {
2040 $name = $deduplicate_address_hash{lc($address)}->[0];
2041 $address = $deduplicate_address_hash{lc($address)}->[1];
2042 $matched = 1;
2043 }
2044 if (!$matched) {
2045 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
2046 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
2047 }
2048 $email = format_email($name, $address, 1);
2049 $email = mailmap_email($email);
2050 return $email;
2051}
2052
683c6f8f
JP
2053sub save_commits_by_author {
2054 my (@lines) = @_;
2055
2056 my @authors = ();
2057 my @commits = ();
2058 my @subjects = ();
2059
2060 foreach my $line (@lines) {
2061 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2062 my $author = $1;
b9e2331d 2063 $author = deduplicate_email($author);
683c6f8f
JP
2064 push(@authors, $author);
2065 }
2066 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2067 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2068 }
2069
2070 for (my $i = 0; $i < @authors; $i++) {
2071 my $exists = 0;
2072 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
2073 if (@{$ref}[0] eq $commits[$i] &&
2074 @{$ref}[1] eq $subjects[$i]) {
2075 $exists = 1;
2076 last;
2077 }
2078 }
2079 if (!$exists) {
2080 push(@{$commit_author_hash{$authors[$i]}},
2081 [ ($commits[$i], $subjects[$i]) ]);
2082 }
dace8e30 2083 }
dace8e30
FM
2084}
2085
683c6f8f
JP
2086sub save_commits_by_signer {
2087 my (@lines) = @_;
2088
2089 my $commit = "";
2090 my $subject = "";
dace8e30 2091
683c6f8f
JP
2092 foreach my $line (@lines) {
2093 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2094 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2095 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
2096 my @signatures = ($line);
2097 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
2098 my @types = @$types_ref;
2099 my @signers = @$signers_ref;
2100
2101 my $type = $types[0];
2102 my $signer = $signers[0];
2103
b9e2331d 2104 $signer = deduplicate_email($signer);
6ef1c52e 2105
683c6f8f
JP
2106 my $exists = 0;
2107 foreach my $ref(@{$commit_signer_hash{$signer}}) {
2108 if (@{$ref}[0] eq $commit &&
2109 @{$ref}[1] eq $subject &&
2110 @{$ref}[2] eq $type) {
2111 $exists = 1;
2112 last;
2113 }
2114 }
2115 if (!$exists) {
2116 push(@{$commit_signer_hash{$signer}},
2117 [ ($commit, $subject, $type) ]);
2118 }
2119 }
2120 }
dace8e30
FM
2121}
2122
60db31ac 2123sub vcs_assign {
a8af2430
JP
2124 my ($role, $divisor, @lines) = @_;
2125
2126 my %hash;
2127 my $count = 0;
2128
a8af2430
JP
2129 return if (@lines <= 0);
2130
2131 if ($divisor <= 0) {
60db31ac 2132 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
a8af2430 2133 $divisor = 1;
3c7385b8 2134 }
8cbb3a77 2135
7fa8ff2e 2136 @lines = mailmap(@lines);
0e70e83d 2137
63ab52db
JP
2138 return if (@lines <= 0);
2139
0e70e83d 2140 @lines = sort(@lines);
11ecf53c 2141
0e70e83d 2142 # uniq -c
11ecf53c
JP
2143 $hash{$_}++ for @lines;
2144
0e70e83d 2145 # sort -rn
0e70e83d 2146 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
11ecf53c 2147 my $sign_offs = $hash{$line};
a8af2430 2148 my $percent = $sign_offs * 100 / $divisor;
3c7385b8 2149
a8af2430 2150 $percent = 100 if ($percent > 100);
435de078 2151 next if (ignore_email_address($line));
11ecf53c
JP
2152 $count++;
2153 last if ($sign_offs < $email_git_min_signatures ||
2154 $count > $email_git_max_maintainers ||
a8af2430 2155 $percent < $email_git_min_percent);
3c7385b8 2156 push_email_address($line, '');
3c7385b8 2157 if ($output_rolestats) {
a8af2430
JP
2158 my $fmt_percent = sprintf("%.0f", $percent);
2159 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
2160 } else {
2161 add_role($line, $role);
3c7385b8 2162 }
f5492666
JP
2163 }
2164}
2165
60db31ac 2166sub vcs_file_signoffs {
a8af2430
JP
2167 my ($file) = @_;
2168
c9ecefea
JP
2169 my $authors_ref;
2170 my $signers_ref;
2171 my $stats_ref;
2172 my @authors = ();
a8af2430 2173 my @signers = ();
c9ecefea 2174 my @stats = ();
60db31ac 2175 my $commits;
f5492666 2176
683c6f8f
JP
2177 $vcs_used = vcs_exists();
2178 return if (!$vcs_used);
a8af2430 2179
60db31ac
JP
2180 my $cmd = $VCS_cmds{"find_signers_cmd"};
2181 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
f5492666 2182
c9ecefea
JP
2183 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2184
2185 @signers = @{$signers_ref} if defined $signers_ref;
2186 @authors = @{$authors_ref} if defined $authors_ref;
2187 @stats = @{$stats_ref} if defined $stats_ref;
2188
2189# print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
b9e2331d
JP
2190
2191 foreach my $signer (@signers) {
2192 $signer = deduplicate_email($signer);
2193 }
2194
60db31ac 2195 vcs_assign("commit_signer", $commits, @signers);
c9ecefea
JP
2196 vcs_assign("authored", $commits, @authors);
2197 if ($#authors == $#stats) {
2198 my $stat_pattern = $VCS_cmds{"stat_pattern"};
2199 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
2200
2201 my $added = 0;
2202 my $deleted = 0;
2203 for (my $i = 0; $i <= $#stats; $i++) {
2204 if ($stats[$i] =~ /$stat_pattern/) {
2205 $added += $1;
2206 $deleted += $2;
2207 }
2208 }
2209 my @tmp_authors = uniq(@authors);
2210 foreach my $author (@tmp_authors) {
2211 $author = deduplicate_email($author);
2212 }
2213 @tmp_authors = uniq(@tmp_authors);
2214 my @list_added = ();
2215 my @list_deleted = ();
2216 foreach my $author (@tmp_authors) {
2217 my $auth_added = 0;
2218 my $auth_deleted = 0;
2219 for (my $i = 0; $i <= $#stats; $i++) {
2220 if ($author eq deduplicate_email($authors[$i]) &&
2221 $stats[$i] =~ /$stat_pattern/) {
2222 $auth_added += $1;
2223 $auth_deleted += $2;
2224 }
2225 }
2226 for (my $i = 0; $i < $auth_added; $i++) {
2227 push(@list_added, $author);
2228 }
2229 for (my $i = 0; $i < $auth_deleted; $i++) {
2230 push(@list_deleted, $author);
2231 }
2232 }
2233 vcs_assign("added_lines", $added, @list_added);
2234 vcs_assign("removed_lines", $deleted, @list_deleted);
2235 }
f5492666
JP
2236}
2237
60db31ac 2238sub vcs_file_blame {
f5492666
JP
2239 my ($file) = @_;
2240
a8af2430 2241 my @signers = ();
63ab52db 2242 my @all_commits = ();
60db31ac 2243 my @commits = ();
a8af2430 2244 my $total_commits;
63ab52db 2245 my $total_lines;
f5492666 2246
683c6f8f
JP
2247 $vcs_used = vcs_exists();
2248 return if (!$vcs_used);
f5492666 2249
63ab52db
JP
2250 @all_commits = vcs_blame($file);
2251 @commits = uniq(@all_commits);
a8af2430 2252 $total_commits = @commits;
63ab52db 2253 $total_lines = @all_commits;
8cbb3a77 2254
683c6f8f
JP
2255 if ($email_git_blame_signatures) {
2256 if (vcs_is_hg()) {
2257 my $commit_count;
c9ecefea
JP
2258 my $commit_authors_ref;
2259 my $commit_signers_ref;
2260 my $stats_ref;
2261 my @commit_authors = ();
683c6f8f
JP
2262 my @commit_signers = ();
2263 my $commit = join(" -r ", @commits);
2264 my $cmd;
8cbb3a77 2265
683c6f8f
JP
2266 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2267 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
60db31ac 2268
c9ecefea
JP
2269 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2270 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2271 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
63ab52db 2272
683c6f8f
JP
2273 push(@signers, @commit_signers);
2274 } else {
2275 foreach my $commit (@commits) {
2276 my $commit_count;
c9ecefea
JP
2277 my $commit_authors_ref;
2278 my $commit_signers_ref;
2279 my $stats_ref;
2280 my @commit_authors = ();
683c6f8f
JP
2281 my @commit_signers = ();
2282 my $cmd;
2283
2284 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2285 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2286
c9ecefea
JP
2287 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2288 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2289 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
683c6f8f
JP
2290
2291 push(@signers, @commit_signers);
2292 }
2293 }
f5492666
JP
2294 }
2295
a8af2430 2296 if ($from_filename) {
63ab52db
JP
2297 if ($output_rolestats) {
2298 my @blame_signers;
683c6f8f
JP
2299 if (vcs_is_hg()) {{ # Double brace for last exit
2300 my $commit_count;
2301 my @commit_signers = ();
2302 @commits = uniq(@commits);
2303 @commits = sort(@commits);
2304 my $commit = join(" -r ", @commits);
2305 my $cmd;
2306
2307 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2308 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2309
2310 my @lines = ();
2311
2312 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2313
2314 if (!$email_git_penguin_chiefs) {
2315 @lines = grep(!/${penguin_chiefs}/i, @lines);
2316 }
2317
2318 last if !@lines;
2319
2320 my @authors = ();
2321 foreach my $line (@lines) {
2322 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2323 my $author = $1;
b9e2331d
JP
2324 $author = deduplicate_email($author);
2325 push(@authors, $author);
683c6f8f
JP
2326 }
2327 }
2328
2329 save_commits_by_author(@lines) if ($interactive);
2330 save_commits_by_signer(@lines) if ($interactive);
2331
2332 push(@signers, @authors);
2333 }}
2334 else {
2335 foreach my $commit (@commits) {
2336 my $i;
2337 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2338 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2339 my @author = vcs_find_author($cmd);
2340 next if !@author;
b9e2331d
JP
2341
2342 my $formatted_author = deduplicate_email($author[0]);
2343
683c6f8f
JP
2344 my $count = grep(/$commit/, @all_commits);
2345 for ($i = 0; $i < $count ; $i++) {
b9e2331d 2346 push(@blame_signers, $formatted_author);
683c6f8f 2347 }
63ab52db
JP
2348 }
2349 }
2350 if (@blame_signers) {
2351 vcs_assign("authored lines", $total_lines, @blame_signers);
2352 }
2353 }
b9e2331d
JP
2354 foreach my $signer (@signers) {
2355 $signer = deduplicate_email($signer);
2356 }
60db31ac 2357 vcs_assign("commits", $total_commits, @signers);
a8af2430 2358 } else {
b9e2331d
JP
2359 foreach my $signer (@signers) {
2360 $signer = deduplicate_email($signer);
2361 }
60db31ac 2362 vcs_assign("modified commits", $total_commits, @signers);
cb7301c7 2363 }
cb7301c7
JP
2364}
2365
4cad35a7
JP
2366sub vcs_file_exists {
2367 my ($file) = @_;
2368
2369 my $exists;
2370
2371 my $vcs_used = vcs_exists();
2372 return 0 if (!$vcs_used);
2373
2374 my $cmd = $VCS_cmds{"file_exists_cmd"};
2375 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
8582fb59 2376 $cmd .= " 2>&1";
4cad35a7
JP
2377 $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2378
8582fb59
JP
2379 return 0 if ($? != 0);
2380
4cad35a7
JP
2381 return $exists;
2382}
2383
e1f75904
TS
2384sub vcs_list_files {
2385 my ($file) = @_;
2386
2387 my @lsfiles = ();
2388
2389 my $vcs_used = vcs_exists();
2390 return 0 if (!$vcs_used);
2391
2392 my $cmd = $VCS_cmds{"list_files_cmd"};
2393 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
2394 @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd);
2395
2396 return () if ($? != 0);
2397
2398 return @lsfiles;
2399}
2400
cb7301c7 2401sub uniq {
a8af2430 2402 my (@parms) = @_;
cb7301c7
JP
2403
2404 my %saw;
2405 @parms = grep(!$saw{$_}++, @parms);
2406 return @parms;
2407}
2408
2409sub sort_and_uniq {
a8af2430 2410 my (@parms) = @_;
cb7301c7
JP
2411
2412 my %saw;
2413 @parms = sort @parms;
2414 @parms = grep(!$saw{$_}++, @parms);
2415 return @parms;
2416}
2417
03372dbb
JP
2418sub clean_file_emails {
2419 my (@file_emails) = @_;
2420 my @fmt_emails = ();
2421
2422 foreach my $email (@file_emails) {
2423 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2424 my ($name, $address) = parse_email($email);
2425 if ($name eq '"[,\.]"') {
2426 $name = "";
2427 }
2428
2429 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2430 if (@nw > 2) {
2431 my $first = $nw[@nw - 3];
2432 my $middle = $nw[@nw - 2];
2433 my $last = $nw[@nw - 1];
2434
2435 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2436 (length($first) == 2 && substr($first, -1) eq ".")) ||
2437 (length($middle) == 1 ||
2438 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2439 $name = "$first $middle $last";
2440 } else {
2441 $name = "$middle $last";
2442 }
2443 }
2444
2445 if (substr($name, -1) =~ /[,\.]/) {
2446 $name = substr($name, 0, length($name) - 1);
2447 } elsif (substr($name, -2) =~ /[,\.]"/) {
2448 $name = substr($name, 0, length($name) - 2) . '"';
2449 }
2450
2451 if (substr($name, 0, 1) =~ /[,\.]/) {
2452 $name = substr($name, 1, length($name) - 1);
2453 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2454 $name = '"' . substr($name, 2, length($name) - 2);
2455 }
2456
2457 my $fmt_email = format_email($name, $address, $email_usename);
2458 push(@fmt_emails, $fmt_email);
2459 }
2460 return @fmt_emails;
2461}
2462
3c7385b8
JP
2463sub merge_email {
2464 my @lines;
2465 my %saw;
2466
2467 for (@_) {
2468 my ($address, $role) = @$_;
2469 if (!$saw{$address}) {
2470 if ($output_roles) {
60db31ac 2471 push(@lines, "$address ($role)");
3c7385b8 2472 } else {
60db31ac 2473 push(@lines, $address);
3c7385b8
JP
2474 }
2475 $saw{$address} = 1;
2476 }
2477 }
2478
2479 return @lines;
2480}
2481
cb7301c7 2482sub output {
a8af2430 2483 my (@parms) = @_;
cb7301c7
JP
2484
2485 if ($output_multiline) {
2486 foreach my $line (@parms) {
2487 print("${line}\n");
2488 }
2489 } else {
2490 print(join($output_separator, @parms));
2491 print("\n");
2492 }
2493}
1b5e1cf6
JP
2494
2495my $rfc822re;
2496
2497sub make_rfc822re {
2498# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2499# comment. We must allow for rfc822_lwsp (or comments) after each of these.
2500# This regexp will only work on addresses which have had comments stripped
2501# and replaced with rfc822_lwsp.
2502
2503 my $specials = '()<>@,;:\\\\".\\[\\]';
2504 my $controls = '\\000-\\037\\177';
2505
2506 my $dtext = "[^\\[\\]\\r\\\\]";
2507 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2508
2509 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2510
2511# Use zero-width assertion to spot the limit of an atom. A simple
2512# $rfc822_lwsp* causes the regexp engine to hang occasionally.
2513 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2514 my $word = "(?:$atom|$quoted_string)";
2515 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2516
2517 my $sub_domain = "(?:$atom|$domain_literal)";
2518 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2519
2520 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2521
2522 my $phrase = "$word*";
2523 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2524 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2525 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2526
2527 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2528 my $address = "(?:$mailbox|$group)";
2529
2530 return "$rfc822_lwsp*$address";
2531}
2532
2533sub rfc822_strip_comments {
2534 my $s = shift;
2535# Recursively remove comments, and replace with a single space. The simpler
2536# regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2537# chars in atoms, for example.
2538
2539 while ($s =~ s/^((?:[^"\\]|\\.)*
2540 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2541 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2542 return $s;
2543}
2544
2545# valid: returns true if the parameter is an RFC822 valid address
2546#
22dd5b0c 2547sub rfc822_valid {
1b5e1cf6
JP
2548 my $s = rfc822_strip_comments(shift);
2549
2550 if (!$rfc822re) {
2551 $rfc822re = make_rfc822re();
2552 }
2553
2554 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2555}
2556
2557# validlist: In scalar context, returns true if the parameter is an RFC822
2558# valid list of addresses.
2559#
2560# In list context, returns an empty list on failure (an invalid
2561# address was found); otherwise a list whose first element is the
2562# number of addresses found and whose remaining elements are the
2563# addresses. This is needed to disambiguate failure (invalid)
2564# from success with no addresses found, because an empty string is
2565# a valid list.
2566
22dd5b0c 2567sub rfc822_validlist {
1b5e1cf6
JP
2568 my $s = rfc822_strip_comments(shift);
2569
2570 if (!$rfc822re) {
2571 $rfc822re = make_rfc822re();
2572 }
2573 # * null list items are valid according to the RFC
2574 # * the '1' business is to aid in distinguishing failure from no results
2575
2576 my @r;
2577 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2578 $s =~ m/^$rfc822_char*$/) {
5f2441e9 2579 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
60db31ac 2580 push(@r, $1);
1b5e1cf6
JP
2581 }
2582 return wantarray ? (scalar(@r), @r) : 1;
2583 }
60db31ac 2584 return wantarray ? () : 0;
1b5e1cf6 2585}