scripts/get_maintainer.pl

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