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