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