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