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