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