Back to home page

OSCL-LXR

 
 

    


0001 #!/usr/bin/env perl
0002 # SPDX-License-Identifier: GPL-2.0
0003 #
0004 # (c) 2007, Joe Perches <joe@perches.com>
0005 #           created from checkpatch.pl
0006 #
0007 # Print selected MAINTAINERS information for
0008 # the files modified in a patch or for a file
0009 #
0010 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
0011 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
0012 
0013 use warnings;
0014 use strict;
0015 
0016 my $P = $0;
0017 my $V = '0.26';
0018 
0019 use Getopt::Long qw(:config no_auto_abbrev);
0020 use Cwd;
0021 use File::Find;
0022 use File::Spec::Functions;
0023 
0024 my $cur_path = fastgetcwd() . '/';
0025 my $lk_path = "./";
0026 my $email = 1;
0027 my $email_usename = 1;
0028 my $email_maintainer = 1;
0029 my $email_reviewer = 1;
0030 my $email_fixes = 1;
0031 my $email_list = 1;
0032 my $email_moderated_list = 1;
0033 my $email_subscriber_list = 0;
0034 my $email_git_penguin_chiefs = 0;
0035 my $email_git = 0;
0036 my $email_git_all_signature_types = 0;
0037 my $email_git_blame = 0;
0038 my $email_git_blame_signatures = 1;
0039 my $email_git_fallback = 1;
0040 my $email_git_min_signatures = 1;
0041 my $email_git_max_maintainers = 5;
0042 my $email_git_min_percent = 5;
0043 my $email_git_since = "1-year-ago";
0044 my $email_hg_since = "-365";
0045 my $interactive = 0;
0046 my $email_remove_duplicates = 1;
0047 my $email_use_mailmap = 1;
0048 my $output_multiline = 1;
0049 my $output_separator = ", ";
0050 my $output_roles = 0;
0051 my $output_rolestats = 1;
0052 my $output_section_maxlen = 50;
0053 my $scm = 0;
0054 my $tree = 1;
0055 my $web = 0;
0056 my $subsystem = 0;
0057 my $status = 0;
0058 my $letters = "";
0059 my $keywords = 1;
0060 my $sections = 0;
0061 my $email_file_emails = 0;
0062 my $from_filename = 0;
0063 my $pattern_depth = 0;
0064 my $self_test = undef;
0065 my $version = 0;
0066 my $help = 0;
0067 my $find_maintainer_files = 0;
0068 my $maintainer_path;
0069 my $vcs_used = 0;
0070 
0071 my $exit = 0;
0072 
0073 my @files = ();
0074 my @fixes = ();         # If a patch description includes Fixes: lines
0075 my @range = ();
0076 my @keyword_tvi = ();
0077 my @file_emails = ();
0078 
0079 my %commit_author_hash;
0080 my %commit_signer_hash;
0081 
0082 my @penguin_chief = ();
0083 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
0084 #Andrew wants in on most everything - 2009/01/14
0085 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
0086 
0087 my @penguin_chief_names = ();
0088 foreach my $chief (@penguin_chief) {
0089     if ($chief =~ m/^(.*):(.*)/) {
0090     my $chief_name = $1;
0091     my $chief_addr = $2;
0092     push(@penguin_chief_names, $chief_name);
0093     }
0094 }
0095 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
0096 
0097 # Signature types of people who are either
0098 #   a) responsible for the code in question, or
0099 #   b) familiar enough with it to give relevant feedback
0100 my @signature_tags = ();
0101 push(@signature_tags, "Signed-off-by:");
0102 push(@signature_tags, "Reviewed-by:");
0103 push(@signature_tags, "Acked-by:");
0104 
0105 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
0106 
0107 # rfc822 email address - preloaded methods go here.
0108 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
0109 my $rfc822_char = '[\\000-\\377]';
0110 
0111 # VCS command support: class-like functions and strings
0112 
0113 my %VCS_cmds;
0114 
0115 my %VCS_cmds_git = (
0116     "execute_cmd" => \&git_execute_cmd,
0117     "available" => '(which("git") ne "") && (-e ".git")',
0118     "find_signers_cmd" =>
0119     "git log --no-color --follow --since=\$email_git_since " .
0120         '--numstat --no-merges ' .
0121         '--format="GitCommit: %H%n' .
0122               'GitAuthor: %an <%ae>%n' .
0123               'GitDate: %aD%n' .
0124               'GitSubject: %s%n' .
0125               '%b%n"' .
0126         " -- \$file",
0127     "find_commit_signers_cmd" =>
0128     "git log --no-color " .
0129         '--numstat ' .
0130         '--format="GitCommit: %H%n' .
0131               'GitAuthor: %an <%ae>%n' .
0132               'GitDate: %aD%n' .
0133               'GitSubject: %s%n' .
0134               '%b%n"' .
0135         " -1 \$commit",
0136     "find_commit_author_cmd" =>
0137     "git log --no-color " .
0138         '--numstat ' .
0139         '--format="GitCommit: %H%n' .
0140               'GitAuthor: %an <%ae>%n' .
0141               'GitDate: %aD%n' .
0142               'GitSubject: %s%n"' .
0143         " -1 \$commit",
0144     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
0145     "blame_file_cmd" => "git blame -l \$file",
0146     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
0147     "blame_commit_pattern" => "^([0-9a-f]+) ",
0148     "author_pattern" => "^GitAuthor: (.*)",
0149     "subject_pattern" => "^GitSubject: (.*)",
0150     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
0151     "file_exists_cmd" => "git ls-files \$file",
0152     "list_files_cmd" => "git ls-files \$file",
0153 );
0154 
0155 my %VCS_cmds_hg = (
0156     "execute_cmd" => \&hg_execute_cmd,
0157     "available" => '(which("hg") ne "") && (-d ".hg")',
0158     "find_signers_cmd" =>
0159     "hg log --date=\$email_hg_since " .
0160         "--template='HgCommit: {node}\\n" .
0161                     "HgAuthor: {author}\\n" .
0162             "HgSubject: {desc}\\n'" .
0163         " -- \$file",
0164     "find_commit_signers_cmd" =>
0165     "hg log " .
0166         "--template='HgSubject: {desc}\\n'" .
0167         " -r \$commit",
0168     "find_commit_author_cmd" =>
0169     "hg log " .
0170         "--template='HgCommit: {node}\\n" .
0171                 "HgAuthor: {author}\\n" .
0172             "HgSubject: {desc|firstline}\\n'" .
0173         " -r \$commit",
0174     "blame_range_cmd" => "",        # not supported
0175     "blame_file_cmd" => "hg blame -n \$file",
0176     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
0177     "blame_commit_pattern" => "^([ 0-9a-f]+):",
0178     "author_pattern" => "^HgAuthor: (.*)",
0179     "subject_pattern" => "^HgSubject: (.*)",
0180     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
0181     "file_exists_cmd" => "hg files \$file",
0182     "list_files_cmd" => "hg manifest -R \$file",
0183 );
0184 
0185 my $conf = which_conf(".get_maintainer.conf");
0186 if (-f $conf) {
0187     my @conf_args;
0188     open(my $conffile, '<', "$conf")
0189     or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
0190 
0191     while (<$conffile>) {
0192     my $line = $_;
0193 
0194     $line =~ s/\s*\n?$//g;
0195     $line =~ s/^\s*//g;
0196     $line =~ s/\s+/ /g;
0197 
0198     next if ($line =~ m/^\s*#/);
0199     next if ($line =~ m/^\s*$/);
0200 
0201     my @words = split(" ", $line);
0202     foreach my $word (@words) {
0203         last if ($word =~ m/^#/);
0204         push (@conf_args, $word);
0205     }
0206     }
0207     close($conffile);
0208     unshift(@ARGV, @conf_args) if @conf_args;
0209 }
0210 
0211 my @ignore_emails = ();
0212 my $ignore_file = which_conf(".get_maintainer.ignore");
0213 if (-f $ignore_file) {
0214     open(my $ignore, '<', "$ignore_file")
0215     or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
0216     while (<$ignore>) {
0217     my $line = $_;
0218 
0219     $line =~ s/\s*\n?$//;
0220     $line =~ s/^\s*//;
0221     $line =~ s/\s+$//;
0222     $line =~ s/#.*$//;
0223 
0224     next if ($line =~ m/^\s*$/);
0225     if (rfc822_valid($line)) {
0226         push(@ignore_emails, $line);
0227     }
0228     }
0229     close($ignore);
0230 }
0231 
0232 if ($#ARGV > 0) {
0233     foreach (@ARGV) {
0234         if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
0235             die "$P: using --self-test does not allow any other option or argument\n";
0236         }
0237     }
0238 }
0239 
0240 if (!GetOptions(
0241         'email!' => \$email,
0242         'git!' => \$email_git,
0243         'git-all-signature-types!' => \$email_git_all_signature_types,
0244         'git-blame!' => \$email_git_blame,
0245         'git-blame-signatures!' => \$email_git_blame_signatures,
0246         'git-fallback!' => \$email_git_fallback,
0247         'git-chief-penguins!' => \$email_git_penguin_chiefs,
0248         'git-min-signatures=i' => \$email_git_min_signatures,
0249         'git-max-maintainers=i' => \$email_git_max_maintainers,
0250         'git-min-percent=i' => \$email_git_min_percent,
0251         'git-since=s' => \$email_git_since,
0252         'hg-since=s' => \$email_hg_since,
0253         'i|interactive!' => \$interactive,
0254         'remove-duplicates!' => \$email_remove_duplicates,
0255         'mailmap!' => \$email_use_mailmap,
0256         'm!' => \$email_maintainer,
0257         'r!' => \$email_reviewer,
0258         'n!' => \$email_usename,
0259         'l!' => \$email_list,
0260         'fixes!' => \$email_fixes,
0261         'moderated!' => \$email_moderated_list,
0262         's!' => \$email_subscriber_list,
0263         'multiline!' => \$output_multiline,
0264         'roles!' => \$output_roles,
0265         'rolestats!' => \$output_rolestats,
0266         'separator=s' => \$output_separator,
0267         'subsystem!' => \$subsystem,
0268         'status!' => \$status,
0269         'scm!' => \$scm,
0270         'tree!' => \$tree,
0271         'web!' => \$web,
0272         'letters=s' => \$letters,
0273         'pattern-depth=i' => \$pattern_depth,
0274         'k|keywords!' => \$keywords,
0275         'sections!' => \$sections,
0276         'fe|file-emails!' => \$email_file_emails,
0277         'f|file' => \$from_filename,
0278         'find-maintainer-files' => \$find_maintainer_files,
0279         'mpath|maintainer-path=s' => \$maintainer_path,
0280         'self-test:s' => \$self_test,
0281         'v|version' => \$version,
0282         'h|help|usage' => \$help,
0283         )) {
0284     die "$P: invalid argument - use --help if necessary\n";
0285 }
0286 
0287 if ($help != 0) {
0288     usage();
0289     exit 0;
0290 }
0291 
0292 if ($version != 0) {
0293     print("${P} ${V}\n");
0294     exit 0;
0295 }
0296 
0297 if (defined $self_test) {
0298     read_all_maintainer_files();
0299     self_test();
0300     exit 0;
0301 }
0302 
0303 if (-t STDIN && !@ARGV) {
0304     # We're talking to a terminal, but have no command line arguments.
0305     die "$P: missing patchfile or -f file - use --help if necessary\n";
0306 }
0307 
0308 $output_multiline = 0 if ($output_separator ne ", ");
0309 $output_rolestats = 1 if ($interactive);
0310 $output_roles = 1 if ($output_rolestats);
0311 
0312 if ($sections || $letters ne "") {
0313     $sections = 1;
0314     $email = 0;
0315     $email_list = 0;
0316     $scm = 0;
0317     $status = 0;
0318     $subsystem = 0;
0319     $web = 0;
0320     $keywords = 0;
0321     $interactive = 0;
0322 } else {
0323     my $selections = $email + $scm + $status + $subsystem + $web;
0324     if ($selections == 0) {
0325     die "$P:  Missing required option: email, scm, status, subsystem or web\n";
0326     }
0327 }
0328 
0329 if ($email &&
0330     ($email_maintainer + $email_reviewer +
0331      $email_list + $email_subscriber_list +
0332      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
0333     die "$P: Please select at least 1 email option\n";
0334 }
0335 
0336 if ($tree && !top_of_kernel_tree($lk_path)) {
0337     die "$P: The current directory does not appear to be "
0338     . "a linux kernel source tree.\n";
0339 }
0340 
0341 ## Read MAINTAINERS for type/value pairs
0342 
0343 my @typevalue = ();
0344 my %keyword_hash;
0345 my @mfiles = ();
0346 my @self_test_info = ();
0347 
0348 sub read_maintainer_file {
0349     my ($file) = @_;
0350 
0351     open (my $maint, '<', "$file")
0352     or die "$P: Can't open MAINTAINERS file '$file': $!\n";
0353     my $i = 1;
0354     while (<$maint>) {
0355     my $line = $_;
0356     chomp $line;
0357 
0358     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0359         my $type = $1;
0360         my $value = $2;
0361 
0362         ##Filename pattern matching
0363         if ($type eq "F" || $type eq "X") {
0364         $value =~ s@\.@\\\.@g;       ##Convert . to \.
0365         $value =~ s/\*/\.\*/g;       ##Convert * to .*
0366         $value =~ s/\?/\./g;         ##Convert ? to .
0367         ##if pattern is a directory and it lacks a trailing slash, add one
0368         if ((-d $value)) {
0369             $value =~ s@([^/])$@$1/@;
0370         }
0371         } elsif ($type eq "K") {
0372         $keyword_hash{@typevalue} = $value;
0373         }
0374         push(@typevalue, "$type:$value");
0375     } elsif (!(/^\s*$/ || /^\s*\#/)) {
0376         push(@typevalue, $line);
0377     }
0378     if (defined $self_test) {
0379         push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
0380     }
0381     $i++;
0382     }
0383     close($maint);
0384 }
0385 
0386 sub find_is_maintainer_file {
0387     my ($file) = $_;
0388     return if ($file !~ m@/MAINTAINERS$@);
0389     $file = $File::Find::name;
0390     return if (! -f $file);
0391     push(@mfiles, $file);
0392 }
0393 
0394 sub find_ignore_git {
0395     return grep { $_ !~ /^\.git$/; } @_;
0396 }
0397 
0398 read_all_maintainer_files();
0399 
0400 sub read_all_maintainer_files {
0401     my $path = "${lk_path}MAINTAINERS";
0402     if (defined $maintainer_path) {
0403     $path = $maintainer_path;
0404     # Perl Cookbook tilde expansion if necessary
0405     $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
0406     }
0407 
0408     if (-d $path) {
0409     $path .= '/' if ($path !~ m@/$@);
0410     if ($find_maintainer_files) {
0411         find( { wanted => \&find_is_maintainer_file,
0412             preprocess => \&find_ignore_git,
0413             no_chdir => 1,
0414         }, "$path");
0415     } else {
0416         opendir(DIR, "$path") or die $!;
0417         my @files = readdir(DIR);
0418         closedir(DIR);
0419         foreach my $file (@files) {
0420         push(@mfiles, "$path$file") if ($file !~ /^\./);
0421         }
0422     }
0423     } elsif (-f "$path") {
0424     push(@mfiles, "$path");
0425     } else {
0426     die "$P: MAINTAINER file not found '$path'\n";
0427     }
0428     die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
0429     foreach my $file (@mfiles) {
0430     read_maintainer_file("$file");
0431     }
0432 }
0433 
0434 sub maintainers_in_file {
0435     my ($file) = @_;
0436 
0437     return if ($file =~ m@\bMAINTAINERS$@);
0438 
0439     if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) {
0440     open(my $f, '<', $file)
0441         or die "$P: Can't open $file: $!\n";
0442     my $text = do { local($/) ; <$f> };
0443     close($f);
0444 
0445     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;
0446     push(@file_emails, clean_file_emails(@poss_addr));
0447     }
0448 }
0449 
0450 #
0451 # Read mail address map
0452 #
0453 
0454 my $mailmap;
0455 
0456 read_mailmap();
0457 
0458 sub read_mailmap {
0459     $mailmap = {
0460     names => {},
0461     addresses => {}
0462     };
0463 
0464     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
0465 
0466     open(my $mailmap_file, '<', "${lk_path}.mailmap")
0467     or warn "$P: Can't open .mailmap: $!\n";
0468 
0469     while (<$mailmap_file>) {
0470     s/#.*$//; #strip comments
0471     s/^\s+|\s+$//g; #trim
0472 
0473     next if (/^\s*$/); #skip empty lines
0474     #entries have one of the following formats:
0475     # name1 <mail1>
0476     # <mail1> <mail2>
0477     # name1 <mail1> <mail2>
0478     # name1 <mail1> name2 <mail2>
0479     # (see man git-shortlog)
0480 
0481     if (/^([^<]+)<([^>]+)>$/) {
0482         my $real_name = $1;
0483         my $address = $2;
0484 
0485         $real_name =~ s/\s+$//;
0486         ($real_name, $address) = parse_email("$real_name <$address>");
0487         $mailmap->{names}->{$address} = $real_name;
0488 
0489     } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
0490         my $real_address = $1;
0491         my $wrong_address = $2;
0492 
0493         $mailmap->{addresses}->{$wrong_address} = $real_address;
0494 
0495     } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
0496         my $real_name = $1;
0497         my $real_address = $2;
0498         my $wrong_address = $3;
0499 
0500         $real_name =~ s/\s+$//;
0501         ($real_name, $real_address) =
0502         parse_email("$real_name <$real_address>");
0503         $mailmap->{names}->{$wrong_address} = $real_name;
0504         $mailmap->{addresses}->{$wrong_address} = $real_address;
0505 
0506     } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
0507         my $real_name = $1;
0508         my $real_address = $2;
0509         my $wrong_name = $3;
0510         my $wrong_address = $4;
0511 
0512         $real_name =~ s/\s+$//;
0513         ($real_name, $real_address) =
0514         parse_email("$real_name <$real_address>");
0515 
0516         $wrong_name =~ s/\s+$//;
0517         ($wrong_name, $wrong_address) =
0518         parse_email("$wrong_name <$wrong_address>");
0519 
0520         my $wrong_email = format_email($wrong_name, $wrong_address, 1);
0521         $mailmap->{names}->{$wrong_email} = $real_name;
0522         $mailmap->{addresses}->{$wrong_email} = $real_address;
0523     }
0524     }
0525     close($mailmap_file);
0526 }
0527 
0528 ## use the filenames on the command line or find the filenames in the patchfiles
0529 
0530 if (!@ARGV) {
0531     push(@ARGV, "&STDIN");
0532 }
0533 
0534 foreach my $file (@ARGV) {
0535     if ($file ne "&STDIN") {
0536     $file = canonpath($file);
0537     ##if $file is a directory and it lacks a trailing slash, add one
0538     if ((-d $file)) {
0539         $file =~ s@([^/])$@$1/@;
0540     } elsif (!(-f $file)) {
0541         die "$P: file '${file}' not found\n";
0542     }
0543     }
0544     if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) {
0545     warn "$P: file '$file' not found in version control $!\n";
0546     }
0547     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
0548     $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
0549     $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
0550     push(@files, $file);
0551     if ($file ne "MAINTAINERS" && -f $file && $keywords) {
0552         open(my $f, '<', $file)
0553         or die "$P: Can't open $file: $!\n";
0554         my $text = do { local($/) ; <$f> };
0555         close($f);
0556         if ($keywords) {
0557         foreach my $line (keys %keyword_hash) {
0558             if ($text =~ m/$keyword_hash{$line}/x) {
0559             push(@keyword_tvi, $line);
0560             }
0561         }
0562         }
0563     }
0564     } else {
0565     my $file_cnt = @files;
0566     my $lastfile;
0567 
0568     open(my $patch, "< $file")
0569         or die "$P: Can't open $file: $!\n";
0570 
0571     # We can check arbitrary information before the patch
0572     # like the commit message, mail headers, etc...
0573     # This allows us to match arbitrary keywords against any part
0574     # of a git format-patch generated file (subject tags, etc...)
0575 
0576     my $patch_prefix = "";          #Parsing the intro
0577 
0578     while (<$patch>) {
0579         my $patch_line = $_;
0580         if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
0581         my $filename = $1;
0582         push(@files, $filename);
0583         } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
0584         my $filename = $1;
0585         push(@files, $filename);
0586         } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
0587         my $filename1 = $1;
0588         my $filename2 = $2;
0589         push(@files, $filename1);
0590         push(@files, $filename2);
0591         } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) {
0592         push(@fixes, $1) if ($email_fixes);
0593         } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
0594         my $filename = $1;
0595         $filename =~ s@^[^/]*/@@;
0596         $filename =~ s@\n@@;
0597         $lastfile = $filename;
0598         push(@files, $filename);
0599         $patch_prefix = "^[+-].*";  #Now parsing the actual patch
0600         } elsif (m/^\@\@ -(\d+),(\d+)/) {
0601         if ($email_git_blame) {
0602             push(@range, "$lastfile:$1:$2");
0603         }
0604         } elsif ($keywords) {
0605         foreach my $line (keys %keyword_hash) {
0606             if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
0607             push(@keyword_tvi, $line);
0608             }
0609         }
0610         }
0611     }
0612     close($patch);
0613 
0614     if ($file_cnt == @files) {
0615         warn "$P: file '${file}' doesn't appear to be a patch.  "
0616         . "Add -f to options?\n";
0617     }
0618     @files = sort_and_uniq(@files);
0619     }
0620 }
0621 
0622 @file_emails = uniq(@file_emails);
0623 @fixes = uniq(@fixes);
0624 
0625 my %email_hash_name;
0626 my %email_hash_address;
0627 my @email_to = ();
0628 my %hash_list_to;
0629 my @list_to = ();
0630 my @scm = ();
0631 my @web = ();
0632 my @subsystem = ();
0633 my @status = ();
0634 my %deduplicate_name_hash = ();
0635 my %deduplicate_address_hash = ();
0636 
0637 my @maintainers = get_maintainers();
0638 if (@maintainers) {
0639     @maintainers = merge_email(@maintainers);
0640     output(@maintainers);
0641 }
0642 
0643 if ($scm) {
0644     @scm = uniq(@scm);
0645     output(@scm);
0646 }
0647 
0648 if ($status) {
0649     @status = uniq(@status);
0650     output(@status);
0651 }
0652 
0653 if ($subsystem) {
0654     @subsystem = uniq(@subsystem);
0655     output(@subsystem);
0656 }
0657 
0658 if ($web) {
0659     @web = uniq(@web);
0660     output(@web);
0661 }
0662 
0663 exit($exit);
0664 
0665 sub self_test {
0666     my @lsfiles = ();
0667     my @good_links = ();
0668     my @bad_links = ();
0669     my @section_headers = ();
0670     my $index = 0;
0671 
0672     @lsfiles = vcs_list_files($lk_path);
0673 
0674     for my $x (@self_test_info) {
0675     $index++;
0676 
0677     ## Section header duplication and missing section content
0678     if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
0679         $x->{line} =~ /^\S[^:]/ &&
0680         defined $self_test_info[$index] &&
0681         $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
0682         my $has_S = 0;
0683         my $has_F = 0;
0684         my $has_ML = 0;
0685         my $status = "";
0686         if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
0687         print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
0688         } else {
0689         push(@section_headers, $x->{line});
0690         }
0691         my $nextline = $index;
0692         while (defined $self_test_info[$nextline] &&
0693            $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
0694         my $type = $1;
0695         my $value = $2;
0696         if ($type eq "S") {
0697             $has_S = 1;
0698             $status = $value;
0699         } elsif ($type eq "F" || $type eq "N") {
0700             $has_F = 1;
0701         } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
0702             $has_ML = 1;
0703         }
0704         $nextline++;
0705         }
0706         if (!$has_ML && $status !~ /orphan|obsolete/i) {
0707         print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
0708         }
0709         if (!$has_S) {
0710         print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
0711         }
0712         if (!$has_F) {
0713         print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
0714         }
0715     }
0716 
0717     next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
0718 
0719     my $type = $1;
0720     my $value = $2;
0721 
0722     ## Filename pattern matching
0723     if (($type eq "F" || $type eq "X") &&
0724         ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
0725         $value =~ s@\.@\\\.@g;       ##Convert . to \.
0726         $value =~ s/\*/\.\*/g;       ##Convert * to .*
0727         $value =~ s/\?/\./g;         ##Convert ? to .
0728         ##if pattern is a directory and it lacks a trailing slash, add one
0729         if ((-d $value)) {
0730         $value =~ s@([^/])$@$1/@;
0731         }
0732         if (!grep(m@^$value@, @lsfiles)) {
0733         print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
0734         }
0735 
0736     ## Link reachability
0737     } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
0738          $value =~ /^https?:/ &&
0739          ($self_test eq "" || $self_test =~ /\blinks\b/)) {
0740         next if (grep(m@^\Q$value\E$@, @good_links));
0741         my $isbad = 0;
0742         if (grep(m@^\Q$value\E$@, @bad_links)) {
0743             $isbad = 1;
0744         } else {
0745         my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
0746         if ($? == 0) {
0747             push(@good_links, $value);
0748         } else {
0749             push(@bad_links, $value);
0750             $isbad = 1;
0751         }
0752         }
0753         if ($isbad) {
0754             print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
0755         }
0756 
0757     ## SCM reachability
0758     } elsif ($type eq "T" &&
0759          ($self_test eq "" || $self_test =~ /\bscm\b/)) {
0760         next if (grep(m@^\Q$value\E$@, @good_links));
0761         my $isbad = 0;
0762         if (grep(m@^\Q$value\E$@, @bad_links)) {
0763             $isbad = 1;
0764             } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
0765         print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
0766         } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
0767         my $url = $1;
0768         my $branch = "";
0769         $branch = $3 if $3;
0770         my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
0771         if ($? == 0) {
0772             push(@good_links, $value);
0773         } else {
0774             push(@bad_links, $value);
0775             $isbad = 1;
0776         }
0777         } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
0778         my $url = $1;
0779         my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
0780         if ($? == 0) {
0781             push(@good_links, $value);
0782         } else {
0783             push(@bad_links, $value);
0784             $isbad = 1;
0785         }
0786         }
0787         if ($isbad) {
0788         print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
0789         }
0790     }
0791     }
0792 }
0793 
0794 sub ignore_email_address {
0795     my ($address) = @_;
0796 
0797     foreach my $ignore (@ignore_emails) {
0798     return 1 if ($ignore eq $address);
0799     }
0800 
0801     return 0;
0802 }
0803 
0804 sub range_is_maintained {
0805     my ($start, $end) = @_;
0806 
0807     for (my $i = $start; $i < $end; $i++) {
0808     my $line = $typevalue[$i];
0809     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0810         my $type = $1;
0811         my $value = $2;
0812         if ($type eq 'S') {
0813         if ($value =~ /(maintain|support)/i) {
0814             return 1;
0815         }
0816         }
0817     }
0818     }
0819     return 0;
0820 }
0821 
0822 sub range_has_maintainer {
0823     my ($start, $end) = @_;
0824 
0825     for (my $i = $start; $i < $end; $i++) {
0826     my $line = $typevalue[$i];
0827     if ($line =~ m/^([A-Z]):\s*(.*)/) {
0828         my $type = $1;
0829         my $value = $2;
0830         if ($type eq 'M') {
0831         return 1;
0832         }
0833     }
0834     }
0835     return 0;
0836 }
0837 
0838 sub get_maintainers {
0839     %email_hash_name = ();
0840     %email_hash_address = ();
0841     %commit_author_hash = ();
0842     %commit_signer_hash = ();
0843     @email_to = ();
0844     %hash_list_to = ();
0845     @list_to = ();
0846     @scm = ();
0847     @web = ();
0848     @subsystem = ();
0849     @status = ();
0850     %deduplicate_name_hash = ();
0851     %deduplicate_address_hash = ();
0852     if ($email_git_all_signature_types) {
0853     $signature_pattern = "(.+?)[Bb][Yy]:";
0854     } else {
0855     $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
0856     }
0857 
0858     # Find responsible parties
0859 
0860     my %exact_pattern_match_hash = ();
0861 
0862     foreach my $file (@files) {
0863 
0864     my %hash;
0865     my $tvi = find_first_section();
0866     while ($tvi < @typevalue) {
0867         my $start = find_starting_index($tvi);
0868         my $end = find_ending_index($tvi);
0869         my $exclude = 0;
0870         my $i;
0871 
0872         #Do not match excluded file patterns
0873 
0874         for ($i = $start; $i < $end; $i++) {
0875         my $line = $typevalue[$i];
0876         if ($line =~ m/^([A-Z]):\s*(.*)/) {
0877             my $type = $1;
0878             my $value = $2;
0879             if ($type eq 'X') {
0880             if (file_match_pattern($file, $value)) {
0881                 $exclude = 1;
0882                 last;
0883             }
0884             }
0885         }
0886         }
0887 
0888         if (!$exclude) {
0889         for ($i = $start; $i < $end; $i++) {
0890             my $line = $typevalue[$i];
0891             if ($line =~ m/^([A-Z]):\s*(.*)/) {
0892             my $type = $1;
0893             my $value = $2;
0894             if ($type eq 'F') {
0895                 if (file_match_pattern($file, $value)) {
0896                 my $value_pd = ($value =~ tr@/@@);
0897                 my $file_pd = ($file  =~ tr@/@@);
0898                 $value_pd++ if (substr($value,-1,1) ne "/");
0899                 $value_pd = -1 if ($value =~ /^\.\*/);
0900                 if ($value_pd >= $file_pd &&
0901                     range_is_maintained($start, $end) &&
0902                     range_has_maintainer($start, $end)) {
0903                     $exact_pattern_match_hash{$file} = 1;
0904                 }
0905                 if ($pattern_depth == 0 ||
0906                     (($file_pd - $value_pd) < $pattern_depth)) {
0907                     $hash{$tvi} = $value_pd;
0908                 }
0909                 }
0910             } elsif ($type eq 'N') {
0911                 if ($file =~ m/$value/x) {
0912                 $hash{$tvi} = 0;
0913                 }
0914             }
0915             }
0916         }
0917         }
0918         $tvi = $end + 1;
0919     }
0920 
0921     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
0922         add_categories($line);
0923         if ($sections) {
0924         my $i;
0925         my $start = find_starting_index($line);
0926         my $end = find_ending_index($line);
0927         for ($i = $start; $i < $end; $i++) {
0928             my $line = $typevalue[$i];
0929             if ($line =~ /^[FX]:/) {        ##Restore file patterns
0930             $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
0931             $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
0932             $line =~ s/\\\./\./g;           ##Convert \. to .
0933             $line =~ s/\.\*/\*/g;           ##Convert .* to *
0934             }
0935             my $count = $line =~ s/^([A-Z]):/$1:\t/g;
0936             if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
0937             print("$line\n");
0938             }
0939         }
0940         print("\n");
0941         }
0942     }
0943 
0944     maintainers_in_file($file);
0945     }
0946 
0947     if ($keywords) {
0948     @keyword_tvi = sort_and_uniq(@keyword_tvi);
0949     foreach my $line (@keyword_tvi) {
0950         add_categories($line);
0951     }
0952     }
0953 
0954     foreach my $email (@email_to, @list_to) {
0955     $email->[0] = deduplicate_email($email->[0]);
0956     }
0957 
0958     foreach my $file (@files) {
0959     if ($email &&
0960         ($email_git ||
0961          ($email_git_fallback &&
0962           $file !~ /MAINTAINERS$/ &&
0963           !$exact_pattern_match_hash{$file}))) {
0964         vcs_file_signoffs($file);
0965     }
0966     if ($email && $email_git_blame) {
0967         vcs_file_blame($file);
0968     }
0969     }
0970 
0971     if ($email) {
0972     foreach my $chief (@penguin_chief) {
0973         if ($chief =~ m/^(.*):(.*)/) {
0974         my $email_address;
0975 
0976         $email_address = format_email($1, $2, $email_usename);
0977         if ($email_git_penguin_chiefs) {
0978             push(@email_to, [$email_address, 'chief penguin']);
0979         } else {
0980             @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
0981         }
0982         }
0983     }
0984 
0985     foreach my $email (@file_emails) {
0986         $email = mailmap_email($email);
0987         my ($name, $address) = parse_email($email);
0988 
0989         my $tmp_email = format_email($name, $address, $email_usename);
0990         push_email_address($tmp_email, '');
0991         add_role($tmp_email, 'in file');
0992     }
0993     }
0994 
0995     foreach my $fix (@fixes) {
0996     vcs_add_commit_signers($fix, "blamed_fixes");
0997     }
0998 
0999     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 
1016 sub 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 
1034 sub usage {
1035     print <<EOT;
1036 usage: $P [options] patchfile
1037        $P [options] -f file|directory
1038 version: $V
1039 
1040 MAINTAINER 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 
1071 Output 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 
1076 Other 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 
1087 Default options:
1088   [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1089    --pattern-depth=0 --remove-duplicates --rolestats]
1090 
1091 Notes:
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 
1123 EOT
1124 }
1125 
1126 sub 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 
1153 sub 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 
1180 sub 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 
1207 sub 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 
1221 sub 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 
1235 sub 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 
1249 sub 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 
1263 sub 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 
1302 sub 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 
1314 sub 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 
1386 sub 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 
1396 sub 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 
1416 sub 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 
1435 sub 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 
1467 sub 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 
1479 sub 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 
1491 sub 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 
1518 sub 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 
1529 sub 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 
1544 sub 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 
1555 sub 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 
1565 sub 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 
1584 sub 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 
1623 sub 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 
1651 sub 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 
1667 sub 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 
1715 my $printed_novcs = 0;
1716 sub 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 
1732 sub vcs_is_git {
1733     vcs_exists();
1734     return $vcs_used == 1;
1735 }
1736 
1737 sub vcs_is_hg {
1738     return $vcs_used == 2;
1739 }
1740 
1741 sub 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 
1767 sub 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 
1839 Version Control options:
1840 g  use git history      [$email_git]
1841 gf use git-fallback     [$email_git_fallback]
1842 b  use git blame        [$email_git_blame]
1843 bs use blame signatures [$email_git_blame_signatures]
1844 c# minimum commits      [$email_git_min_signatures]
1845 %# min percent          [$email_git_min_percent]
1846 d# history to use       [$$date_ref]
1847 x# max maintainers      [$email_git_max_maintainers]
1848 t  all signature types  [$email_git_all_signature_types]
1849 m  use .mailmap         [$email_use_mailmap]
1850 EOT
1851         }
1852         print STDERR <<EOT
1853 
1854 Additional options:
1855 0  toggle all
1856 tm toggle maintainers
1857 tg toggle git entries
1858 tl toggle open list entries
1859 ts toggle subscriber list entries
1860 f  emails in file       [$email_file_emails]
1861 k  keywords in file     [$keywords]
1862 r  remove duplicates    [$email_remove_duplicates]
1863 p# pattern match depth  [$pattern_depth]
1864 EOT
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 
2005 Interactive mode allows you to select the various maintainers, submitters,
2006 commit signers and mailing lists that could be CC'd on a patch.
2007 
2008 Any *'d entry is selected.
2009 
2010 If you have git or hg installed, you can choose to summarize the commit
2011 history of files in the patch.  Also, each line of the current file can
2012 be matched to its commit author and that commits signers with blame.
2013 
2014 Various knobs exist to control the length of time for active commit
2015 tracking, the maximum number of commit authors and signers to add,
2016 and such.
2017 
2018 Enter selections at the prompt until you are satisfied that the selected
2019 maintainers are appropriate.  You may enter multiple selections separated
2020 by either commas or spaces.
2021 
2022 EOT
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 
2047 sub bool_invert {
2048     my ($bool_ref) = @_;
2049 
2050     if ($$bool_ref) {
2051     $$bool_ref = 0;
2052     } else {
2053     $$bool_ref = 1;
2054     }
2055 }
2056 
2057 sub 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 
2087 sub 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 
2120 sub 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 
2157 sub 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 
2200 sub 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 
2272 sub 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 
2400 sub 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 
2418 sub 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 
2435 sub uniq {
2436     my (@parms) = @_;
2437 
2438     my %saw;
2439     @parms = grep(!$saw{$_}++, @parms);
2440     return @parms;
2441 }
2442 
2443 sub sort_and_uniq {
2444     my (@parms) = @_;
2445 
2446     my %saw;
2447     @parms = sort @parms;
2448     @parms = grep(!$saw{$_}++, @parms);
2449     return @parms;
2450 }
2451 
2452 sub 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 
2497 sub 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 
2516 sub 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 
2529 my $rfc822re;
2530 
2531 sub 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 
2567 sub 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 #
2581 sub 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 
2601 sub 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 }