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