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