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