scripts/get_maintainer.pl

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