Back to home page

LXR

 
 

    


0001 #!/usr/bin/perl -w
0002 # (c) 2007, Joe Perches <joe@perches.com>
0003 #           created from checkpatch.pl
0004 #
0005 # Print selected MAINTAINERS information for
0006 # the files modified in a patch or for a file
0007 #
0008 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
0009 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
0010 #
0011 # Licensed under the terms of the GNU GPL License version 2
0012 
0013 use strict;
0014 
0015 my $P = $0;
0016 my $V = '0.26';
0017 
0018 use Getopt::Long qw(:config no_auto_abbrev);
0019 use Cwd;
0020 
0021 my $cur_path = fastgetcwd() . '/';
0022 my $lk_path = "./";
0023 my $email = 1;
0024 my $email_usename = 1;
0025 my $email_maintainer = 1;
0026 my $email_reviewer = 1;
0027 my $email_list = 1;
0028 my $email_subscriber_list = 0;
0029 my $email_git_penguin_chiefs = 0;
0030 my $email_git = 0;
0031 my $email_git_all_signature_types = 0;
0032 my $email_git_blame = 0;
0033 my $email_git_blame_signatures = 1;
0034 my $email_git_fallback = 1;
0035 my $email_git_min_signatures = 1;
0036 my $email_git_max_maintainers = 5;
0037 my $email_git_min_percent = 5;
0038 my $email_git_since = "1-year-ago";
0039 my $email_hg_since = "-365";
0040 my $interactive = 0;
0041 my $email_remove_duplicates = 1;
0042 my $email_use_mailmap = 1;
0043 my $output_multiline = 1;
0044 my $output_separator = ", ";
0045 my $output_roles = 0;
0046 my $output_rolestats = 1;
0047 my $output_section_maxlen = 50;
0048 my $scm = 0;
0049 my $web = 0;
0050 my $subsystem = 0;
0051 my $status = 0;
0052 my $letters = "";
0053 my $keywords = 1;
0054 my $sections = 0;
0055 my $file_emails = 0;
0056 my $from_filename = 0;
0057 my $pattern_depth = 0;
0058 my $version = 0;
0059 my $help = 0;
0060 
0061 my $vcs_used = 0;
0062 
0063 my $exit = 0;
0064 
0065 my %commit_author_hash;
0066 my %commit_signer_hash;
0067 
0068 my @penguin_chief = ();
0069 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
0070 #Andrew wants in on most everything - 2009/01/14
0071 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
0072 
0073 my @penguin_chief_names = ();
0074 foreach my $chief (@penguin_chief) {
0075     if ($chief =~ m/^(.*):(.*)/) {
0076     my $chief_name = $1;
0077     my $chief_addr = $2;
0078     push(@penguin_chief_names, $chief_name);
0079     }
0080 }
0081 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
0082 
0083 # Signature types of people who are either
0084 #   a) responsible for the code in question, or
0085 #   b) familiar enough with it to give relevant feedback
0086 my @signature_tags = ();
0087 push(@signature_tags, "Signed-off-by:");
0088 push(@signature_tags, "Reviewed-by:");
0089 push(@signature_tags, "Acked-by:");
0090 
0091 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
0092 
0093 # rfc822 email address - preloaded methods go here.
0094 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
0095 my $rfc822_char = '[\\000-\\377]';
0096 
0097 # VCS command support: class-like functions and strings
0098 
0099 my %VCS_cmds;
0100 
0101 my %VCS_cmds_git = (
0102     "execute_cmd" => \&git_execute_cmd,
0103     "available" => '(which("git") ne "") && (-e ".git")',
0104     "find_signers_cmd" =>
0105     "git log --no-color --follow --since=\$email_git_since " .
0106         '--numstat --no-merges ' .
0107         '--format="GitCommit: %H%n' .
0108               'GitAuthor: %an <%ae>%n' .
0109               'GitDate: %aD%n' .
0110               'GitSubject: %s%n' .
0111               '%b%n"' .
0112         " -- \$file",
0113     "find_commit_signers_cmd" =>
0114     "git log --no-color " .
0115         '--numstat ' .
0116         '--format="GitCommit: %H%n' .
0117               'GitAuthor: %an <%ae>%n' .
0118               'GitDate: %aD%n' .
0119               'GitSubject: %s%n' .
0120               '%b%n"' .
0121         " -1 \$commit",
0122     "find_commit_author_cmd" =>
0123     "git log --no-color " .
0124         '--numstat ' .
0125         '--format="GitCommit: %H%n' .
0126               'GitAuthor: %an <%ae>%n' .
0127               'GitDate: %aD%n' .
0128               'GitSubject: %s%n"' .
0129         " -1 \$commit",
0130     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
0131     "blame_file_cmd" => "git blame -l \$file",
0132     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
0133     "blame_commit_pattern" => "^([0-9a-f]+) ",
0134     "author_pattern" => "^GitAuthor: (.*)",
0135     "subject_pattern" => "^GitSubject: (.*)",
0136     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
0137     "file_exists_cmd" => "git ls-files \$file",
0138 );
0139 
0140 my %VCS_cmds_hg = (
0141     "execute_cmd" => \&hg_execute_cmd,
0142     "available" => '(which("hg") ne "") && (-d ".hg")',
0143     "find_signers_cmd" =>
0144     "hg log --date=\$email_hg_since " .
0145         "--template='HgCommit: {node}\\n" .
0146                     "HgAuthor: {author}\\n" .
0147             "HgSubject: {desc}\\n'" .
0148         " -- \$file",
0149     "find_commit_signers_cmd" =>
0150     "hg log " .
0151         "--template='HgSubject: {desc}\\n'" .
0152         " -r \$commit",
0153     "find_commit_author_cmd" =>
0154     "hg log " .
0155         "--template='HgCommit: {node}\\n" .
0156                 "HgAuthor: {author}\\n" .
0157             "HgSubject: {desc|firstline}\\n'" .
0158         " -r \$commit",
0159     "blame_range_cmd" => "",        # not supported
0160     "blame_file_cmd" => "hg blame -n \$file",
0161     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
0162     "blame_commit_pattern" => "^([ 0-9a-f]+):",
0163     "author_pattern" => "^HgAuthor: (.*)",
0164     "subject_pattern" => "^HgSubject: (.*)",
0165     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
0166     "file_exists_cmd" => "hg files \$file",
0167 );
0168 
0169 my $conf = which_conf(".get_maintainer.conf");
0170 if (-f $conf) {
0171     my @conf_args;
0172     open(my $conffile, '<', "$conf")
0173     or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
0174 
0175     while (<$conffile>) {
0176     my $line = $_;
0177 
0178     $line =~ s/\s*\n?$//g;
0179     $line =~ s/^\s*//g;
0180     $line =~ s/\s+/ /g;
0181 
0182     next if ($line =~ m/^\s*#/);
0183     next if ($line =~ m/^\s*$/);
0184 
0185     my @words = split(" ", $line);
0186     foreach my $word (@words) {
0187         last if ($word =~ m/^#/);
0188         push (@conf_args, $word);
0189     }
0190     }
0191     close($conffile);
0192     unshift(@ARGV, @conf_args) if @conf_args;
0193 }
0194 
0195 my @ignore_emails = ();
0196 my $ignore_file = which_conf(".get_maintainer.ignore");
0197 if (-f $ignore_file) {
0198     open(my $ignore, '<', "$ignore_file")
0199     or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
0200     while (<$ignore>) {
0201     my $line = $_;
0202 
0203     $line =~ s/\s*\n?$//;
0204     $line =~ s/^\s*//;
0205     $line =~ s/\s+$//;
0206     $line =~ s/#.*$//;
0207 
0208     next if ($line =~ m/^\s*$/);
0209     if (rfc822_valid($line)) {
0210         push(@ignore_emails, $line);
0211     }
0212     }
0213     close($ignore);
0214 }
0215 
0216 if (!GetOptions(
0217         'email!' => \$email,
0218         'git!' => \$email_git,
0219         'git-all-signature-types!' => \$email_git_all_signature_types,
0220         'git-blame!' => \$email_git_blame,
0221         'git-blame-signatures!' => \$email_git_blame_signatures,
0222         'git-fallback!' => \$email_git_fallback,
0223         'git-chief-penguins!' => \$email_git_penguin_chiefs,
0224         'git-min-signatures=i' => \$email_git_min_signatures,
0225         'git-max-maintainers=i' => \$email_git_max_maintainers,
0226         'git-min-percent=i' => \$email_git_min_percent,
0227         'git-since=s' => \$email_git_since,
0228         'hg-since=s' => \$email_hg_since,
0229         'i|interactive!' => \$interactive,
0230         'remove-duplicates!' => \$email_remove_duplicates,
0231         'mailmap!' => \$email_use_mailmap,
0232         'm!' => \$email_maintainer,
0233         'r!' => \$email_reviewer,
0234         'n!' => \$email_usename,
0235         'l!' => \$email_list,
0236         's!' => \$email_subscriber_list,
0237         'multiline!' => \$output_multiline,
0238         'roles!' => \$output_roles,
0239         'rolestats!' => \$output_rolestats,
0240         'separator=s' => \$output_separator,
0241         'subsystem!' => \$subsystem,
0242         'status!' => \$status,
0243         'scm!' => \$scm,
0244         'web!' => \$web,
0245         'letters=s' => \$letters,
0246         'pattern-depth=i' => \$pattern_depth,
0247         'k|keywords!' => \$keywords,
0248         'sections!' => \$sections,
0249         'fe|file-emails!' => \$file_emails,
0250         'f|file' => \$from_filename,
0251         'v|version' => \$version,
0252         'h|help|usage' => \$help,
0253         )) {
0254     die "$P: invalid argument - use --help if necessary\n";
0255 }
0256 
0257 if ($help != 0) {
0258     usage();
0259     exit 0;
0260 }
0261 
0262 if ($version != 0) {
0263     print("${P} ${V}\n");
0264     exit 0;
0265 }
0266 
0267 if (-t STDIN && !@ARGV) {
0268     # We're talking to a terminal, but have no command line arguments.
0269     die "$P: missing patchfile or -f file - use --help if necessary\n";
0270 }
0271 
0272 $output_multiline = 0 if ($output_separator ne ", ");
0273 $output_rolestats = 1 if ($interactive);
0274 $output_roles = 1 if ($output_rolestats);
0275 
0276 if ($sections || $letters ne "") {
0277     $sections = 1;
0278     $email = 0;
0279     $email_list = 0;
0280     $scm = 0;
0281     $status = 0;
0282     $subsystem = 0;
0283     $web = 0;
0284     $keywords = 0;
0285     $interactive = 0;
0286 } else {
0287     my $selections = $email + $scm + $status + $subsystem + $web;
0288     if ($selections == 0) {
0289     die "$P:  Missing required option: email, scm, status, subsystem or web\n";
0290     }
0291 }
0292 
0293 if ($email &&
0294     ($email_maintainer + $email_reviewer +
0295      $email_list + $email_subscriber_list +
0296      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
0297     die "$P: Please select at least 1 email option\n";
0298 }
0299 
0300 if (!top_of_kernel_tree($lk_path)) {
0301     die "$P: The current directory does not appear to be "
0302     . "a linux kernel source tree.\n";
0303 }
0304 
0305 ## Read MAINTAINERS for type/value pairs
0306 
0307 my @typevalue = ();
0308 my %keyword_hash;
0309 
0310 open (my $maint, '<', "${lk_path}MAINTAINERS")
0311     or die "$P: Can't open MAINTAINERS: $!\n";
0312 while (<$maint>) {
0313     my $line = $_;
0314 
0315     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0316     my $type = $1;
0317     my $value = $2;
0318 
0319     ##Filename pattern matching
0320     if ($type eq "F" || $type eq "X") {
0321         $value =~ s@\.@\\\.@g;       ##Convert . to \.
0322         $value =~ s/\*/\.\*/g;       ##Convert * to .*
0323         $value =~ s/\?/\./g;         ##Convert ? to .
0324         ##if pattern is a directory and it lacks a trailing slash, add one
0325         if ((-d $value)) {
0326         $value =~ s@([^/])$@$1/@;
0327         }
0328     } elsif ($type eq "K") {
0329         $keyword_hash{@typevalue} = $value;
0330     }
0331     push(@typevalue, "$type:$value");
0332     } elsif (!/^(\s)*$/) {
0333     $line =~ s/\n$//g;
0334     push(@typevalue, $line);
0335     }
0336 }
0337 close($maint);
0338 
0339 
0340 #
0341 # Read mail address map
0342 #
0343 
0344 my $mailmap;
0345 
0346 read_mailmap();
0347 
0348 sub read_mailmap {
0349     $mailmap = {
0350     names => {},
0351     addresses => {}
0352     };
0353 
0354     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
0355 
0356     open(my $mailmap_file, '<', "${lk_path}.mailmap")
0357     or warn "$P: Can't open .mailmap: $!\n";
0358 
0359     while (<$mailmap_file>) {
0360     s/#.*$//; #strip comments
0361     s/^\s+|\s+$//g; #trim
0362 
0363     next if (/^\s*$/); #skip empty lines
0364     #entries have one of the following formats:
0365     # name1 <mail1>
0366     # <mail1> <mail2>
0367     # name1 <mail1> <mail2>
0368     # name1 <mail1> name2 <mail2>
0369     # (see man git-shortlog)
0370 
0371     if (/^([^<]+)<([^>]+)>$/) {
0372         my $real_name = $1;
0373         my $address = $2;
0374 
0375         $real_name =~ s/\s+$//;
0376         ($real_name, $address) = parse_email("$real_name <$address>");
0377         $mailmap->{names}->{$address} = $real_name;
0378 
0379     } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
0380         my $real_address = $1;
0381         my $wrong_address = $2;
0382 
0383         $mailmap->{addresses}->{$wrong_address} = $real_address;
0384 
0385     } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
0386         my $real_name = $1;
0387         my $real_address = $2;
0388         my $wrong_address = $3;
0389 
0390         $real_name =~ s/\s+$//;
0391         ($real_name, $real_address) =
0392         parse_email("$real_name <$real_address>");
0393         $mailmap->{names}->{$wrong_address} = $real_name;
0394         $mailmap->{addresses}->{$wrong_address} = $real_address;
0395 
0396     } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
0397         my $real_name = $1;
0398         my $real_address = $2;
0399         my $wrong_name = $3;
0400         my $wrong_address = $4;
0401 
0402         $real_name =~ s/\s+$//;
0403         ($real_name, $real_address) =
0404         parse_email("$real_name <$real_address>");
0405 
0406         $wrong_name =~ s/\s+$//;
0407         ($wrong_name, $wrong_address) =
0408         parse_email("$wrong_name <$wrong_address>");
0409 
0410         my $wrong_email = format_email($wrong_name, $wrong_address, 1);
0411         $mailmap->{names}->{$wrong_email} = $real_name;
0412         $mailmap->{addresses}->{$wrong_email} = $real_address;
0413     }
0414     }
0415     close($mailmap_file);
0416 }
0417 
0418 ## use the filenames on the command line or find the filenames in the patchfiles
0419 
0420 my @files = ();
0421 my @range = ();
0422 my @keyword_tvi = ();
0423 my @file_emails = ();
0424 
0425 if (!@ARGV) {
0426     push(@ARGV, "&STDIN");
0427 }
0428 
0429 foreach my $file (@ARGV) {
0430     if ($file ne "&STDIN") {
0431     ##if $file is a directory and it lacks a trailing slash, add one
0432     if ((-d $file)) {
0433         $file =~ s@([^/])$@$1/@;
0434     } elsif (!(-f $file)) {
0435         die "$P: file '${file}' not found\n";
0436     }
0437     }
0438     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
0439     $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
0440     $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
0441     push(@files, $file);
0442     if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
0443         open(my $f, '<', $file)
0444         or die "$P: Can't open $file: $!\n";
0445         my $text = do { local($/) ; <$f> };
0446         close($f);
0447         if ($keywords) {
0448         foreach my $line (keys %keyword_hash) {
0449             if ($text =~ m/$keyword_hash{$line}/x) {
0450             push(@keyword_tvi, $line);
0451             }
0452         }
0453         }
0454         if ($file_emails) {
0455         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;
0456         push(@file_emails, clean_file_emails(@poss_addr));
0457         }
0458     }
0459     } else {
0460     my $file_cnt = @files;
0461     my $lastfile;
0462 
0463     open(my $patch, "< $file")
0464         or die "$P: Can't open $file: $!\n";
0465 
0466     # We can check arbitrary information before the patch
0467     # like the commit message, mail headers, etc...
0468     # This allows us to match arbitrary keywords against any part
0469     # of a git format-patch generated file (subject tags, etc...)
0470 
0471     my $patch_prefix = "";          #Parsing the intro
0472 
0473     while (<$patch>) {
0474         my $patch_line = $_;
0475         if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
0476         my $filename = $1;
0477         $filename =~ s@^[^/]*/@@;
0478         $filename =~ s@\n@@;
0479         $lastfile = $filename;
0480         push(@files, $filename);
0481         $patch_prefix = "^[+-].*";  #Now parsing the actual patch
0482         } elsif (m/^\@\@ -(\d+),(\d+)/) {
0483         if ($email_git_blame) {
0484             push(@range, "$lastfile:$1:$2");
0485         }
0486         } elsif ($keywords) {
0487         foreach my $line (keys %keyword_hash) {
0488             if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
0489             push(@keyword_tvi, $line);
0490             }
0491         }
0492         }
0493     }
0494     close($patch);
0495 
0496     if ($file_cnt == @files) {
0497         warn "$P: file '${file}' doesn't appear to be a patch.  "
0498         . "Add -f to options?\n";
0499     }
0500     @files = sort_and_uniq(@files);
0501     }
0502 }
0503 
0504 @file_emails = uniq(@file_emails);
0505 
0506 my %email_hash_name;
0507 my %email_hash_address;
0508 my @email_to = ();
0509 my %hash_list_to;
0510 my @list_to = ();
0511 my @scm = ();
0512 my @web = ();
0513 my @subsystem = ();
0514 my @status = ();
0515 my %deduplicate_name_hash = ();
0516 my %deduplicate_address_hash = ();
0517 
0518 my @maintainers = get_maintainers();
0519 
0520 if (@maintainers) {
0521     @maintainers = merge_email(@maintainers);
0522     output(@maintainers);
0523 }
0524 
0525 if ($scm) {
0526     @scm = uniq(@scm);
0527     output(@scm);
0528 }
0529 
0530 if ($status) {
0531     @status = uniq(@status);
0532     output(@status);
0533 }
0534 
0535 if ($subsystem) {
0536     @subsystem = uniq(@subsystem);
0537     output(@subsystem);
0538 }
0539 
0540 if ($web) {
0541     @web = uniq(@web);
0542     output(@web);
0543 }
0544 
0545 exit($exit);
0546 
0547 sub ignore_email_address {
0548     my ($address) = @_;
0549 
0550     foreach my $ignore (@ignore_emails) {
0551     return 1 if ($ignore eq $address);
0552     }
0553 
0554     return 0;
0555 }
0556 
0557 sub range_is_maintained {
0558     my ($start, $end) = @_;
0559 
0560     for (my $i = $start; $i < $end; $i++) {
0561     my $line = $typevalue[$i];
0562     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0563         my $type = $1;
0564         my $value = $2;
0565         if ($type eq 'S') {
0566         if ($value =~ /(maintain|support)/i) {
0567             return 1;
0568         }
0569         }
0570     }
0571     }
0572     return 0;
0573 }
0574 
0575 sub range_has_maintainer {
0576     my ($start, $end) = @_;
0577 
0578     for (my $i = $start; $i < $end; $i++) {
0579     my $line = $typevalue[$i];
0580     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0581         my $type = $1;
0582         my $value = $2;
0583         if ($type eq 'M') {
0584         return 1;
0585         }
0586     }
0587     }
0588     return 0;
0589 }
0590 
0591 sub get_maintainers {
0592     %email_hash_name = ();
0593     %email_hash_address = ();
0594     %commit_author_hash = ();
0595     %commit_signer_hash = ();
0596     @email_to = ();
0597     %hash_list_to = ();
0598     @list_to = ();
0599     @scm = ();
0600     @web = ();
0601     @subsystem = ();
0602     @status = ();
0603     %deduplicate_name_hash = ();
0604     %deduplicate_address_hash = ();
0605     if ($email_git_all_signature_types) {
0606     $signature_pattern = "(.+?)[Bb][Yy]:";
0607     } else {
0608     $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
0609     }
0610 
0611     # Find responsible parties
0612 
0613     my %exact_pattern_match_hash = ();
0614 
0615     foreach my $file (@files) {
0616 
0617     my %hash;
0618     my $tvi = find_first_section();
0619     while ($tvi < @typevalue) {
0620         my $start = find_starting_index($tvi);
0621         my $end = find_ending_index($tvi);
0622         my $exclude = 0;
0623         my $i;
0624 
0625         #Do not match excluded file patterns
0626 
0627         for ($i = $start; $i < $end; $i++) {
0628         my $line = $typevalue[$i];
0629         if ($line =~ m/^([A-Z]):\s*(.*)/) {
0630             my $type = $1;
0631             my $value = $2;
0632             if ($type eq 'X') {
0633             if (file_match_pattern($file, $value)) {
0634                 $exclude = 1;
0635                 last;
0636             }
0637             }
0638         }
0639         }
0640 
0641         if (!$exclude) {
0642         for ($i = $start; $i < $end; $i++) {
0643             my $line = $typevalue[$i];
0644             if ($line =~ m/^([A-Z]):\s*(.*)/) {
0645             my $type = $1;
0646             my $value = $2;
0647             if ($type eq 'F') {
0648                 if (file_match_pattern($file, $value)) {
0649                 my $value_pd = ($value =~ tr@/@@);
0650                 my $file_pd = ($file  =~ tr@/@@);
0651                 $value_pd++ if (substr($value,-1,1) ne "/");
0652                 $value_pd = -1 if ($value =~ /^\.\*/);
0653                 if ($value_pd >= $file_pd &&
0654                     range_is_maintained($start, $end) &&
0655                     range_has_maintainer($start, $end)) {
0656                     $exact_pattern_match_hash{$file} = 1;
0657                 }
0658                 if ($pattern_depth == 0 ||
0659                     (($file_pd - $value_pd) < $pattern_depth)) {
0660                     $hash{$tvi} = $value_pd;
0661                 }
0662                 }
0663             } elsif ($type eq 'N') {
0664                 if ($file =~ m/$value/x) {
0665                 $hash{$tvi} = 0;
0666                 }
0667             }
0668             }
0669         }
0670         }
0671         $tvi = $end + 1;
0672     }
0673 
0674     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
0675         add_categories($line);
0676         if ($sections) {
0677         my $i;
0678         my $start = find_starting_index($line);
0679         my $end = find_ending_index($line);
0680         for ($i = $start; $i < $end; $i++) {
0681             my $line = $typevalue[$i];
0682             if ($line =~ /^[FX]:/) {        ##Restore file patterns
0683             $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
0684             $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
0685             $line =~ s/\\\./\./g;           ##Convert \. to .
0686             $line =~ s/\.\*/\*/g;           ##Convert .* to *
0687             }
0688             my $count = $line =~ s/^([A-Z]):/$1:\t/g;
0689             if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
0690             print("$line\n");
0691             }
0692         }
0693         print("\n");
0694         }
0695     }
0696     }
0697 
0698     if ($keywords) {
0699     @keyword_tvi = sort_and_uniq(@keyword_tvi);
0700     foreach my $line (@keyword_tvi) {
0701         add_categories($line);
0702     }
0703     }
0704 
0705     foreach my $email (@email_to, @list_to) {
0706     $email->[0] = deduplicate_email($email->[0]);
0707     }
0708 
0709     foreach my $file (@files) {
0710     if ($email &&
0711         ($email_git || ($email_git_fallback &&
0712                 !$exact_pattern_match_hash{$file}))) {
0713         vcs_file_signoffs($file);
0714     }
0715     if ($email && $email_git_blame) {
0716         vcs_file_blame($file);
0717     }
0718     }
0719 
0720     if ($email) {
0721     foreach my $chief (@penguin_chief) {
0722         if ($chief =~ m/^(.*):(.*)/) {
0723         my $email_address;
0724 
0725         $email_address = format_email($1, $2, $email_usename);
0726         if ($email_git_penguin_chiefs) {
0727             push(@email_to, [$email_address, 'chief penguin']);
0728         } else {
0729             @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
0730         }
0731         }
0732     }
0733 
0734     foreach my $email (@file_emails) {
0735         my ($name, $address) = parse_email($email);
0736 
0737         my $tmp_email = format_email($name, $address, $email_usename);
0738         push_email_address($tmp_email, '');
0739         add_role($tmp_email, 'in file');
0740     }
0741     }
0742 
0743     my @to = ();
0744     if ($email || $email_list) {
0745     if ($email) {
0746         @to = (@to, @email_to);
0747     }
0748     if ($email_list) {
0749         @to = (@to, @list_to);
0750     }
0751     }
0752 
0753     if ($interactive) {
0754     @to = interactive_get_maintainers(\@to);
0755     }
0756 
0757     return @to;
0758 }
0759 
0760 sub file_match_pattern {
0761     my ($file, $pattern) = @_;
0762     if (substr($pattern, -1) eq "/") {
0763     if ($file =~ m@^$pattern@) {
0764         return 1;
0765     }
0766     } else {
0767     if ($file =~ m@^$pattern@) {
0768         my $s1 = ($file =~ tr@/@@);
0769         my $s2 = ($pattern =~ tr@/@@);
0770         if ($s1 == $s2) {
0771         return 1;
0772         }
0773     }
0774     }
0775     return 0;
0776 }
0777 
0778 sub usage {
0779     print <<EOT;
0780 usage: $P [options] patchfile
0781        $P [options] -f file|directory
0782 version: $V
0783 
0784 MAINTAINER field selection options:
0785   --email => print email address(es) if any
0786     --git => include recent git \*-by: signers
0787     --git-all-signature-types => include signers regardless of signature type
0788         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
0789     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
0790     --git-chief-penguins => include ${penguin_chiefs}
0791     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
0792     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
0793     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
0794     --git-blame => use git blame to find modified commits for patch or file
0795     --git-blame-signatures => when used with --git-blame, also include all commit signers
0796     --git-since => git history to use (default: $email_git_since)
0797     --hg-since => hg history to use (default: $email_hg_since)
0798     --interactive => display a menu (mostly useful if used with the --git option)
0799     --m => include maintainer(s) if any
0800     --r => include reviewer(s) if any
0801     --n => include name 'Full Name <addr\@domain.tld>'
0802     --l => include list(s) if any
0803     --s => include subscriber only list(s) if any
0804     --remove-duplicates => minimize duplicate email names/addresses
0805     --roles => show roles (status:subsystem, git-signer, list, etc...)
0806     --rolestats => show roles and statistics (commits/total_commits, %)
0807     --file-emails => add email addresses found in -f file (default: 0 (off))
0808   --scm => print SCM tree(s) if any
0809   --status => print status if any
0810   --subsystem => print subsystem name if any
0811   --web => print website(s) if any
0812 
0813 Output type options:
0814   --separator [, ] => separator for multiple entries on 1 line
0815     using --separator also sets --nomultiline if --separator is not [, ]
0816   --multiline => print 1 entry per line
0817 
0818 Other options:
0819   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
0820   --keywords => scan patch for keywords (default: $keywords)
0821   --sections => print all of the subsystem sections with pattern matches
0822   --letters => print all matching 'letter' types from all matching sections
0823   --mailmap => use .mailmap file (default: $email_use_mailmap)
0824   --version => show version
0825   --help => show this help information
0826 
0827 Default options:
0828   [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
0829    --remove-duplicates --rolestats]
0830 
0831 Notes:
0832   Using "-f directory" may give unexpected results:
0833       Used with "--git", git signators for _all_ files in and below
0834           directory are examined as git recurses directories.
0835           Any specified X: (exclude) pattern matches are _not_ ignored.
0836       Used with "--nogit", directory is used as a pattern match,
0837           no individual file within the directory or subdirectory
0838           is matched.
0839       Used with "--git-blame", does not iterate all files in directory
0840   Using "--git-blame" is slow and may add old committers and authors
0841       that are no longer active maintainers to the output.
0842   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
0843       other automated tools that expect only ["name"] <email address>
0844       may not work because of additional output after <email address>.
0845   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
0846       not the percentage of the entire file authored.  # of commits is
0847       not a good measure of amount of code authored.  1 major commit may
0848       contain a thousand lines, 5 trivial commits may modify a single line.
0849   If git is not installed, but mercurial (hg) is installed and an .hg
0850       repository exists, the following options apply to mercurial:
0851           --git,
0852           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
0853           --git-blame
0854       Use --hg-since not --git-since to control date selection
0855   File ".get_maintainer.conf", if it exists in the linux kernel source root
0856       directory, can change whatever get_maintainer defaults are desired.
0857       Entries in this file can be any command line argument.
0858       This file is prepended to any additional command line arguments.
0859       Multiple lines and # comments are allowed.
0860   Most options have both positive and negative forms.
0861       The negative forms for --<foo> are --no<foo> and --no-<foo>.
0862 
0863 EOT
0864 }
0865 
0866 sub top_of_kernel_tree {
0867     my ($lk_path) = @_;
0868 
0869     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
0870     $lk_path .= "/";
0871     }
0872     if (   (-f "${lk_path}COPYING")
0873     && (-f "${lk_path}CREDITS")
0874     && (-f "${lk_path}Kbuild")
0875     && (-f "${lk_path}MAINTAINERS")
0876     && (-f "${lk_path}Makefile")
0877     && (-f "${lk_path}README")
0878     && (-d "${lk_path}Documentation")
0879     && (-d "${lk_path}arch")
0880     && (-d "${lk_path}include")
0881     && (-d "${lk_path}drivers")
0882     && (-d "${lk_path}fs")
0883     && (-d "${lk_path}init")
0884     && (-d "${lk_path}ipc")
0885     && (-d "${lk_path}kernel")
0886     && (-d "${lk_path}lib")
0887     && (-d "${lk_path}scripts")) {
0888     return 1;
0889     }
0890     return 0;
0891 }
0892 
0893 sub parse_email {
0894     my ($formatted_email) = @_;
0895 
0896     my $name = "";
0897     my $address = "";
0898 
0899     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
0900     $name = $1;
0901     $address = $2;
0902     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
0903     $address = $1;
0904     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
0905     $address = $1;
0906     }
0907 
0908     $name =~ s/^\s+|\s+$//g;
0909     $name =~ s/^\"|\"$//g;
0910     $address =~ s/^\s+|\s+$//g;
0911 
0912     if ($name =~ /[^\w \-]/i) {      ##has "must quote" chars
0913     $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
0914     $name = "\"$name\"";
0915     }
0916 
0917     return ($name, $address);
0918 }
0919 
0920 sub format_email {
0921     my ($name, $address, $usename) = @_;
0922 
0923     my $formatted_email;
0924 
0925     $name =~ s/^\s+|\s+$//g;
0926     $name =~ s/^\"|\"$//g;
0927     $address =~ s/^\s+|\s+$//g;
0928 
0929     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
0930     $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
0931     $name = "\"$name\"";
0932     }
0933 
0934     if ($usename) {
0935     if ("$name" eq "") {
0936         $formatted_email = "$address";
0937     } else {
0938         $formatted_email = "$name <$address>";
0939     }
0940     } else {
0941     $formatted_email = $address;
0942     }
0943 
0944     return $formatted_email;
0945 }
0946 
0947 sub find_first_section {
0948     my $index = 0;
0949 
0950     while ($index < @typevalue) {
0951     my $tv = $typevalue[$index];
0952     if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
0953         last;
0954     }
0955     $index++;
0956     }
0957 
0958     return $index;
0959 }
0960 
0961 sub find_starting_index {
0962     my ($index) = @_;
0963 
0964     while ($index > 0) {
0965     my $tv = $typevalue[$index];
0966     if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
0967         last;
0968     }
0969     $index--;
0970     }
0971 
0972     return $index;
0973 }
0974 
0975 sub find_ending_index {
0976     my ($index) = @_;
0977 
0978     while ($index < @typevalue) {
0979     my $tv = $typevalue[$index];
0980     if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
0981         last;
0982     }
0983     $index++;
0984     }
0985 
0986     return $index;
0987 }
0988 
0989 sub get_subsystem_name {
0990     my ($index) = @_;
0991 
0992     my $start = find_starting_index($index);
0993 
0994     my $subsystem = $typevalue[$start];
0995     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
0996     $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
0997     $subsystem =~ s/\s*$//;
0998     $subsystem = $subsystem . "...";
0999     }
1000     return $subsystem;
1001 }
1002 
1003 sub get_maintainer_role {
1004     my ($index) = @_;
1005 
1006     my $i;
1007     my $start = find_starting_index($index);
1008     my $end = find_ending_index($index);
1009 
1010     my $role = "unknown";
1011     my $subsystem = get_subsystem_name($index);
1012 
1013     for ($i = $start + 1; $i < $end; $i++) {
1014     my $tv = $typevalue[$i];
1015     if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1016         my $ptype = $1;
1017         my $pvalue = $2;
1018         if ($ptype eq "S") {
1019         $role = $pvalue;
1020         }
1021     }
1022     }
1023 
1024     $role = lc($role);
1025     if      ($role eq "supported") {
1026     $role = "supporter";
1027     } elsif ($role eq "maintained") {
1028     $role = "maintainer";
1029     } elsif ($role eq "odd fixes") {
1030     $role = "odd fixer";
1031     } elsif ($role eq "orphan") {
1032     $role = "orphan minder";
1033     } elsif ($role eq "obsolete") {
1034     $role = "obsolete minder";
1035     } elsif ($role eq "buried alive in reporters") {
1036     $role = "chief penguin";
1037     }
1038 
1039     return $role . ":" . $subsystem;
1040 }
1041 
1042 sub get_list_role {
1043     my ($index) = @_;
1044 
1045     my $subsystem = get_subsystem_name($index);
1046 
1047     if ($subsystem eq "THE REST") {
1048     $subsystem = "";
1049     }
1050 
1051     return $subsystem;
1052 }
1053 
1054 sub add_categories {
1055     my ($index) = @_;
1056 
1057     my $i;
1058     my $start = find_starting_index($index);
1059     my $end = find_ending_index($index);
1060 
1061     push(@subsystem, $typevalue[$start]);
1062 
1063     for ($i = $start + 1; $i < $end; $i++) {
1064     my $tv = $typevalue[$i];
1065     if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1066         my $ptype = $1;
1067         my $pvalue = $2;
1068         if ($ptype eq "L") {
1069         my $list_address = $pvalue;
1070         my $list_additional = "";
1071         my $list_role = get_list_role($i);
1072 
1073         if ($list_role ne "") {
1074             $list_role = ":" . $list_role;
1075         }
1076         if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1077             $list_address = $1;
1078             $list_additional = $2;
1079         }
1080         if ($list_additional =~ m/subscribers-only/) {
1081             if ($email_subscriber_list) {
1082             if (!$hash_list_to{lc($list_address)}) {
1083                 $hash_list_to{lc($list_address)} = 1;
1084                 push(@list_to, [$list_address,
1085                         "subscriber list${list_role}"]);
1086             }
1087             }
1088         } else {
1089             if ($email_list) {
1090             if (!$hash_list_to{lc($list_address)}) {
1091                 $hash_list_to{lc($list_address)} = 1;
1092                 if ($list_additional =~ m/moderated/) {
1093                 push(@list_to, [$list_address,
1094                         "moderated list${list_role}"]);
1095                 } else {
1096                 push(@list_to, [$list_address,
1097                         "open list${list_role}"]);
1098                 }
1099             }
1100             }
1101         }
1102         } elsif ($ptype eq "M") {
1103         my ($name, $address) = parse_email($pvalue);
1104         if ($name eq "") {
1105             if ($i > 0) {
1106             my $tv = $typevalue[$i - 1];
1107             if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1108                 if ($1 eq "P") {
1109                 $name = $2;
1110                 $pvalue = format_email($name, $address, $email_usename);
1111                 }
1112             }
1113             }
1114         }
1115         if ($email_maintainer) {
1116             my $role = get_maintainer_role($i);
1117             push_email_addresses($pvalue, $role);
1118         }
1119         } elsif ($ptype eq "R") {
1120         my ($name, $address) = parse_email($pvalue);
1121         if ($name eq "") {
1122             if ($i > 0) {
1123             my $tv = $typevalue[$i - 1];
1124             if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1125                 if ($1 eq "P") {
1126                 $name = $2;
1127                 $pvalue = format_email($name, $address, $email_usename);
1128                 }
1129             }
1130             }
1131         }
1132         if ($email_reviewer) {
1133             my $subsystem = get_subsystem_name($i);
1134             push_email_addresses($pvalue, "reviewer:$subsystem");
1135         }
1136         } elsif ($ptype eq "T") {
1137         push(@scm, $pvalue);
1138         } elsif ($ptype eq "W") {
1139         push(@web, $pvalue);
1140         } elsif ($ptype eq "S") {
1141         push(@status, $pvalue);
1142         }
1143     }
1144     }
1145 }
1146 
1147 sub email_inuse {
1148     my ($name, $address) = @_;
1149 
1150     return 1 if (($name eq "") && ($address eq ""));
1151     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1152     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1153 
1154     return 0;
1155 }
1156 
1157 sub push_email_address {
1158     my ($line, $role) = @_;
1159 
1160     my ($name, $address) = parse_email($line);
1161 
1162     if ($address eq "") {
1163     return 0;
1164     }
1165 
1166     if (!$email_remove_duplicates) {
1167     push(@email_to, [format_email($name, $address, $email_usename), $role]);
1168     } elsif (!email_inuse($name, $address)) {
1169     push(@email_to, [format_email($name, $address, $email_usename), $role]);
1170     $email_hash_name{lc($name)}++ if ($name ne "");
1171     $email_hash_address{lc($address)}++;
1172     }
1173 
1174     return 1;
1175 }
1176 
1177 sub push_email_addresses {
1178     my ($address, $role) = @_;
1179 
1180     my @address_list = ();
1181 
1182     if (rfc822_valid($address)) {
1183     push_email_address($address, $role);
1184     } elsif (@address_list = rfc822_validlist($address)) {
1185     my $array_count = shift(@address_list);
1186     while (my $entry = shift(@address_list)) {
1187         push_email_address($entry, $role);
1188     }
1189     } else {
1190     if (!push_email_address($address, $role)) {
1191         warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1192     }
1193     }
1194 }
1195 
1196 sub add_role {
1197     my ($line, $role) = @_;
1198 
1199     my ($name, $address) = parse_email($line);
1200     my $email = format_email($name, $address, $email_usename);
1201 
1202     foreach my $entry (@email_to) {
1203     if ($email_remove_duplicates) {
1204         my ($entry_name, $entry_address) = parse_email($entry->[0]);
1205         if (($name eq $entry_name || $address eq $entry_address)
1206         && ($role eq "" || !($entry->[1] =~ m/$role/))
1207         ) {
1208         if ($entry->[1] eq "") {
1209             $entry->[1] = "$role";
1210         } else {
1211             $entry->[1] = "$entry->[1],$role";
1212         }
1213         }
1214     } else {
1215         if ($email eq $entry->[0]
1216         && ($role eq "" || !($entry->[1] =~ m/$role/))
1217         ) {
1218         if ($entry->[1] eq "") {
1219             $entry->[1] = "$role";
1220         } else {
1221             $entry->[1] = "$entry->[1],$role";
1222         }
1223         }
1224     }
1225     }
1226 }
1227 
1228 sub which {
1229     my ($bin) = @_;
1230 
1231     foreach my $path (split(/:/, $ENV{PATH})) {
1232     if (-e "$path/$bin") {
1233         return "$path/$bin";
1234     }
1235     }
1236 
1237     return "";
1238 }
1239 
1240 sub which_conf {
1241     my ($conf) = @_;
1242 
1243     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1244     if (-e "$path/$conf") {
1245         return "$path/$conf";
1246     }
1247     }
1248 
1249     return "";
1250 }
1251 
1252 sub mailmap_email {
1253     my ($line) = @_;
1254 
1255     my ($name, $address) = parse_email($line);
1256     my $email = format_email($name, $address, 1);
1257     my $real_name = $name;
1258     my $real_address = $address;
1259 
1260     if (exists $mailmap->{names}->{$email} ||
1261     exists $mailmap->{addresses}->{$email}) {
1262     if (exists $mailmap->{names}->{$email}) {
1263         $real_name = $mailmap->{names}->{$email};
1264     }
1265     if (exists $mailmap->{addresses}->{$email}) {
1266         $real_address = $mailmap->{addresses}->{$email};
1267     }
1268     } else {
1269     if (exists $mailmap->{names}->{$address}) {
1270         $real_name = $mailmap->{names}->{$address};
1271     }
1272     if (exists $mailmap->{addresses}->{$address}) {
1273         $real_address = $mailmap->{addresses}->{$address};
1274     }
1275     }
1276     return format_email($real_name, $real_address, 1);
1277 }
1278 
1279 sub mailmap {
1280     my (@addresses) = @_;
1281 
1282     my @mapped_emails = ();
1283     foreach my $line (@addresses) {
1284     push(@mapped_emails, mailmap_email($line));
1285     }
1286     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1287     return @mapped_emails;
1288 }
1289 
1290 sub merge_by_realname {
1291     my %address_map;
1292     my (@emails) = @_;
1293 
1294     foreach my $email (@emails) {
1295     my ($name, $address) = parse_email($email);
1296     if (exists $address_map{$name}) {
1297         $address = $address_map{$name};
1298         $email = format_email($name, $address, 1);
1299     } else {
1300         $address_map{$name} = $address;
1301     }
1302     }
1303 }
1304 
1305 sub git_execute_cmd {
1306     my ($cmd) = @_;
1307     my @lines = ();
1308 
1309     my $output = `$cmd`;
1310     $output =~ s/^\s*//gm;
1311     @lines = split("\n", $output);
1312 
1313     return @lines;
1314 }
1315 
1316 sub hg_execute_cmd {
1317     my ($cmd) = @_;
1318     my @lines = ();
1319 
1320     my $output = `$cmd`;
1321     @lines = split("\n", $output);
1322 
1323     return @lines;
1324 }
1325 
1326 sub extract_formatted_signatures {
1327     my (@signature_lines) = @_;
1328 
1329     my @type = @signature_lines;
1330 
1331     s/\s*(.*):.*/$1/ for (@type);
1332 
1333     # cut -f2- -d":"
1334     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1335 
1336 ## Reformat email addresses (with names) to avoid badly written signatures
1337 
1338     foreach my $signer (@signature_lines) {
1339     $signer = deduplicate_email($signer);
1340     }
1341 
1342     return (\@type, \@signature_lines);
1343 }
1344 
1345 sub vcs_find_signers {
1346     my ($cmd, $file) = @_;
1347     my $commits;
1348     my @lines = ();
1349     my @signatures = ();
1350     my @authors = ();
1351     my @stats = ();
1352 
1353     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1354 
1355     my $pattern = $VCS_cmds{"commit_pattern"};
1356     my $author_pattern = $VCS_cmds{"author_pattern"};
1357     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1358 
1359     $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
1360 
1361     $commits = grep(/$pattern/, @lines);    # of commits
1362 
1363     @authors = grep(/$author_pattern/, @lines);
1364     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1365     @stats = grep(/$stat_pattern/, @lines);
1366 
1367 #    print("stats: <@stats>\n");
1368 
1369     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1370 
1371     save_commits_by_author(@lines) if ($interactive);
1372     save_commits_by_signer(@lines) if ($interactive);
1373 
1374     if (!$email_git_penguin_chiefs) {
1375     @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1376     }
1377 
1378     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1379     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1380 
1381     return ($commits, $signers_ref, $authors_ref, \@stats);
1382 }
1383 
1384 sub vcs_find_author {
1385     my ($cmd) = @_;
1386     my @lines = ();
1387 
1388     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1389 
1390     if (!$email_git_penguin_chiefs) {
1391     @lines = grep(!/${penguin_chiefs}/i, @lines);
1392     }
1393 
1394     return @lines if !@lines;
1395 
1396     my @authors = ();
1397     foreach my $line (@lines) {
1398     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1399         my $author = $1;
1400         my ($name, $address) = parse_email($author);
1401         $author = format_email($name, $address, 1);
1402         push(@authors, $author);
1403     }
1404     }
1405 
1406     save_commits_by_author(@lines) if ($interactive);
1407     save_commits_by_signer(@lines) if ($interactive);
1408 
1409     return @authors;
1410 }
1411 
1412 sub vcs_save_commits {
1413     my ($cmd) = @_;
1414     my @lines = ();
1415     my @commits = ();
1416 
1417     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1418 
1419     foreach my $line (@lines) {
1420     if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1421         push(@commits, $1);
1422     }
1423     }
1424 
1425     return @commits;
1426 }
1427 
1428 sub vcs_blame {
1429     my ($file) = @_;
1430     my $cmd;
1431     my @commits = ();
1432 
1433     return @commits if (!(-f $file));
1434 
1435     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1436     my @all_commits = ();
1437 
1438     $cmd = $VCS_cmds{"blame_file_cmd"};
1439     $cmd =~ s/(\$\w+)/$1/eeg;       #interpolate $cmd
1440     @all_commits = vcs_save_commits($cmd);
1441 
1442     foreach my $file_range_diff (@range) {
1443         next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1444         my $diff_file = $1;
1445         my $diff_start = $2;
1446         my $diff_length = $3;
1447         next if ("$file" ne "$diff_file");
1448         for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1449         push(@commits, $all_commits[$i]);
1450         }
1451     }
1452     } elsif (@range) {
1453     foreach my $file_range_diff (@range) {
1454         next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1455         my $diff_file = $1;
1456         my $diff_start = $2;
1457         my $diff_length = $3;
1458         next if ("$file" ne "$diff_file");
1459         $cmd = $VCS_cmds{"blame_range_cmd"};
1460         $cmd =~ s/(\$\w+)/$1/eeg;       #interpolate $cmd
1461         push(@commits, vcs_save_commits($cmd));
1462     }
1463     } else {
1464     $cmd = $VCS_cmds{"blame_file_cmd"};
1465     $cmd =~ s/(\$\w+)/$1/eeg;       #interpolate $cmd
1466     @commits = vcs_save_commits($cmd);
1467     }
1468 
1469     foreach my $commit (@commits) {
1470     $commit =~ s/^\^//g;
1471     }
1472 
1473     return @commits;
1474 }
1475 
1476 my $printed_novcs = 0;
1477 sub vcs_exists {
1478     %VCS_cmds = %VCS_cmds_git;
1479     return 1 if eval $VCS_cmds{"available"};
1480     %VCS_cmds = %VCS_cmds_hg;
1481     return 2 if eval $VCS_cmds{"available"};
1482     %VCS_cmds = ();
1483     if (!$printed_novcs) {
1484     warn("$P: No supported VCS found.  Add --nogit to options?\n");
1485     warn("Using a git repository produces better results.\n");
1486     warn("Try Linus Torvalds' latest git repository using:\n");
1487     warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1488     $printed_novcs = 1;
1489     }
1490     return 0;
1491 }
1492 
1493 sub vcs_is_git {
1494     vcs_exists();
1495     return $vcs_used == 1;
1496 }
1497 
1498 sub vcs_is_hg {
1499     return $vcs_used == 2;
1500 }
1501 
1502 sub interactive_get_maintainers {
1503     my ($list_ref) = @_;
1504     my @list = @$list_ref;
1505 
1506     vcs_exists();
1507 
1508     my %selected;
1509     my %authored;
1510     my %signed;
1511     my $count = 0;
1512     my $maintained = 0;
1513     foreach my $entry (@list) {
1514     $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1515     $selected{$count} = 1;
1516     $authored{$count} = 0;
1517     $signed{$count} = 0;
1518     $count++;
1519     }
1520 
1521     #menu loop
1522     my $done = 0;
1523     my $print_options = 0;
1524     my $redraw = 1;
1525     while (!$done) {
1526     $count = 0;
1527     if ($redraw) {
1528         printf STDERR "\n%1s %2s %-65s",
1529               "*", "#", "email/list and role:stats";
1530         if ($email_git ||
1531         ($email_git_fallback && !$maintained) ||
1532         $email_git_blame) {
1533         print STDERR "auth sign";
1534         }
1535         print STDERR "\n";
1536         foreach my $entry (@list) {
1537         my $email = $entry->[0];
1538         my $role = $entry->[1];
1539         my $sel = "";
1540         $sel = "*" if ($selected{$count});
1541         my $commit_author = $commit_author_hash{$email};
1542         my $commit_signer = $commit_signer_hash{$email};
1543         my $authored = 0;
1544         my $signed = 0;
1545         $authored++ for (@{$commit_author});
1546         $signed++ for (@{$commit_signer});
1547         printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1548         printf STDERR "%4d %4d", $authored, $signed
1549             if ($authored > 0 || $signed > 0);
1550         printf STDERR "\n     %s\n", $role;
1551         if ($authored{$count}) {
1552             my $commit_author = $commit_author_hash{$email};
1553             foreach my $ref (@{$commit_author}) {
1554             print STDERR "     Author: @{$ref}[1]\n";
1555             }
1556         }
1557         if ($signed{$count}) {
1558             my $commit_signer = $commit_signer_hash{$email};
1559             foreach my $ref (@{$commit_signer}) {
1560             print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1561             }
1562         }
1563 
1564         $count++;
1565         }
1566     }
1567     my $date_ref = \$email_git_since;
1568     $date_ref = \$email_hg_since if (vcs_is_hg());
1569     if ($print_options) {
1570         $print_options = 0;
1571         if (vcs_exists()) {
1572         print STDERR <<EOT
1573 
1574 Version Control options:
1575 g  use git history      [$email_git]
1576 gf use git-fallback     [$email_git_fallback]
1577 b  use git blame        [$email_git_blame]
1578 bs use blame signatures [$email_git_blame_signatures]
1579 c# minimum commits      [$email_git_min_signatures]
1580 %# min percent          [$email_git_min_percent]
1581 d# history to use       [$$date_ref]
1582 x# max maintainers      [$email_git_max_maintainers]
1583 t  all signature types  [$email_git_all_signature_types]
1584 m  use .mailmap         [$email_use_mailmap]
1585 EOT
1586         }
1587         print STDERR <<EOT
1588 
1589 Additional options:
1590 0  toggle all
1591 tm toggle maintainers
1592 tg toggle git entries
1593 tl toggle open list entries
1594 ts toggle subscriber list entries
1595 f  emails in file       [$file_emails]
1596 k  keywords in file     [$keywords]
1597 r  remove duplicates    [$email_remove_duplicates]
1598 p# pattern match depth  [$pattern_depth]
1599 EOT
1600     }
1601     print STDERR
1602 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1603 
1604     my $input = <STDIN>;
1605     chomp($input);
1606 
1607     $redraw = 1;
1608     my $rerun = 0;
1609     my @wish = split(/[, ]+/, $input);
1610     foreach my $nr (@wish) {
1611         $nr = lc($nr);
1612         my $sel = substr($nr, 0, 1);
1613         my $str = substr($nr, 1);
1614         my $val = 0;
1615         $val = $1 if $str =~ /^(\d+)$/;
1616 
1617         if ($sel eq "y") {
1618         $interactive = 0;
1619         $done = 1;
1620         $output_rolestats = 0;
1621         $output_roles = 0;
1622         last;
1623         } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1624         $selected{$nr - 1} = !$selected{$nr - 1};
1625         } elsif ($sel eq "*" || $sel eq '^') {
1626         my $toggle = 0;
1627         $toggle = 1 if ($sel eq '*');
1628         for (my $i = 0; $i < $count; $i++) {
1629             $selected{$i} = $toggle;
1630         }
1631         } elsif ($sel eq "0") {
1632         for (my $i = 0; $i < $count; $i++) {
1633             $selected{$i} = !$selected{$i};
1634         }
1635         } elsif ($sel eq "t") {
1636         if (lc($str) eq "m") {
1637             for (my $i = 0; $i < $count; $i++) {
1638             $selected{$i} = !$selected{$i}
1639                 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1640             }
1641         } elsif (lc($str) eq "g") {
1642             for (my $i = 0; $i < $count; $i++) {
1643             $selected{$i} = !$selected{$i}
1644                 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1645             }
1646         } elsif (lc($str) eq "l") {
1647             for (my $i = 0; $i < $count; $i++) {
1648             $selected{$i} = !$selected{$i}
1649                 if ($list[$i]->[1] =~ /^(open list)/i);
1650             }
1651         } elsif (lc($str) eq "s") {
1652             for (my $i = 0; $i < $count; $i++) {
1653             $selected{$i} = !$selected{$i}
1654                 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1655             }
1656         }
1657         } elsif ($sel eq "a") {
1658         if ($val > 0 && $val <= $count) {
1659             $authored{$val - 1} = !$authored{$val - 1};
1660         } elsif ($str eq '*' || $str eq '^') {
1661             my $toggle = 0;
1662             $toggle = 1 if ($str eq '*');
1663             for (my $i = 0; $i < $count; $i++) {
1664             $authored{$i} = $toggle;
1665             }
1666         }
1667         } elsif ($sel eq "s") {
1668         if ($val > 0 && $val <= $count) {
1669             $signed{$val - 1} = !$signed{$val - 1};
1670         } elsif ($str eq '*' || $str eq '^') {
1671             my $toggle = 0;
1672             $toggle = 1 if ($str eq '*');
1673             for (my $i = 0; $i < $count; $i++) {
1674             $signed{$i} = $toggle;
1675             }
1676         }
1677         } elsif ($sel eq "o") {
1678         $print_options = 1;
1679         $redraw = 1;
1680         } elsif ($sel eq "g") {
1681         if ($str eq "f") {
1682             bool_invert(\$email_git_fallback);
1683         } else {
1684             bool_invert(\$email_git);
1685         }
1686         $rerun = 1;
1687         } elsif ($sel eq "b") {
1688         if ($str eq "s") {
1689             bool_invert(\$email_git_blame_signatures);
1690         } else {
1691             bool_invert(\$email_git_blame);
1692         }
1693         $rerun = 1;
1694         } elsif ($sel eq "c") {
1695         if ($val > 0) {
1696             $email_git_min_signatures = $val;
1697             $rerun = 1;
1698         }
1699         } elsif ($sel eq "x") {
1700         if ($val > 0) {
1701             $email_git_max_maintainers = $val;
1702             $rerun = 1;
1703         }
1704         } elsif ($sel eq "%") {
1705         if ($str ne "" && $val >= 0) {
1706             $email_git_min_percent = $val;
1707             $rerun = 1;
1708         }
1709         } elsif ($sel eq "d") {
1710         if (vcs_is_git()) {
1711             $email_git_since = $str;
1712         } elsif (vcs_is_hg()) {
1713             $email_hg_since = $str;
1714         }
1715         $rerun = 1;
1716         } elsif ($sel eq "t") {
1717         bool_invert(\$email_git_all_signature_types);
1718         $rerun = 1;
1719         } elsif ($sel eq "f") {
1720         bool_invert(\$file_emails);
1721         $rerun = 1;
1722         } elsif ($sel eq "r") {
1723         bool_invert(\$email_remove_duplicates);
1724         $rerun = 1;
1725         } elsif ($sel eq "m") {
1726         bool_invert(\$email_use_mailmap);
1727         read_mailmap();
1728         $rerun = 1;
1729         } elsif ($sel eq "k") {
1730         bool_invert(\$keywords);
1731         $rerun = 1;
1732         } elsif ($sel eq "p") {
1733         if ($str ne "" && $val >= 0) {
1734             $pattern_depth = $val;
1735             $rerun = 1;
1736         }
1737         } elsif ($sel eq "h" || $sel eq "?") {
1738         print STDERR <<EOT
1739 
1740 Interactive mode allows you to select the various maintainers, submitters,
1741 commit signers and mailing lists that could be CC'd on a patch.
1742 
1743 Any *'d entry is selected.
1744 
1745 If you have git or hg installed, you can choose to summarize the commit
1746 history of files in the patch.  Also, each line of the current file can
1747 be matched to its commit author and that commits signers with blame.
1748 
1749 Various knobs exist to control the length of time for active commit
1750 tracking, the maximum number of commit authors and signers to add,
1751 and such.
1752 
1753 Enter selections at the prompt until you are satisfied that the selected
1754 maintainers are appropriate.  You may enter multiple selections separated
1755 by either commas or spaces.
1756 
1757 EOT
1758         } else {
1759         print STDERR "invalid option: '$nr'\n";
1760         $redraw = 0;
1761         }
1762     }
1763     if ($rerun) {
1764         print STDERR "git-blame can be very slow, please have patience..."
1765         if ($email_git_blame);
1766         goto &get_maintainers;
1767     }
1768     }
1769 
1770     #drop not selected entries
1771     $count = 0;
1772     my @new_emailto = ();
1773     foreach my $entry (@list) {
1774     if ($selected{$count}) {
1775         push(@new_emailto, $list[$count]);
1776     }
1777     $count++;
1778     }
1779     return @new_emailto;
1780 }
1781 
1782 sub bool_invert {
1783     my ($bool_ref) = @_;
1784 
1785     if ($$bool_ref) {
1786     $$bool_ref = 0;
1787     } else {
1788     $$bool_ref = 1;
1789     }
1790 }
1791 
1792 sub deduplicate_email {
1793     my ($email) = @_;
1794 
1795     my $matched = 0;
1796     my ($name, $address) = parse_email($email);
1797     $email = format_email($name, $address, 1);
1798     $email = mailmap_email($email);
1799 
1800     return $email if (!$email_remove_duplicates);
1801 
1802     ($name, $address) = parse_email($email);
1803 
1804     if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1805     $name = $deduplicate_name_hash{lc($name)}->[0];
1806     $address = $deduplicate_name_hash{lc($name)}->[1];
1807     $matched = 1;
1808     } elsif ($deduplicate_address_hash{lc($address)}) {
1809     $name = $deduplicate_address_hash{lc($address)}->[0];
1810     $address = $deduplicate_address_hash{lc($address)}->[1];
1811     $matched = 1;
1812     }
1813     if (!$matched) {
1814     $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1815     $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1816     }
1817     $email = format_email($name, $address, 1);
1818     $email = mailmap_email($email);
1819     return $email;
1820 }
1821 
1822 sub save_commits_by_author {
1823     my (@lines) = @_;
1824 
1825     my @authors = ();
1826     my @commits = ();
1827     my @subjects = ();
1828 
1829     foreach my $line (@lines) {
1830     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1831         my $author = $1;
1832         $author = deduplicate_email($author);
1833         push(@authors, $author);
1834     }
1835     push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1836     push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1837     }
1838 
1839     for (my $i = 0; $i < @authors; $i++) {
1840     my $exists = 0;
1841     foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1842         if (@{$ref}[0] eq $commits[$i] &&
1843         @{$ref}[1] eq $subjects[$i]) {
1844         $exists = 1;
1845         last;
1846         }
1847     }
1848     if (!$exists) {
1849         push(@{$commit_author_hash{$authors[$i]}},
1850          [ ($commits[$i], $subjects[$i]) ]);
1851     }
1852     }
1853 }
1854 
1855 sub save_commits_by_signer {
1856     my (@lines) = @_;
1857 
1858     my $commit = "";
1859     my $subject = "";
1860 
1861     foreach my $line (@lines) {
1862     $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1863     $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1864     if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1865         my @signatures = ($line);
1866         my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1867         my @types = @$types_ref;
1868         my @signers = @$signers_ref;
1869 
1870         my $type = $types[0];
1871         my $signer = $signers[0];
1872 
1873         $signer = deduplicate_email($signer);
1874 
1875         my $exists = 0;
1876         foreach my $ref(@{$commit_signer_hash{$signer}}) {
1877         if (@{$ref}[0] eq $commit &&
1878             @{$ref}[1] eq $subject &&
1879             @{$ref}[2] eq $type) {
1880             $exists = 1;
1881             last;
1882         }
1883         }
1884         if (!$exists) {
1885         push(@{$commit_signer_hash{$signer}},
1886              [ ($commit, $subject, $type) ]);
1887         }
1888     }
1889     }
1890 }
1891 
1892 sub vcs_assign {
1893     my ($role, $divisor, @lines) = @_;
1894 
1895     my %hash;
1896     my $count = 0;
1897 
1898     return if (@lines <= 0);
1899 
1900     if ($divisor <= 0) {
1901     warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1902     $divisor = 1;
1903     }
1904 
1905     @lines = mailmap(@lines);
1906 
1907     return if (@lines <= 0);
1908 
1909     @lines = sort(@lines);
1910 
1911     # uniq -c
1912     $hash{$_}++ for @lines;
1913 
1914     # sort -rn
1915     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1916     my $sign_offs = $hash{$line};
1917     my $percent = $sign_offs * 100 / $divisor;
1918 
1919     $percent = 100 if ($percent > 100);
1920     next if (ignore_email_address($line));
1921     $count++;
1922     last if ($sign_offs < $email_git_min_signatures ||
1923          $count > $email_git_max_maintainers ||
1924          $percent < $email_git_min_percent);
1925     push_email_address($line, '');
1926     if ($output_rolestats) {
1927         my $fmt_percent = sprintf("%.0f", $percent);
1928         add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1929     } else {
1930         add_role($line, $role);
1931     }
1932     }
1933 }
1934 
1935 sub vcs_file_signoffs {
1936     my ($file) = @_;
1937 
1938     my $authors_ref;
1939     my $signers_ref;
1940     my $stats_ref;
1941     my @authors = ();
1942     my @signers = ();
1943     my @stats = ();
1944     my $commits;
1945 
1946     $vcs_used = vcs_exists();
1947     return if (!$vcs_used);
1948 
1949     my $cmd = $VCS_cmds{"find_signers_cmd"};
1950     $cmd =~ s/(\$\w+)/$1/eeg;       # interpolate $cmd
1951 
1952     ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1953 
1954     @signers = @{$signers_ref} if defined $signers_ref;
1955     @authors = @{$authors_ref} if defined $authors_ref;
1956     @stats = @{$stats_ref} if defined $stats_ref;
1957 
1958 #    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1959 
1960     foreach my $signer (@signers) {
1961     $signer = deduplicate_email($signer);
1962     }
1963 
1964     vcs_assign("commit_signer", $commits, @signers);
1965     vcs_assign("authored", $commits, @authors);
1966     if ($#authors == $#stats) {
1967     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1968     $stat_pattern =~ s/(\$\w+)/$1/eeg;  #interpolate $stat_pattern
1969 
1970     my $added = 0;
1971     my $deleted = 0;
1972     for (my $i = 0; $i <= $#stats; $i++) {
1973         if ($stats[$i] =~ /$stat_pattern/) {
1974         $added += $1;
1975         $deleted += $2;
1976         }
1977     }
1978     my @tmp_authors = uniq(@authors);
1979     foreach my $author (@tmp_authors) {
1980         $author = deduplicate_email($author);
1981     }
1982     @tmp_authors = uniq(@tmp_authors);
1983     my @list_added = ();
1984     my @list_deleted = ();
1985     foreach my $author (@tmp_authors) {
1986         my $auth_added = 0;
1987         my $auth_deleted = 0;
1988         for (my $i = 0; $i <= $#stats; $i++) {
1989         if ($author eq deduplicate_email($authors[$i]) &&
1990             $stats[$i] =~ /$stat_pattern/) {
1991             $auth_added += $1;
1992             $auth_deleted += $2;
1993         }
1994         }
1995         for (my $i = 0; $i < $auth_added; $i++) {
1996         push(@list_added, $author);
1997         }
1998         for (my $i = 0; $i < $auth_deleted; $i++) {
1999         push(@list_deleted, $author);
2000         }
2001     }
2002     vcs_assign("added_lines", $added, @list_added);
2003     vcs_assign("removed_lines", $deleted, @list_deleted);
2004     }
2005 }
2006 
2007 sub vcs_file_blame {
2008     my ($file) = @_;
2009 
2010     my @signers = ();
2011     my @all_commits = ();
2012     my @commits = ();
2013     my $total_commits;
2014     my $total_lines;
2015 
2016     $vcs_used = vcs_exists();
2017     return if (!$vcs_used);
2018 
2019     @all_commits = vcs_blame($file);
2020     @commits = uniq(@all_commits);
2021     $total_commits = @commits;
2022     $total_lines = @all_commits;
2023 
2024     if ($email_git_blame_signatures) {
2025     if (vcs_is_hg()) {
2026         my $commit_count;
2027         my $commit_authors_ref;
2028         my $commit_signers_ref;
2029         my $stats_ref;
2030         my @commit_authors = ();
2031         my @commit_signers = ();
2032         my $commit = join(" -r ", @commits);
2033         my $cmd;
2034 
2035         $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2036         $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2037 
2038         ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2039         @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2040         @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2041 
2042         push(@signers, @commit_signers);
2043     } else {
2044         foreach my $commit (@commits) {
2045         my $commit_count;
2046         my $commit_authors_ref;
2047         my $commit_signers_ref;
2048         my $stats_ref;
2049         my @commit_authors = ();
2050         my @commit_signers = ();
2051         my $cmd;
2052 
2053         $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2054         $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2055 
2056         ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2057         @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2058         @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2059 
2060         push(@signers, @commit_signers);
2061         }
2062     }
2063     }
2064 
2065     if ($from_filename) {
2066     if ($output_rolestats) {
2067         my @blame_signers;
2068         if (vcs_is_hg()) {{     # Double brace for last exit
2069         my $commit_count;
2070         my @commit_signers = ();
2071         @commits = uniq(@commits);
2072         @commits = sort(@commits);
2073         my $commit = join(" -r ", @commits);
2074         my $cmd;
2075 
2076         $cmd = $VCS_cmds{"find_commit_author_cmd"};
2077         $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2078 
2079         my @lines = ();
2080 
2081         @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2082 
2083         if (!$email_git_penguin_chiefs) {
2084             @lines = grep(!/${penguin_chiefs}/i, @lines);
2085         }
2086 
2087         last if !@lines;
2088 
2089         my @authors = ();
2090         foreach my $line (@lines) {
2091             if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2092             my $author = $1;
2093             $author = deduplicate_email($author);
2094             push(@authors, $author);
2095             }
2096         }
2097 
2098         save_commits_by_author(@lines) if ($interactive);
2099         save_commits_by_signer(@lines) if ($interactive);
2100 
2101         push(@signers, @authors);
2102         }}
2103         else {
2104         foreach my $commit (@commits) {
2105             my $i;
2106             my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2107             $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2108             my @author = vcs_find_author($cmd);
2109             next if !@author;
2110 
2111             my $formatted_author = deduplicate_email($author[0]);
2112 
2113             my $count = grep(/$commit/, @all_commits);
2114             for ($i = 0; $i < $count ; $i++) {
2115             push(@blame_signers, $formatted_author);
2116             }
2117         }
2118         }
2119         if (@blame_signers) {
2120         vcs_assign("authored lines", $total_lines, @blame_signers);
2121         }
2122     }
2123     foreach my $signer (@signers) {
2124         $signer = deduplicate_email($signer);
2125     }
2126     vcs_assign("commits", $total_commits, @signers);
2127     } else {
2128     foreach my $signer (@signers) {
2129         $signer = deduplicate_email($signer);
2130     }
2131     vcs_assign("modified commits", $total_commits, @signers);
2132     }
2133 }
2134 
2135 sub vcs_file_exists {
2136     my ($file) = @_;
2137 
2138     my $exists;
2139 
2140     my $vcs_used = vcs_exists();
2141     return 0 if (!$vcs_used);
2142 
2143     my $cmd = $VCS_cmds{"file_exists_cmd"};
2144     $cmd =~ s/(\$\w+)/$1/eeg;       # interpolate $cmd
2145     $cmd .= " 2>&1";
2146     $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2147 
2148     return 0 if ($? != 0);
2149 
2150     return $exists;
2151 }
2152 
2153 sub uniq {
2154     my (@parms) = @_;
2155 
2156     my %saw;
2157     @parms = grep(!$saw{$_}++, @parms);
2158     return @parms;
2159 }
2160 
2161 sub sort_and_uniq {
2162     my (@parms) = @_;
2163 
2164     my %saw;
2165     @parms = sort @parms;
2166     @parms = grep(!$saw{$_}++, @parms);
2167     return @parms;
2168 }
2169 
2170 sub clean_file_emails {
2171     my (@file_emails) = @_;
2172     my @fmt_emails = ();
2173 
2174     foreach my $email (@file_emails) {
2175     $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2176     my ($name, $address) = parse_email($email);
2177     if ($name eq '"[,\.]"') {
2178         $name = "";
2179     }
2180 
2181     my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2182     if (@nw > 2) {
2183         my $first = $nw[@nw - 3];
2184         my $middle = $nw[@nw - 2];
2185         my $last = $nw[@nw - 1];
2186 
2187         if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2188          (length($first) == 2 && substr($first, -1) eq ".")) ||
2189         (length($middle) == 1 ||
2190          (length($middle) == 2 && substr($middle, -1) eq "."))) {
2191         $name = "$first $middle $last";
2192         } else {
2193         $name = "$middle $last";
2194         }
2195     }
2196 
2197     if (substr($name, -1) =~ /[,\.]/) {
2198         $name = substr($name, 0, length($name) - 1);
2199     } elsif (substr($name, -2) =~ /[,\.]"/) {
2200         $name = substr($name, 0, length($name) - 2) . '"';
2201     }
2202 
2203     if (substr($name, 0, 1) =~ /[,\.]/) {
2204         $name = substr($name, 1, length($name) - 1);
2205     } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2206         $name = '"' . substr($name, 2, length($name) - 2);
2207     }
2208 
2209     my $fmt_email = format_email($name, $address, $email_usename);
2210     push(@fmt_emails, $fmt_email);
2211     }
2212     return @fmt_emails;
2213 }
2214 
2215 sub merge_email {
2216     my @lines;
2217     my %saw;
2218 
2219     for (@_) {
2220     my ($address, $role) = @$_;
2221     if (!$saw{$address}) {
2222         if ($output_roles) {
2223         push(@lines, "$address ($role)");
2224         } else {
2225         push(@lines, $address);
2226         }
2227         $saw{$address} = 1;
2228     }
2229     }
2230 
2231     return @lines;
2232 }
2233 
2234 sub output {
2235     my (@parms) = @_;
2236 
2237     if ($output_multiline) {
2238     foreach my $line (@parms) {
2239         print("${line}\n");
2240     }
2241     } else {
2242     print(join($output_separator, @parms));
2243     print("\n");
2244     }
2245 }
2246 
2247 my $rfc822re;
2248 
2249 sub make_rfc822re {
2250 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2251 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2252 #   This regexp will only work on addresses which have had comments stripped
2253 #   and replaced with rfc822_lwsp.
2254 
2255     my $specials = '()<>@,;:\\\\".\\[\\]';
2256     my $controls = '\\000-\\037\\177';
2257 
2258     my $dtext = "[^\\[\\]\\r\\\\]";
2259     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2260 
2261     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2262 
2263 #   Use zero-width assertion to spot the limit of an atom.  A simple
2264 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2265     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2266     my $word = "(?:$atom|$quoted_string)";
2267     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2268 
2269     my $sub_domain = "(?:$atom|$domain_literal)";
2270     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2271 
2272     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2273 
2274     my $phrase = "$word*";
2275     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2276     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2277     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2278 
2279     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2280     my $address = "(?:$mailbox|$group)";
2281 
2282     return "$rfc822_lwsp*$address";
2283 }
2284 
2285 sub rfc822_strip_comments {
2286     my $s = shift;
2287 #   Recursively remove comments, and replace with a single space.  The simpler
2288 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2289 #   chars in atoms, for example.
2290 
2291     while ($s =~ s/^((?:[^"\\]|\\.)*
2292                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2293                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2294     return $s;
2295 }
2296 
2297 #   valid: returns true if the parameter is an RFC822 valid address
2298 #
2299 sub rfc822_valid {
2300     my $s = rfc822_strip_comments(shift);
2301 
2302     if (!$rfc822re) {
2303         $rfc822re = make_rfc822re();
2304     }
2305 
2306     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2307 }
2308 
2309 #   validlist: In scalar context, returns true if the parameter is an RFC822
2310 #              valid list of addresses.
2311 #
2312 #              In list context, returns an empty list on failure (an invalid
2313 #              address was found); otherwise a list whose first element is the
2314 #              number of addresses found and whose remaining elements are the
2315 #              addresses.  This is needed to disambiguate failure (invalid)
2316 #              from success with no addresses found, because an empty string is
2317 #              a valid list.
2318 
2319 sub rfc822_validlist {
2320     my $s = rfc822_strip_comments(shift);
2321 
2322     if (!$rfc822re) {
2323         $rfc822re = make_rfc822re();
2324     }
2325     # * null list items are valid according to the RFC
2326     # * the '1' business is to aid in distinguishing failure from no results
2327 
2328     my @r;
2329     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2330     $s =~ m/^$rfc822_char*$/) {
2331         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2332             push(@r, $1);
2333         }
2334         return wantarray ? (scalar(@r), @r) : 1;
2335     }
2336     return wantarray ? () : 0;
2337 }