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