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