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