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