util/scripts/get_maintainer.pl

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