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