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