get_maintainer.pl

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

FreeBSD/Linux Kernel Cross Reference
sys/scripts/get_maintainer.pl
