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