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 = 1;
  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, "Tom Rini:trini\@konsulko.com");
  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                 'find-maintainer-files' => \$find_maintainer_files,
 253                 'v|version' => \$version,
 254                 'h|help|usage' => \$help,
 255                 )) {
 256     die "$P: invalid argument - use --help if necessary\n";
 257 }
 258
 259 if ($help != 0) {
 260     usage();
 261     exit 0;
 262 }
 263
 264 if ($version != 0) {
 265     print("${P} ${V}\n");
 266     exit 0;
 267 }
 268
 269 if (-t STDIN && !@ARGV) {
 270     # We're talking to a terminal, but have no command line arguments.
 271     die "$P: missing patchfile or -f file - use --help if necessary\n";
 272 }
 273
 274 $output_multiline = 0 if ($output_separator ne ", ");
 275 $output_rolestats = 1 if ($interactive);
 276 $output_roles = 1 if ($output_rolestats);
 277
 278 if ($sections || $letters ne "") {
 279     $sections = 1;
 280     $email = 0;
 281     $email_list = 0;
 282     $scm = 0;
 283     $status = 0;
 284     $subsystem = 0;
 285     $web = 0;
 286     $keywords = 0;
 287     $interactive = 0;
 288 } else {
 289     my $selections = $email + $scm + $status + $subsystem + $web;
 290     if ($selections == 0) {
 291         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 292     }
 293 }
 294
 295 if ($email &&
 296     ($email_maintainer + $email_reviewer +
 297      $email_list + $email_subscriber_list +
 298      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 299     die "$P: Please select at least 1 email option\n";
 300 }
 301
 302 if (!top_of_kernel_tree($lk_path)) {
 303     die "$P: The current directory does not appear to be "
 304         . "a U-Boot source tree.\n";
 305 }
 306
 307 ## Read MAINTAINERS for type/value pairs
 308
 309 my @typevalue = ();
 310 my %keyword_hash;
 311 my @mfiles = ();
 312
 313 sub read_maintainer_file {
 314     my ($file) = @_;
 315
 316     open (my $maint, '<', "$file")
 317         or die "$P: Can't open MAINTAINERS file '$file': $!\n";
 318     while (<$maint>) {
 319         my $line = $_;
 320
 321         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 322             my $type = $1;
 323             my $value = $2;
 324
 325             ##Filename pattern matching
 326             if ($type eq "F" || $type eq "X") {
 327                 $value =~ s@\.@\\\.@g;       ##Convert . to \.
 328                 $value =~ s/\*/\.\*/g;       ##Convert * to .*
 329                 $value =~ s/\?/\./g;         ##Convert ? to .
 330                 ##if pattern is a directory and it lacks a trailing slash, add one
 331                 if ((-d $value)) {
 332                     $value =~ s@([^/])$@$1/@;
 333                 }
 334             } elsif ($type eq "K") {
 335                 $keyword_hash{@typevalue} = $value;
 336             }
 337             push(@typevalue, "$type:$value");
 338         } elsif (!(/^\s*$/ || /^\s*\#/)) {
 339             $line =~ s/\n$//g;
 340             push(@typevalue, $line);
 341         }
 342     }
 343     close($maint);
 344 }
 345
 346 sub find_is_maintainer_file {
 347     my ($file) = $_;
 348     return if ($file !~ m@/MAINTAINERS$@);
 349     $file = $File::Find::name;
 350     return if (! -f $file);
 351     push(@mfiles, $file);
 352 }
 353
 354 sub find_ignore_git {
 355     return grep { $_ !~ /^\.git$/; } @_;
 356 }
 357
 358 if (-d "${lk_path}MAINTAINERS") {
 359     opendir(DIR, "${lk_path}MAINTAINERS") or die $!;
 360     my @files = readdir(DIR);
 361     closedir(DIR);
 362     foreach my $file (@files) {
 363         push(@mfiles, "${lk_path}MAINTAINERS/$file") if ($file !~ /^\./);
 364     }
 365 }
 366
 367 if ($find_maintainer_files) {
 368     find( { wanted => \&find_is_maintainer_file,
 369             preprocess => \&find_ignore_git,
 370             no_chdir => 1,
 371         }, "${lk_path}");
 372 } else {
 373     push(@mfiles, "${lk_path}MAINTAINERS") if -f "${lk_path}MAINTAINERS";
 374 }
 375
 376 foreach my $file (@mfiles) {
 377     read_maintainer_file("$file");
 378 }
 379
 380 #
 381 # Read mail address map
 382 #
 383
 384 my $mailmap;
 385
 386 read_mailmap();
 387
 388 sub read_mailmap {
 389     $mailmap = {
 390         names => {},
 391         addresses => {}
 392     };
 393
 394     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 395
 396     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 397         or warn "$P: Can't open .mailmap: $!\n";
 398
 399     while (<$mailmap_file>) {
 400         s/#.*$//; #strip comments
 401         s/^\s+|\s+$//g; #trim
 402
 403         next if (/^\s*$/); #skip empty lines
 404         #entries have one of the following formats:
 405         # name1 <mail1>
 406         # <mail1> <mail2>
 407         # name1 <mail1> <mail2>
 408         # name1 <mail1> name2 <mail2>
 409         # (see man git-shortlog)
 410
 411         if (/^([^<]+)<([^>]+)>$/) {
 412             my $real_name = $1;
 413             my $address = $2;
 414
 415             $real_name =~ s/\s+$//;
 416             ($real_name, $address) = parse_email("$real_name <$address>");
 417             $mailmap->{names}->{$address} = $real_name;
 418
 419         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 420             my $real_address = $1;
 421             my $wrong_address = $2;
 422
 423             $mailmap->{addresses}->{$wrong_address} = $real_address;
 424
 425         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 426             my $real_name = $1;
 427             my $real_address = $2;
 428             my $wrong_address = $3;
 429
 430             $real_name =~ s/\s+$//;
 431             ($real_name, $real_address) =
 432                 parse_email("$real_name <$real_address>");
 433             $mailmap->{names}->{$wrong_address} = $real_name;
 434             $mailmap->{addresses}->{$wrong_address} = $real_address;
 435
 436         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 437             my $real_name = $1;
 438             my $real_address = $2;
 439             my $wrong_name = $3;
 440             my $wrong_address = $4;
 441
 442             $real_name =~ s/\s+$//;
 443             ($real_name, $real_address) =
 444                 parse_email("$real_name <$real_address>");
 445
 446             $wrong_name =~ s/\s+$//;
 447             ($wrong_name, $wrong_address) =
 448                 parse_email("$wrong_name <$wrong_address>");
 449
 450             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 451             $mailmap->{names}->{$wrong_email} = $real_name;
 452             $mailmap->{addresses}->{$wrong_email} = $real_address;
 453         }
 454     }
 455     close($mailmap_file);
 456 }
 457
 458 ## use the filenames on the command line or find the filenames in the patchfiles
 459
 460 my @files = ();
 461 my @range = ();
 462 my @keyword_tvi = ();
 463 my @file_emails = ();
 464
 465 if (!@ARGV) {
 466     push(@ARGV, "&STDIN");
 467 }
 468
 469 foreach my $file (@ARGV) {
 470     if ($file ne "&STDIN") {
 471         ##if $file is a directory and it lacks a trailing slash, add one
 472         if ((-d $file)) {
 473             $file =~ s@([^/])$@$1/@;
 474         } elsif (!(-f $file)) {
 475             die "$P: file '${file}' not found\n";
 476         }
 477     }
 478     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
 479         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
 480         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
 481         push(@files, $file);
 482         if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
 483             open(my $f, '<', $file)
 484                 or die "$P: Can't open $file: $!\n";
 485             my $text = do { local($/) ; <$f> };
 486             close($f);
 487             if ($keywords) {
 488                 foreach my $line (keys %keyword_hash) {
 489                     if ($text =~ m/$keyword_hash{$line}/x) {
 490                         push(@keyword_tvi, $line);
 491                     }
 492                 }
 493             }
 494             if ($file_emails) {
 495                 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;
 496                 push(@file_emails, clean_file_emails(@poss_addr));
 497             }
 498         }
 499     } else {
 500         my $file_cnt = @files;
 501         my $lastfile;
 502
 503         open(my $patch, "< $file")
 504             or die "$P: Can't open $file: $!\n";
 505
 506         # We can check arbitrary information before the patch
 507         # like the commit message, mail headers, etc...
 508         # This allows us to match arbitrary keywords against any part
 509         # of a git format-patch generated file (subject tags, etc...)
 510
 511         my $patch_prefix = "";                  #Parsing the intro
 512
 513         while (<$patch>) {
 514             my $patch_line = $_;
 515             if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 516                 my $filename = $1;
 517                 $filename =~ s@^[^/]*/@@;
 518                 $filename =~ s@\n@@;
 519                 $lastfile = $filename;
 520                 push(@files, $filename);
 521                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 522             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 523                 if ($email_git_blame) {
 524                     push(@range, "$lastfile:$1:$2");
 525                 }
 526             } elsif ($keywords) {
 527                 foreach my $line (keys %keyword_hash) {
 528                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 529                         push(@keyword_tvi, $line);
 530                     }
 531                 }
 532             }
 533         }
 534         close($patch);
 535
 536         if ($file_cnt == @files) {
 537             warn "$P: file '${file}' doesn't appear to be a patch.  "
 538                 . "Add -f to options?\n";
 539         }
 540         @files = sort_and_uniq(@files);
 541     }
 542 }
 543
 544 @file_emails = uniq(@file_emails);
 545
 546 my %email_hash_name;
 547 my %email_hash_address;
 548 my @email_to = ();
 549 my %hash_list_to;
 550 my @list_to = ();
 551 my @scm = ();
 552 my @web = ();
 553 my @subsystem = ();
 554 my @status = ();
 555 my %deduplicate_name_hash = ();
 556 my %deduplicate_address_hash = ();
 557
 558 my @maintainers = get_maintainers();
 559
 560 if (@maintainers) {
 561     @maintainers = merge_email(@maintainers);
 562     output(@maintainers);
 563 }
 564
 565 if ($scm) {
 566     @scm = uniq(@scm);
 567     output(@scm);
 568 }
 569
 570 if ($status) {
 571     @status = uniq(@status);
 572     output(@status);
 573 }
 574
 575 if ($subsystem) {
 576     @subsystem = uniq(@subsystem);
 577     output(@subsystem);
 578 }
 579
 580 if ($web) {
 581     @web = uniq(@web);
 582     output(@web);
 583 }
 584
 585 exit($exit);
 586
 587 sub ignore_email_address {
 588     my ($address) = @_;
 589
 590     foreach my $ignore (@ignore_emails) {
 591         return 1 if ($ignore eq $address);
 592     }
 593
 594     return 0;
 595 }
 596
 597 sub range_is_maintained {
 598     my ($start, $end) = @_;
 599
 600     for (my $i = $start; $i < $end; $i++) {
 601         my $line = $typevalue[$i];
 602         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 603             my $type = $1;
 604             my $value = $2;
 605             if ($type eq 'S') {
 606                 if ($value =~ /(maintain|support)/i) {
 607                     return 1;
 608                 }
 609             }
 610         }
 611     }
 612     return 0;
 613 }
 614
 615 sub range_has_maintainer {
 616     my ($start, $end) = @_;
 617
 618     for (my $i = $start; $i < $end; $i++) {
 619         my $line = $typevalue[$i];
 620         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 621             my $type = $1;
 622             my $value = $2;
 623             if ($type eq 'M') {
 624                 return 1;
 625             }
 626         }
 627     }
 628     return 0;
 629 }
 630
 631 sub get_maintainers {
 632     %email_hash_name = ();
 633     %email_hash_address = ();
 634     %commit_author_hash = ();
 635     %commit_signer_hash = ();
 636     @email_to = ();
 637     %hash_list_to = ();
 638     @list_to = ();
 639     @scm = ();
 640     @web = ();
 641     @subsystem = ();
 642     @status = ();
 643     %deduplicate_name_hash = ();
 644     %deduplicate_address_hash = ();
 645     if ($email_git_all_signature_types) {
 646         $signature_pattern = "(.+?)[Bb][Yy]:";
 647     } else {
 648         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 649     }
 650
 651     # Find responsible parties
 652
 653     my %exact_pattern_match_hash = ();
 654
 655     foreach my $file (@files) {
 656
 657         my %hash;
 658         my $tvi = find_first_section();
 659         while ($tvi < @typevalue) {
 660             my $start = find_starting_index($tvi);
 661             my $end = find_ending_index($tvi);
 662             my $exclude = 0;
 663             my $i;
 664
 665             #Do not match excluded file patterns
 666
 667             for ($i = $start; $i < $end; $i++) {
 668                 my $line = $typevalue[$i];
 669                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
 670                     my $type = $1;
 671                     my $value = $2;
 672                     if ($type eq 'X') {
 673                         if (file_match_pattern($file, $value)) {
 674                             $exclude = 1;
 675                             last;
 676                         }
 677                     }
 678                 }
 679             }
 680
 681             if (!$exclude) {
 682                 for ($i = $start; $i < $end; $i++) {
 683                     my $line = $typevalue[$i];
 684                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 685                         my $type = $1;
 686                         my $value = $2;
 687                         if ($type eq 'F') {
 688                             if (file_match_pattern($file, $value)) {
 689                                 my $value_pd = ($value =~ tr@/@@);
 690                                 my $file_pd = ($file  =~ tr@/@@);
 691                                 $value_pd++ if (substr($value,-1,1) ne "/");
 692                                 $value_pd = -1 if ($value =~ /^\.\*/);
 693                                 if ($value_pd >= $file_pd &&
 694                                     range_is_maintained($start, $end) &&
 695                                     range_has_maintainer($start, $end)) {
 696                                     $exact_pattern_match_hash{$file} = 1;
 697                                 }
 698                                 if ($pattern_depth == 0 ||
 699                                     (($file_pd - $value_pd) < $pattern_depth)) {
 700                                     $hash{$tvi} = $value_pd;
 701                                 }
 702                             }
 703                         } elsif ($type eq 'N') {
 704                             if ($file =~ m/$value/x) {
 705                                 $hash{$tvi} = 0;
 706                             }
 707                         }
 708                     }
 709                 }
 710             }
 711             $tvi = $end + 1;
 712         }
 713
 714         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 715             add_categories($line);
 716             if ($sections) {
 717                 my $i;
 718                 my $start = find_starting_index($line);
 719                 my $end = find_ending_index($line);
 720                 for ($i = $start; $i < $end; $i++) {
 721                     my $line = $typevalue[$i];
 722                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 723                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 724                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 725                         $line =~ s/\\\./\./g;           ##Convert \. to .
 726                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 727                     }
 728                     my $count = $line =~ s/^([A-Z]):/$1:\t/g;
 729                     if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
 730                         print("$line\n");
 731                     }
 732                 }
 733                 print("\n");
 734             }
 735         }
 736     }
 737
 738     if ($keywords) {
 739         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 740         foreach my $line (@keyword_tvi) {
 741             add_categories($line);
 742         }
 743     }
 744
 745     foreach my $email (@email_to, @list_to) {
 746         $email->[0] = deduplicate_email($email->[0]);
 747     }
 748
 749     foreach my $file (@files) {
 750         if ($email &&
 751             ($email_git || ($email_git_fallback &&
 752                             !$exact_pattern_match_hash{$file}))) {
 753             vcs_file_signoffs($file);
 754         }
 755         if ($email && $email_git_blame) {
 756             vcs_file_blame($file);
 757         }
 758     }
 759
 760     if ($email) {
 761         foreach my $chief (@penguin_chief) {
 762             if ($chief =~ m/^(.*):(.*)/) {
 763                 my $email_address;
 764
 765                 $email_address = format_email($1, $2, $email_usename);
 766                 if ($email_git_penguin_chiefs) {
 767                     push(@email_to, [$email_address, 'chief penguin']);
 768                 } else {
 769                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 770                 }
 771             }
 772         }
 773
 774         foreach my $email (@file_emails) {
 775             my ($name, $address) = parse_email($email);
 776
 777             my $tmp_email = format_email($name, $address, $email_usename);
 778             push_email_address($tmp_email, '');
 779             add_role($tmp_email, 'in file');
 780         }
 781     }
 782
 783     my @to = ();
 784     if ($email || $email_list) {
 785         if ($email) {
 786             @to = (@to, @email_to);
 787         }
 788         if ($email_list) {
 789             @to = (@to, @list_to);
 790         }
 791     }
 792
 793     if ($interactive) {
 794         @to = interactive_get_maintainers(\@to);
 795     }
 796
 797     return @to;
 798 }
 799
 800 sub file_match_pattern {
 801     my ($file, $pattern) = @_;
 802     if (substr($pattern, -1) eq "/") {
 803         if ($file =~ m@^$pattern@) {
 804             return 1;
 805         }
 806     } else {
 807         if ($file =~ m@^$pattern@) {
 808             my $s1 = ($file =~ tr@/@@);
 809             my $s2 = ($pattern =~ tr@/@@);
 810             if ($s1 == $s2) {
 811                 return 1;
 812             }
 813         }
 814     }
 815     return 0;
 816 }
 817
 818 sub usage {
 819     print <<EOT;
 820 usage: $P [options] patchfile
 821        $P [options] -f file|directory
 822 version: $V
 823
 824 MAINTAINER field selection options:
 825   --email => print email address(es) if any
 826     --git => include recent git \*-by: signers
 827     --git-all-signature-types => include signers regardless of signature type
 828         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
 829     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
 830     --git-chief-penguins => include ${penguin_chiefs}
 831     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
 832     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
 833     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
 834     --git-blame => use git blame to find modified commits for patch or file
 835     --git-blame-signatures => when used with --git-blame, also include all commit signers
 836     --git-since => git history to use (default: $email_git_since)
 837     --hg-since => hg history to use (default: $email_hg_since)
 838     --interactive => display a menu (mostly useful if used with the --git option)
 839     --m => include maintainer(s) if any
 840     --r => include reviewer(s) if any
 841     --n => include name 'Full Name <addr\@domain.tld>'
 842     --l => include list(s) if any
 843     --s => include subscriber only list(s) if any
 844     --remove-duplicates => minimize duplicate email names/addresses
 845     --roles => show roles (status:subsystem, git-signer, list, etc...)
 846     --rolestats => show roles and statistics (commits/total_commits, %)
 847     --file-emails => add email addresses found in -f file (default: 0 (off))
 848   --scm => print SCM tree(s) if any
 849   --status => print status if any
 850   --subsystem => print subsystem name if any
 851   --web => print website(s) if any
 852
 853 Output type options:
 854   --separator [, ] => separator for multiple entries on 1 line
 855     using --separator also sets --nomultiline if --separator is not [, ]
 856   --multiline => print 1 entry per line
 857
 858 Other options:
 859   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 860   --keywords => scan patch for keywords (default: $keywords)
 861   --sections => print all of the subsystem sections with pattern matches
 862   --letters => print all matching 'letter' types from all matching sections
 863   --mailmap => use .mailmap file (default: $email_use_mailmap)
 864   --version => show version
 865   --help => show this help information
 866
 867 Default options:
 868   [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
 869    --remove-duplicates --rolestats]
 870
 871 Notes:
 872   Using "-f directory" may give unexpected results:
 873       Used with "--git", git signators for _all_ files in and below
 874           directory are examined as git recurses directories.
 875           Any specified X: (exclude) pattern matches are _not_ ignored.
 876       Used with "--nogit", directory is used as a pattern match,
 877           no individual file within the directory or subdirectory
 878           is matched.
 879       Used with "--git-blame", does not iterate all files in directory
 880   Using "--git-blame" is slow and may add old committers and authors
 881       that are no longer active maintainers to the output.
 882   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
 883       other automated tools that expect only ["name"] <email address>
 884       may not work because of additional output after <email address>.
 885   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
 886       not the percentage of the entire file authored.  # of commits is
 887       not a good measure of amount of code authored.  1 major commit may
 888       contain a thousand lines, 5 trivial commits may modify a single line.
 889   If git is not installed, but mercurial (hg) is installed and an .hg
 890       repository exists, the following options apply to mercurial:
 891           --git,
 892           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
 893           --git-blame
 894       Use --hg-since not --git-since to control date selection
 895   File ".get_maintainer.conf", if it exists in the linux kernel source root
 896       directory, can change whatever get_maintainer defaults are desired.
 897       Entries in this file can be any command line argument.
 898       This file is prepended to any additional command line arguments.
 899       Multiple lines and # comments are allowed.
 900   Most options have both positive and negative forms.
 901       The negative forms for --<foo> are --no<foo> and --no-<foo>.
 902
 903 EOT
 904 }
 905
 906 sub top_of_kernel_tree {
 907     my ($lk_path) = @_;
 908
 909     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 910         $lk_path .= "/";
 911     }
 912     if (   (-f "${lk_path}Kbuild")
 913         && (-e "${lk_path}MAINTAINERS")
 914         && (-f "${lk_path}Makefile")
 915         && (-f "${lk_path}README")
 916         && (-d "${lk_path}arch")
 917         && (-d "${lk_path}board")
 918         && (-d "${lk_path}common")
 919         && (-d "${lk_path}doc")
 920         && (-d "${lk_path}drivers")
 921         && (-d "${lk_path}dts")
 922         && (-d "${lk_path}fs")
 923         && (-d "${lk_path}lib")
 924         && (-d "${lk_path}include")
 925         && (-d "${lk_path}net")
 926         && (-d "${lk_path}post")
 927         && (-d "${lk_path}scripts")
 928         && (-d "${lk_path}test")
 929         && (-d "${lk_path}tools")) {
 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 }