scripts/get_maintainer.pl

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