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