scripts/get_maintainer.pl

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