contrib/scripts/get_maintainer.pl

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