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