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