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, "Tom Rini:trini\@konsulko.com");
  84
  85 my @penguin_chief_names = ();
  86 foreach my $chief (@penguin_chief) {
  87     if ($chief =~ m/^(.*):(.*)/) {
  88         my $chief_name = $1;
  89         my $chief_addr = $2;
  90         push(@penguin_chief_names, $chief_name);
  91     }
  92 }
  93 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  94
  95 # Signature types of people who are either
  96 #       a) responsible for the code in question, or
  97 #       b) familiar enough with it to give relevant feedback
  98 my @signature_tags = ();
  99 push(@signature_tags, "Signed-off-by:");
 100 push(@signature_tags, "Reviewed-by:");
 101 push(@signature_tags, "Acked-by:");
 102
 103 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 104
 105 # rfc822 email address - preloaded methods go here.
 106 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
 107 my $rfc822_char = '[\\000-\\377]';
 108
 109 # VCS command support: class-like functions and strings
 110
 111 my %VCS_cmds;
 112
 113 my %VCS_cmds_git = (
 114     "execute_cmd" => \&git_execute_cmd,
 115     "available" => '(which("git") ne "") && (-e ".git")',
 116     "find_signers_cmd" =>
 117         "git log --no-color --follow --since=\$email_git_since " .
 118             '--numstat --no-merges ' .
 119             '--format="GitCommit: %H%n' .
 120                       'GitAuthor: %an <%ae>%n' .
 121                       'GitDate: %aD%n' .
 122                       'GitSubject: %s%n' .
 123                       '%b%n"' .
 124             " -- \$file",
 125     "find_commit_signers_cmd" =>
 126         "git log --no-color " .
 127             '--numstat ' .
 128             '--format="GitCommit: %H%n' .
 129                       'GitAuthor: %an <%ae>%n' .
 130                       'GitDate: %aD%n' .
 131                       'GitSubject: %s%n' .
 132                       '%b%n"' .
 133             " -1 \$commit",
 134     "find_commit_author_cmd" =>
 135         "git log --no-color " .
 136             '--numstat ' .
 137             '--format="GitCommit: %H%n' .
 138                       'GitAuthor: %an <%ae>%n' .
 139                       'GitDate: %aD%n' .
 140                       'GitSubject: %s%n"' .
 141             " -1 \$commit",
 142     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 143     "blame_file_cmd" => "git blame -l \$file",
 144     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 145     "blame_commit_pattern" => "^([0-9a-f]+) ",
 146     "author_pattern" => "^GitAuthor: (.*)",
 147     "subject_pattern" => "^GitSubject: (.*)",
 148     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 149     "file_exists_cmd" => "git ls-files \$file",
 150     "list_files_cmd" => "git ls-files \$file",
 151 );
 152
 153 my %VCS_cmds_hg = (
 154     "execute_cmd" => \&hg_execute_cmd,
 155     "available" => '(which("hg") ne "") && (-d ".hg")',
 156     "find_signers_cmd" =>
 157         "hg log --date=\$email_hg_since " .
 158             "--template='HgCommit: {node}\\n" .
 159                         "HgAuthor: {author}\\n" .
 160                         "HgSubject: {desc}\\n'" .
 161             " -- \$file",
 162     "find_commit_signers_cmd" =>
 163         "hg log " .
 164             "--template='HgSubject: {desc}\\n'" .
 165             " -r \$commit",
 166     "find_commit_author_cmd" =>
 167         "hg log " .
 168             "--template='HgCommit: {node}\\n" .
 169                         "HgAuthor: {author}\\n" .
 170                         "HgSubject: {desc|firstline}\\n'" .
 171             " -r \$commit",
 172     "blame_range_cmd" => "",            # not supported
 173     "blame_file_cmd" => "hg blame -n \$file",
 174     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 175     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 176     "author_pattern" => "^HgAuthor: (.*)",
 177     "subject_pattern" => "^HgSubject: (.*)",
 178     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 179     "file_exists_cmd" => "hg files \$file",
 180     "list_files_cmd" => "hg manifest -R \$file",
 181 );
 182
 183 my $conf = which_conf(".get_maintainer.conf");
 184 if (-f $conf) {
 185     my @conf_args;
 186     open(my $conffile, '<', "$conf")
 187         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 188
 189     while (<$conffile>) {
 190         my $line = $_;
 191
 192         $line =~ s/\s*\n?$//g;
 193         $line =~ s/^\s*//g;
 194         $line =~ s/\s+/ /g;
 195
 196         next if ($line =~ m/^\s*#/);
 197         next if ($line =~ m/^\s*$/);
 198
 199         my @words = split(" ", $line);
 200         foreach my $word (@words) {
 201             last if ($word =~ m/^#/);
 202             push (@conf_args, $word);
 203         }
 204     }
 205     close($conffile);
 206     unshift(@ARGV, @conf_args) if @conf_args;
 207 }
 208
 209 my @ignore_emails = ();
 210 my $ignore_file = which_conf(".get_maintainer.ignore");
 211 if (-f $ignore_file) {
 212     open(my $ignore, '<', "$ignore_file")
 213         or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
 214     while (<$ignore>) {
 215         my $line = $_;
 216
 217         $line =~ s/\s*\n?$//;
 218         $line =~ s/^\s*//;
 219         $line =~ s/\s+$//;
 220         $line =~ s/#.*$//;
 221
 222         next if ($line =~ m/^\s*$/);
 223         if (rfc822_valid($line)) {
 224             push(@ignore_emails, $line);
 225         }
 226     }
 227     close($ignore);
 228 }
 229
 230 if ($#ARGV > 0) {
 231     foreach (@ARGV) {
 232         if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
 233             die "$P: using --self-test does not allow any other option or argument\n";
 234         }
 235     }
 236 }
 237
 238 if (!GetOptions(
 239                 'email!' => \$email,
 240                 'git!' => \$email_git,
 241                 'git-all-signature-types!' => \$email_git_all_signature_types,
 242                 'git-blame!' => \$email_git_blame,
 243                 'git-blame-signatures!' => \$email_git_blame_signatures,
 244                 'git-fallback!' => \$email_git_fallback,
 245                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 246                 'git-min-signatures=i' => \$email_git_min_signatures,
 247                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 248                 'git-min-percent=i' => \$email_git_min_percent,
 249                 'git-since=s' => \$email_git_since,
 250                 'hg-since=s' => \$email_hg_since,
 251                 'i|interactive!' => \$interactive,
 252                 'remove-duplicates!' => \$email_remove_duplicates,
 253                 'mailmap!' => \$email_use_mailmap,
 254                 'm!' => \$email_maintainer,
 255                 'r!' => \$email_reviewer,
 256                 'n!' => \$email_usename,
 257                 'l!' => \$email_list,
 258                 'fixes!' => \$email_fixes,
 259                 'moderated!' => \$email_moderated_list,
 260                 's!' => \$email_subscriber_list,
 261                 'multiline!' => \$output_multiline,
 262                 'roles!' => \$output_roles,
 263                 'rolestats!' => \$output_rolestats,
 264                 'separator=s' => \$output_separator,
 265                 'subsystem!' => \$subsystem,
 266                 'status!' => \$status,
 267                 'scm!' => \$scm,
 268                 'tree!' => \$tree,
 269                 'web!' => \$web,
 270                 'letters=s' => \$letters,
 271                 'pattern-depth=i' => \$pattern_depth,
 272                 'k|keywords!' => \$keywords,
 273                 'sections!' => \$sections,
 274                 'fe|file-emails!' => \$email_file_emails,
 275                 'f|file' => \$from_filename,
 276                 'find-maintainer-files' => \$find_maintainer_files,
 277                 'mpath|maintainer-path=s' => \$maintainer_path,
 278                 'self-test:s' => \$self_test,
 279                 'v|version' => \$version,
 280                 'h|help|usage' => \$help,
 281                 )) {
 282     die "$P: invalid argument - use --help if necessary\n";
 283 }
 284
 285 if ($help != 0) {
 286     usage();
 287     exit 0;
 288 }
 289
 290 if ($version != 0) {
 291     print("${P} ${V}\n");
 292     exit 0;
 293 }
 294
 295 if (defined $self_test) {
 296     read_all_maintainer_files();
 297     self_test();
 298     exit 0;
 299 }
 300
 301 if (-t STDIN && !@ARGV) {
 302     # We're talking to a terminal, but have no command line arguments.
 303     die "$P: missing patchfile or -f file - use --help if necessary\n";
 304 }
 305
 306 $output_multiline = 0 if ($output_separator ne ", ");
 307 $output_rolestats = 1 if ($interactive);
 308 $output_roles = 1 if ($output_rolestats);
 309
 310 if ($sections || $letters ne "") {
 311     $sections = 1;
 312     $email = 0;
 313     $email_list = 0;
 314     $scm = 0;
 315     $status = 0;
 316     $subsystem = 0;
 317     $web = 0;
 318     $keywords = 0;
 319     $interactive = 0;
 320 } else {
 321     my $selections = $email + $scm + $status + $subsystem + $web;
 322     if ($selections == 0) {
 323         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 324     }
 325 }
 326
 327 if ($email &&
 328     ($email_maintainer + $email_reviewer +
 329      $email_list + $email_subscriber_list +
 330      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 331     die "$P: Please select at least 1 email option\n";
 332 }
 333
 334 if ($tree && !top_of_kernel_tree($lk_path)) {
 335     die "$P: The current directory does not appear to be "
 336         . "a U-Boot source tree.\n";
 337 }
 338
 339 ## Read MAINTAINERS for type/value pairs
 340
 341 my @typevalue = ();
 342 my %keyword_hash;
 343 my @mfiles = ();
 344 my @self_test_info = ();
 345
 346 sub read_maintainer_file {
 347     my ($file) = @_;
 348
 349     open (my $maint, '<', "$file")
 350         or die "$P: Can't open MAINTAINERS file '$file': $!\n";
 351     my $i = 1;
 352     while (<$maint>) {
 353         my $line = $_;
 354         chomp $line;
 355
 356         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 357             my $type = $1;
 358             my $value = $2;
 359
 360             ##Filename pattern matching
 361             if ($type eq "F" || $type eq "X") {
 362                 $value =~ s@\.@\\\.@g;       ##Convert . to \.
 363                 $value =~ s/\*/\.\*/g;       ##Convert * to .*
 364                 $value =~ s/\?/\./g;         ##Convert ? to .
 365                 ##if pattern is a directory and it lacks a trailing slash, add one
 366                 if ((-d $value)) {
 367                     $value =~ s@([^/])$@$1/@;
 368                 }
 369             } elsif ($type eq "K") {
 370                 $keyword_hash{@typevalue} = $value;
 371             }
 372             push(@typevalue, "$type:$value");
 373         } elsif (!(/^\s*$/ || /^\s*\#/)) {
 374             push(@typevalue, $line);
 375         }
 376         if (defined $self_test) {
 377             push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
 378         }
 379         $i++;
 380     }
 381     close($maint);
 382 }
 383
 384 sub find_is_maintainer_file {
 385     my ($file) = $_;
 386     return if ($file !~ m@/MAINTAINERS$@);
 387     $file = $File::Find::name;
 388     return if (! -f $file);
 389     push(@mfiles, $file);
 390 }
 391
 392 sub find_ignore_git {
 393     return grep { $_ !~ /^\.git$/; } @_;
 394 }
 395
 396 read_all_maintainer_files();
 397
 398 sub read_all_maintainer_files {
 399     my $path = "${lk_path}MAINTAINERS";
 400     if (defined $maintainer_path) {
 401         $path = $maintainer_path;
 402         # Perl Cookbook tilde expansion if necessary
 403         $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
 404     }
 405
 406     if (-d $path) {
 407         $path .= '/' if ($path !~ m@/$@);
 408         if ($find_maintainer_files) {
 409             find( { wanted => \&find_is_maintainer_file,
 410                     preprocess => \&find_ignore_git,
 411                     no_chdir => 1,
 412                 }, "$path");
 413         } else {
 414             opendir(DIR, "$path") or die $!;
 415             my @files = readdir(DIR);
 416             closedir(DIR);
 417             foreach my $file (@files) {
 418                 push(@mfiles, "$path$file") if ($file !~ /^\./);
 419             }
 420         }
 421     } elsif (-f "$path") {
 422         push(@mfiles, "$path");
 423     } else {
 424         die "$P: MAINTAINER file not found '$path'\n";
 425     }
 426     die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
 427     foreach my $file (@mfiles) {
 428         read_maintainer_file("$file");
 429     }
 430 }
 431
 432 sub maintainers_in_file {
 433     my ($file) = @_;
 434
 435     return if ($file =~ m@\bMAINTAINERS$@);
 436
 437     if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) {
 438         open(my $f, '<', $file)
 439             or die "$P: Can't open $file: $!\n";
 440         my $text = do { local($/) ; <$f> };
 441         close($f);
 442
 443         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;
 444         push(@file_emails, clean_file_emails(@poss_addr));
 445     }
 446 }
 447
 448 #
 449 # Read mail address map
 450 #
 451
 452 my $mailmap;
 453
 454 read_mailmap();
 455
 456 sub read_mailmap {
 457     $mailmap = {
 458         names => {},
 459         addresses => {}
 460     };
 461
 462     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 463
 464     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 465         or warn "$P: Can't open .mailmap: $!\n";
 466
 467     while (<$mailmap_file>) {
 468         s/#.*$//; #strip comments
 469         s/^\s+|\s+$//g; #trim
 470
 471         next if (/^\s*$/); #skip empty lines
 472         #entries have one of the following formats:
 473         # name1 <mail1>
 474         # <mail1> <mail2>
 475         # name1 <mail1> <mail2>
 476         # name1 <mail1> name2 <mail2>
 477         # (see man git-shortlog)
 478
 479         if (/^([^<]+)<([^>]+)>$/) {
 480             my $real_name = $1;
 481             my $address = $2;
 482
 483             $real_name =~ s/\s+$//;
 484             ($real_name, $address) = parse_email("$real_name <$address>");
 485             $mailmap->{names}->{$address} = $real_name;
 486
 487         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 488             my $real_address = $1;
 489             my $wrong_address = $2;
 490
 491             $mailmap->{addresses}->{$wrong_address} = $real_address;
 492
 493         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 494             my $real_name = $1;
 495             my $real_address = $2;
 496             my $wrong_address = $3;
 497
 498             $real_name =~ s/\s+$//;
 499             ($real_name, $real_address) =
 500                 parse_email("$real_name <$real_address>");
 501             $mailmap->{names}->{$wrong_address} = $real_name;
 502             $mailmap->{addresses}->{$wrong_address} = $real_address;
 503
 504         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 505             my $real_name = $1;
 506             my $real_address = $2;
 507             my $wrong_name = $3;
 508             my $wrong_address = $4;
 509
 510             $real_name =~ s/\s+$//;
 511             ($real_name, $real_address) =
 512                 parse_email("$real_name <$real_address>");
 513
 514             $wrong_name =~ s/\s+$//;
 515             ($wrong_name, $wrong_address) =
 516                 parse_email("$wrong_name <$wrong_address>");
 517
 518             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 519             $mailmap->{names}->{$wrong_email} = $real_name;
 520             $mailmap->{addresses}->{$wrong_email} = $real_address;
 521         }
 522     }
 523     close($mailmap_file);
 524 }
 525
 526 ## use the filenames on the command line or find the filenames in the patchfiles
 527
 528 if (!@ARGV) {
 529     push(@ARGV, "&STDIN");
 530 }
 531
 532 foreach my $file (@ARGV) {
 533     if ($file ne "&STDIN") {
 534         $file = canonpath($file);
 535         ##if $file is a directory and it lacks a trailing slash, add one
 536         if ((-d $file)) {
 537             $file =~ s@([^/])$@$1/@;
 538         } elsif (!(-f $file)) {
 539             die "$P: file '${file}' not found\n";
 540         }
 541     }
 542     if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) {
 543         warn "$P: file '$file' not found in version control $!\n";
 544     }
 545     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
 546         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
 547         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
 548         push(@files, $file);
 549         if ($file ne "MAINTAINERS" && -f $file && $keywords) {
 550             open(my $f, '<', $file)
 551                 or die "$P: Can't open $file: $!\n";
 552             my $text = do { local($/) ; <$f> };
 553             close($f);
 554             if ($keywords) {
 555                 foreach my $line (keys %keyword_hash) {
 556                     if ($text =~ m/$keyword_hash{$line}/x) {
 557                         push(@keyword_tvi, $line);
 558                     }
 559                 }
 560             }
 561         }
 562     } else {
 563         my $file_cnt = @files;
 564         my $lastfile;
 565
 566         open(my $patch, "< $file")
 567             or die "$P: Can't open $file: $!\n";
 568
 569         # We can check arbitrary information before the patch
 570         # like the commit message, mail headers, etc...
 571         # This allows us to match arbitrary keywords against any part
 572         # of a git format-patch generated file (subject tags, etc...)
 573
 574         my $patch_prefix = "";                  #Parsing the intro
 575
 576         while (<$patch>) {
 577             my $patch_line = $_;
 578             if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
 579                 my $filename = $1;
 580                 push(@files, $filename);
 581             } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
 582                 my $filename = $1;
 583                 push(@files, $filename);
 584             } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
 585                 my $filename1 = $1;
 586                 my $filename2 = $2;
 587                 push(@files, $filename1);
 588                 push(@files, $filename2);
 589             } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) {
 590                 push(@fixes, $1) if ($email_fixes);
 591             } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 592                 my $filename = $1;
 593                 $filename =~ s@^[^/]*/@@;
 594                 $filename =~ s@\n@@;
 595                 $lastfile = $filename;
 596                 push(@files, $filename);
 597                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 598             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 599                 if ($email_git_blame) {
 600                     push(@range, "$lastfile:$1:$2");
 601                 }
 602             } elsif ($keywords) {
 603                 foreach my $line (keys %keyword_hash) {
 604                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 605                         push(@keyword_tvi, $line);
 606                     }
 607                 }
 608             }
 609         }
 610         close($patch);
 611
 612         if ($file_cnt == @files) {
 613             warn "$P: file '${file}' doesn't appear to be a patch.  "
 614                 . "Add -f to options?\n";
 615         }
 616         @files = sort_and_uniq(@files);
 617     }
 618 }
 619
 620 @file_emails = uniq(@file_emails);
 621 @fixes = uniq(@fixes);
 622
 623 my %email_hash_name;
 624 my %email_hash_address;
 625 my @email_to = ();
 626 my %hash_list_to;
 627 my @list_to = ();
 628 my @scm = ();
 629 my @web = ();
 630 my @subsystem = ();
 631 my @status = ();
 632 my %deduplicate_name_hash = ();
 633 my %deduplicate_address_hash = ();
 634
 635 my @maintainers = get_maintainers();
 636 if (@maintainers) {
 637     @maintainers = merge_email(@maintainers);
 638     output(@maintainers);
 639 }
 640
 641 if ($scm) {
 642     @scm = uniq(@scm);
 643     output(@scm);
 644 }
 645
 646 if ($status) {
 647     @status = uniq(@status);
 648     output(@status);
 649 }
 650
 651 if ($subsystem) {
 652     @subsystem = uniq(@subsystem);
 653     output(@subsystem);
 654 }
 655
 656 if ($web) {
 657     @web = uniq(@web);
 658     output(@web);
 659 }
 660
 661 exit($exit);
 662
 663 sub self_test {
 664     my @lsfiles = ();
 665     my @good_links = ();
 666     my @bad_links = ();
 667     my @section_headers = ();
 668     my $index = 0;
 669
 670     @lsfiles = vcs_list_files($lk_path);
 671
 672     for my $x (@self_test_info) {
 673         $index++;
 674
 675         ## Section header duplication and missing section content
 676         if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
 677             $x->{line} =~ /^\S[^:]/ &&
 678             defined $self_test_info[$index] &&
 679             $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
 680             my $has_S = 0;
 681             my $has_F = 0;
 682             my $has_ML = 0;
 683             my $status = "";
 684             if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
 685                 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
 686             } else {
 687                 push(@section_headers, $x->{line});
 688             }
 689             my $nextline = $index;
 690             while (defined $self_test_info[$nextline] &&
 691                    $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
 692                 my $type = $1;
 693                 my $value = $2;
 694                 if ($type eq "S") {
 695                     $has_S = 1;
 696                     $status = $value;
 697                 } elsif ($type eq "F" || $type eq "N") {
 698                     $has_F = 1;
 699                 } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
 700                     $has_ML = 1;
 701                 }
 702                 $nextline++;
 703             }
 704             if (!$has_ML && $status !~ /orphan|obsolete/i) {
 705                 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
 706             }
 707             if (!$has_S) {
 708                 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
 709             }
 710             if (!$has_F) {
 711                 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
 712             }
 713         }
 714
 715         next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
 716
 717         my $type = $1;
 718         my $value = $2;
 719
 720         ## Filename pattern matching
 721         if (($type eq "F" || $type eq "X") &&
 722             ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
 723             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 724             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 725             $value =~ s/\?/\./g;         ##Convert ? to .
 726             ##if pattern is a directory and it lacks a trailing slash, add one
 727             if ((-d $value)) {
 728                 $value =~ s@([^/])$@$1/@;
 729             }
 730             if (!grep(m@^$value@, @lsfiles)) {
 731                 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
 732             }
 733
 734         ## Link reachability
 735         } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
 736                  $value =~ /^https?:/ &&
 737                  ($self_test eq "" || $self_test =~ /\blinks\b/)) {
 738             next if (grep(m@^\Q$value\E$@, @good_links));
 739             my $isbad = 0;
 740             if (grep(m@^\Q$value\E$@, @bad_links)) {
 741                 $isbad = 1;
 742             } else {
 743                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
 744                 if ($? == 0) {
 745                     push(@good_links, $value);
 746                 } else {
 747                     push(@bad_links, $value);
 748                     $isbad = 1;
 749                 }
 750             }
 751             if ($isbad) {
 752                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 753             }
 754
 755         ## SCM reachability
 756         } elsif ($type eq "T" &&
 757                  ($self_test eq "" || $self_test =~ /\bscm\b/)) {
 758             next if (grep(m@^\Q$value\E$@, @good_links));
 759             my $isbad = 0;
 760             if (grep(m@^\Q$value\E$@, @bad_links)) {
 761                 $isbad = 1;
 762             } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
 763                 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
 764             } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
 765                 my $url = $1;
 766                 my $branch = "";
 767                 $branch = $3 if $3;
 768                 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
 769                 if ($? == 0) {
 770                     push(@good_links, $value);
 771                 } else {
 772                     push(@bad_links, $value);
 773                     $isbad = 1;
 774                 }
 775             } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
 776                 my $url = $1;
 777                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
 778                 if ($? == 0) {
 779                     push(@good_links, $value);
 780                 } else {
 781                     push(@bad_links, $value);
 782                     $isbad = 1;
 783                 }
 784             }
 785             if ($isbad) {
 786                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 787             }
 788         }
 789     }
 790 }
 791
 792 sub ignore_email_address {
 793     my ($address) = @_;
 794
 795     foreach my $ignore (@ignore_emails) {
 796         return 1 if ($ignore eq $address);
 797     }
 798
 799     return 0;
 800 }
 801
 802 sub range_is_maintained {
 803     my ($start, $end) = @_;
 804
 805     for (my $i = $start; $i < $end; $i++) {
 806         my $line = $typevalue[$i];
 807         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 808             my $type = $1;
 809             my $value = $2;
 810             if ($type eq 'S') {
 811                 if ($value =~ /(maintain|support)/i) {
 812                     return 1;
 813                 }
 814             }
 815         }
 816     }
 817     return 0;
 818 }
 819
 820 sub range_has_maintainer {
 821     my ($start, $end) = @_;
 822
 823     for (my $i = $start; $i < $end; $i++) {
 824         my $line = $typevalue[$i];
 825         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 826             my $type = $1;
 827             my $value = $2;
 828             if ($type eq 'M') {
 829                 return 1;
 830             }
 831         }
 832     }
 833     return 0;
 834 }
 835
 836 sub get_maintainers {
 837     %email_hash_name = ();
 838     %email_hash_address = ();
 839     %commit_author_hash = ();
 840     %commit_signer_hash = ();
 841     @email_to = ();
 842     %hash_list_to = ();
 843     @list_to = ();
 844     @scm = ();
 845     @web = ();
 846     @subsystem = ();
 847     @status = ();
 848     %deduplicate_name_hash = ();
 849     %deduplicate_address_hash = ();
 850     if ($email_git_all_signature_types) {
 851         $signature_pattern = "(.+?)[Bb][Yy]:";
 852     } else {
 853         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 854     }
 855
 856     # Find responsible parties
 857
 858     my %exact_pattern_match_hash = ();
 859
 860     foreach my $file (@files) {
 861
 862         my %hash;
 863         my $tvi = find_first_section();
 864         while ($tvi < @typevalue) {
 865             my $start = find_starting_index($tvi);
 866             my $end = find_ending_index($tvi);
 867             my $exclude = 0;
 868             my $i;
 869
 870             #Do not match excluded file patterns
 871
 872             for ($i = $start; $i < $end; $i++) {
 873                 my $line = $typevalue[$i];
 874                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
 875                     my $type = $1;
 876                     my $value = $2;
 877                     if ($type eq 'X') {
 878                         if (file_match_pattern($file, $value)) {
 879                             $exclude = 1;
 880                             last;
 881                         }
 882                     }
 883                 }
 884             }
 885
 886             if (!$exclude) {
 887                 for ($i = $start; $i < $end; $i++) {
 888                     my $line = $typevalue[$i];
 889                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 890                         my $type = $1;
 891                         my $value = $2;
 892                         if ($type eq 'F') {
 893                             if (file_match_pattern($file, $value)) {
 894                                 my $value_pd = ($value =~ tr@/@@);
 895                                 my $file_pd = ($file  =~ tr@/@@);
 896                                 $value_pd++ if (substr($value,-1,1) ne "/");
 897                                 $value_pd = -1 if ($value =~ /^\.\*/);
 898                                 if ($value_pd >= $file_pd &&
 899                                     range_is_maintained($start, $end) &&
 900                                     range_has_maintainer($start, $end)) {
 901                                     $exact_pattern_match_hash{$file} = 1;
 902                                 }
 903                                 if ($pattern_depth == 0 ||
 904                                     (($file_pd - $value_pd) < $pattern_depth)) {
 905                                     $hash{$tvi} = $value_pd;
 906                                 }
 907                             }
 908                         } elsif ($type eq 'N') {
 909                             if ($file =~ m/$value/x) {
 910                                 $hash{$tvi} = 0;
 911                             }
 912                         }
 913                     }
 914                 }
 915             }
 916             $tvi = $end + 1;
 917         }
 918
 919         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 920             add_categories($line);
 921             if ($sections) {
 922                 my $i;
 923                 my $start = find_starting_index($line);
 924                 my $end = find_ending_index($line);
 925                 for ($i = $start; $i < $end; $i++) {
 926                     my $line = $typevalue[$i];
 927                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 928                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 929                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 930                         $line =~ s/\\\./\./g;           ##Convert \. to .
 931                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 932                     }
 933                     my $count = $line =~ s/^([A-Z]):/$1:\t/g;
 934                     if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
 935                         print("$line\n");
 936                     }
 937                 }
 938                 print("\n");
 939             }
 940         }
 941
 942         maintainers_in_file($file);
 943     }
 944
 945     if ($keywords) {
 946         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 947         foreach my $line (@keyword_tvi) {
 948             add_categories($line);
 949         }
 950     }
 951
 952     foreach my $email (@email_to, @list_to) {
 953         $email->[0] = deduplicate_email($email->[0]);
 954     }
 955
 956     foreach my $file (@files) {
 957         if ($email &&
 958             ($email_git ||
 959              ($email_git_fallback &&
 960               $file !~ /MAINTAINERS$/ &&
 961               !$exact_pattern_match_hash{$file}))) {
 962             vcs_file_signoffs($file);
 963         }
 964         if ($email && $email_git_blame) {
 965             vcs_file_blame($file);
 966         }
 967     }
 968
 969     if ($email) {
 970         foreach my $chief (@penguin_chief) {
 971             if ($chief =~ m/^(.*):(.*)/) {
 972                 my $email_address;
 973
 974                 $email_address = format_email($1, $2, $email_usename);
 975                 if ($email_git_penguin_chiefs) {
 976                     push(@email_to, [$email_address, 'chief penguin']);
 977                 } else {
 978                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 979                 }
 980             }
 981         }
 982
 983         foreach my $email (@file_emails) {
 984             my ($name, $address) = parse_email($email);
 985
 986             my $tmp_email = format_email($name, $address, $email_usename);
 987             push_email_address($tmp_email, '');
 988             add_role($tmp_email, 'in file');
 989         }
 990     }
 991
 992     foreach my $fix (@fixes) {
 993         vcs_add_commit_signers($fix, "blamed_fixes");
 994     }
 995
 996     my @to = ();
 997     if ($email || $email_list) {
 998         if ($email) {
 999             @to = (@to, @email_to);
1000         }
1001         if ($email_list) {
1002             @to = (@to, @list_to);
1003         }
1004     }
1005
1006     if ($interactive) {
1007         @to = interactive_get_maintainers(\@to);
1008     }
1009
1010     return @to;
1011 }
1012
1013 sub file_match_pattern {
1014     my ($file, $pattern) = @_;
1015     if (substr($pattern, -1) eq "/") {
1016         if ($file =~ m@^$pattern@) {
1017             return 1;
1018         }
1019     } else {
1020         if ($file =~ m@^$pattern@) {
1021             my $s1 = ($file =~ tr@/@@);
1022             my $s2 = ($pattern =~ tr@/@@);
1023             if ($s1 == $s2) {
1024                 return 1;
1025             }
1026         }
1027     }
1028     return 0;
1029 }
1030
1031 sub usage {
1032     print <<EOT;
1033 usage: $P [options] patchfile
1034        $P [options] -f file|directory
1035 version: $V
1036
1037 MAINTAINER field selection options:
1038   --email => print email address(es) if any
1039     --git => include recent git \*-by: signers
1040     --git-all-signature-types => include signers regardless of signature type
1041         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1042     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1043     --git-chief-penguins => include ${penguin_chiefs}
1044     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1045     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1046     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1047     --git-blame => use git blame to find modified commits for patch or file
1048     --git-blame-signatures => when used with --git-blame, also include all commit signers
1049     --git-since => git history to use (default: $email_git_since)
1050     --hg-since => hg history to use (default: $email_hg_since)
1051     --interactive => display a menu (mostly useful if used with the --git option)
1052     --m => include maintainer(s) if any
1053     --r => include reviewer(s) if any
1054     --n => include name 'Full Name <addr\@domain.tld>'
1055     --l => include list(s) if any
1056     --moderated => include moderated lists(s) if any (default: true)
1057     --s => include subscriber only list(s) if any (default: false)
1058     --remove-duplicates => minimize duplicate email names/addresses
1059     --roles => show roles (status:subsystem, git-signer, list, etc...)
1060     --rolestats => show roles and statistics (commits/total_commits, %)
1061     --file-emails => add email addresses found in -f file (default: 0 (off))
1062     --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on))
1063   --scm => print SCM tree(s) if any
1064   --status => print status if any
1065   --subsystem => print subsystem name if any
1066   --web => print website(s) if any
1067
1068 Output type options:
1069   --separator [, ] => separator for multiple entries on 1 line
1070     using --separator also sets --nomultiline if --separator is not [, ]
1071   --multiline => print 1 entry per line
1072
1073 Other options:
1074   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1075   --keywords => scan patch for keywords (default: $keywords)
1076   --sections => print all of the subsystem sections with pattern matches
1077   --letters => print all matching 'letter' types from all matching sections
1078   --mailmap => use .mailmap file (default: $email_use_mailmap)
1079   --no-tree => run without a kernel tree
1080   --self-test => show potential issues with MAINTAINERS file content
1081   --version => show version
1082   --help => show this help information
1083
1084 Default options:
1085   [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1086    --pattern-depth=0 --remove-duplicates --rolestats]
1087
1088 Notes:
1089   Using "-f directory" may give unexpected results:
1090       Used with "--git", git signators for _all_ files in and below
1091           directory are examined as git recurses directories.
1092           Any specified X: (exclude) pattern matches are _not_ ignored.
1093       Used with "--nogit", directory is used as a pattern match,
1094           no individual file within the directory or subdirectory
1095           is matched.
1096       Used with "--git-blame", does not iterate all files in directory
1097   Using "--git-blame" is slow and may add old committers and authors
1098       that are no longer active maintainers to the output.
1099   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1100       other automated tools that expect only ["name"] <email address>
1101       may not work because of additional output after <email address>.
1102   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1103       not the percentage of the entire file authored.  # of commits is
1104       not a good measure of amount of code authored.  1 major commit may
1105       contain a thousand lines, 5 trivial commits may modify a single line.
1106   If git is not installed, but mercurial (hg) is installed and an .hg
1107       repository exists, the following options apply to mercurial:
1108           --git,
1109           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1110           --git-blame
1111       Use --hg-since not --git-since to control date selection
1112   File ".get_maintainer.conf", if it exists in the linux kernel source root
1113       directory, can change whatever get_maintainer defaults are desired.
1114       Entries in this file can be any command line argument.
1115       This file is prepended to any additional command line arguments.
1116       Multiple lines and # comments are allowed.
1117   Most options have both positive and negative forms.
1118       The negative forms for --<foo> are --no<foo> and --no-<foo>.
1119
1120 EOT
1121 }
1122
1123 sub top_of_kernel_tree {
1124     my ($lk_path) = @_;
1125
1126     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1127         $lk_path .= "/";
1128     }
1129     if (   (-f "${lk_path}Kbuild")
1130         && (-e "${lk_path}MAINTAINERS")
1131         && (-f "${lk_path}Makefile")
1132         && (-f "${lk_path}README")
1133         && (-d "${lk_path}arch")
1134         && (-d "${lk_path}board")
1135         && (-d "${lk_path}common")
1136         && (-d "${lk_path}doc")
1137         && (-d "${lk_path}drivers")
1138         && (-d "${lk_path}dts")
1139         && (-d "${lk_path}fs")
1140         && (-d "${lk_path}lib")
1141         && (-d "${lk_path}include")
1142         && (-d "${lk_path}net")
1143         && (-d "${lk_path}post")
1144         && (-d "${lk_path}scripts")
1145         && (-d "${lk_path}test")
1146         && (-d "${lk_path}tools")) {
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) {
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 }