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