scripts/get_maintainer.pl

   1 #!/usr/bin/perl -w
   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 strict;
  14
  15 my $P = $0;
  16 my $V = '0.26-beta4';
  17
  18 use Getopt::Long qw(:config no_auto_abbrev);
  19
  20 my $lk_path = "./";
  21 my $email = 1;
  22 my $email_usename = 1;
  23 my $email_maintainer = 1;
  24 my $email_list = 1;
  25 my $email_subscriber_list = 0;
  26 my $email_git_penguin_chiefs = 0;
  27 my $email_git = 0;
  28 my $email_git_all_signature_types = 0;
  29 my $email_git_blame = 0;
  30 my $email_git_blame_signatures = 1;
  31 my $email_git_fallback = 1;
  32 my $email_git_min_signatures = 1;
  33 my $email_git_max_maintainers = 5;
  34 my $email_git_min_percent = 5;
  35 my $email_git_since = "1-year-ago";
  36 my $email_hg_since = "-365";
  37 my $interactive = 0;
  38 my $email_remove_duplicates = 1;
  39 my $output_multiline = 1;
  40 my $output_separator = ", ";
  41 my $output_roles = 0;
  42 my $output_rolestats = 0;
  43 my $scm = 0;
  44 my $web = 0;
  45 my $subsystem = 0;
  46 my $status = 0;
  47 my $keywords = 1;
  48 my $sections = 0;
  49 my $file_emails = 0;
  50 my $from_filename = 0;
  51 my $pattern_depth = 0;
  52 my $version = 0;
  53 my $help = 0;
  54
  55 my $vcs_used = 0;
  56
  57 my $exit = 0;
  58
  59 my %commit_author_hash;
  60 my %commit_signer_hash;
  61
  62 my @penguin_chief = ();
  63 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
  64 #Andrew wants in on most everything - 2009/01/14
  65 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  66
  67 my @penguin_chief_names = ();
  68 foreach my $chief (@penguin_chief) {
  69     if ($chief =~ m/^(.*):(.*)/) {
  70         my $chief_name = $1;
  71         my $chief_addr = $2;
  72         push(@penguin_chief_names, $chief_name);
  73     }
  74 }
  75 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  76
  77 # Signature types of people who are either
  78 #       a) responsible for the code in question, or
  79 #       b) familiar enough with it to give relevant feedback
  80 my @signature_tags = ();
  81 push(@signature_tags, "Signed-off-by:");
  82 push(@signature_tags, "Reviewed-by:");
  83 push(@signature_tags, "Acked-by:");
  84
  85 # rfc822 email address - preloaded methods go here.
  86 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  87 my $rfc822_char = '[\\000-\\377]';
  88
  89 # VCS command support: class-like functions and strings
  90
  91 my %VCS_cmds;
  92
  93 my %VCS_cmds_git = (
  94     "execute_cmd" => \&git_execute_cmd,
  95     "available" => '(which("git") ne "") && (-d ".git")',
  96     "find_signers_cmd" =>
  97         "git log --no-color --since=\$email_git_since " .
  98             '--format="GitCommit: %H%n' .
  99                       'GitAuthor: %an <%ae>%n' .
 100                       'GitDate: %aD%n' .
 101                       'GitSubject: %s%n' .
 102                       '%b%n"' .
 103             " -- \$file",
 104     "find_commit_signers_cmd" =>
 105         "git log --no-color " .
 106             '--format="GitCommit: %H%n' .
 107                       'GitAuthor: %an <%ae>%n' .
 108                       'GitDate: %aD%n' .
 109                       'GitSubject: %s%n' .
 110                       '%b%n"' .
 111             " -1 \$commit",
 112     "find_commit_author_cmd" =>
 113         "git log --no-color " .
 114             '--format="GitCommit: %H%n' .
 115                       'GitAuthor: %an <%ae>%n' .
 116                       'GitDate: %aD%n' .
 117                       'GitSubject: %s%n"' .
 118             " -1 \$commit",
 119     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 120     "blame_file_cmd" => "git blame -l \$file",
 121     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 122     "blame_commit_pattern" => "^([0-9a-f]+) ",
 123     "author_pattern" => "^GitAuthor: (.*)",
 124     "subject_pattern" => "^GitSubject: (.*)",
 125 );
 126
 127 my %VCS_cmds_hg = (
 128     "execute_cmd" => \&hg_execute_cmd,
 129     "available" => '(which("hg") ne "") && (-d ".hg")',
 130     "find_signers_cmd" =>
 131         "hg log --date=\$email_hg_since " .
 132             "--template='HgCommit: {node}\\n" .
 133                         "HgAuthor: {author}\\n" .
 134                         "HgSubject: {desc}\\n'" .
 135             " -- \$file",
 136     "find_commit_signers_cmd" =>
 137         "hg log " .
 138             "--template='HgSubject: {desc}\\n'" .
 139             " -r \$commit",
 140     "find_commit_author_cmd" =>
 141         "hg log " .
 142             "--template='HgCommit: {node}\\n" .
 143                         "HgAuthor: {author}\\n" .
 144                         "HgSubject: {desc|firstline}\\n'" .
 145             " -r \$commit",
 146     "blame_range_cmd" => "",            # not supported
 147     "blame_file_cmd" => "hg blame -n \$file",
 148     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 149     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 150     "author_pattern" => "^HgAuthor: (.*)",
 151     "subject_pattern" => "^HgSubject: (.*)",
 152 );
 153
 154 my $conf = which_conf(".get_maintainer.conf");
 155 if (-f $conf) {
 156     my @conf_args;
 157     open(my $conffile, '<', "$conf")
 158         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 159
 160     while (<$conffile>) {
 161         my $line = $_;
 162
 163         $line =~ s/\s*\n?$//g;
 164         $line =~ s/^\s*//g;
 165         $line =~ s/\s+/ /g;
 166
 167         next if ($line =~ m/^\s*#/);
 168         next if ($line =~ m/^\s*$/);
 169
 170         my @words = split(" ", $line);
 171         foreach my $word (@words) {
 172             last if ($word =~ m/^#/);
 173             push (@conf_args, $word);
 174         }
 175     }
 176     close($conffile);
 177     unshift(@ARGV, @conf_args) if @conf_args;
 178 }
 179
 180 if (!GetOptions(
 181                 'email!' => \$email,
 182                 'git!' => \$email_git,
 183                 'git-all-signature-types!' => \$email_git_all_signature_types,
 184                 'git-blame!' => \$email_git_blame,
 185                 'git-blame-signatures!' => \$email_git_blame_signatures,
 186                 'git-fallback!' => \$email_git_fallback,
 187                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 188                 'git-min-signatures=i' => \$email_git_min_signatures,
 189                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 190                 'git-min-percent=i' => \$email_git_min_percent,
 191                 'git-since=s' => \$email_git_since,
 192                 'hg-since=s' => \$email_hg_since,
 193                 'i|interactive!' => \$interactive,
 194                 'remove-duplicates!' => \$email_remove_duplicates,
 195                 'm!' => \$email_maintainer,
 196                 'n!' => \$email_usename,
 197                 'l!' => \$email_list,
 198                 's!' => \$email_subscriber_list,
 199                 'multiline!' => \$output_multiline,
 200                 'roles!' => \$output_roles,
 201                 'rolestats!' => \$output_rolestats,
 202                 'separator=s' => \$output_separator,
 203                 'subsystem!' => \$subsystem,
 204                 'status!' => \$status,
 205                 'scm!' => \$scm,
 206                 'web!' => \$web,
 207                 'pattern-depth=i' => \$pattern_depth,
 208                 'k|keywords!' => \$keywords,
 209                 'sections!' => \$sections,
 210                 'fe|file-emails!' => \$file_emails,
 211                 'f|file' => \$from_filename,
 212                 'v|version' => \$version,
 213                 'h|help|usage' => \$help,
 214                 )) {
 215     die "$P: invalid argument - use --help if necessary\n";
 216 }
 217
 218 if ($help != 0) {
 219     usage();
 220     exit 0;
 221 }
 222
 223 if ($version != 0) {
 224     print("${P} ${V}\n");
 225     exit 0;
 226 }
 227
 228 if (-t STDIN && !@ARGV) {
 229     # We're talking to a terminal, but have no command line arguments.
 230     die "$P: missing patchfile or -f file - use --help if necessary\n";
 231 }
 232
 233 $output_multiline = 0 if ($output_separator ne ", ");
 234 $output_rolestats = 1 if ($interactive);
 235 $output_roles = 1 if ($output_rolestats);
 236
 237 if ($sections) {
 238     $email = 0;
 239     $email_list = 0;
 240     $scm = 0;
 241     $status = 0;
 242     $subsystem = 0;
 243     $web = 0;
 244     $keywords = 0;
 245     $interactive = 0;
 246 } else {
 247     my $selections = $email + $scm + $status + $subsystem + $web;
 248     if ($selections == 0) {
 249         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 250     }
 251 }
 252
 253 if ($email &&
 254     ($email_maintainer + $email_list + $email_subscriber_list +
 255      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 256     die "$P: Please select at least 1 email option\n";
 257 }
 258
 259 if (!top_of_kernel_tree($lk_path)) {
 260     die "$P: The current directory does not appear to be "
 261         . "a linux kernel source tree.\n";
 262 }
 263
 264 ## Read MAINTAINERS for type/value pairs
 265
 266 my @typevalue = ();
 267 my %keyword_hash;
 268
 269 open (my $maint, '<', "${lk_path}MAINTAINERS")
 270     or die "$P: Can't open MAINTAINERS: $!\n";
 271 while (<$maint>) {
 272     my $line = $_;
 273
 274     if ($line =~ m/^(\C):\s*(.*)/) {
 275         my $type = $1;
 276         my $value = $2;
 277
 278         ##Filename pattern matching
 279         if ($type eq "F" || $type eq "X") {
 280             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 281             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 282             $value =~ s/\?/\./g;         ##Convert ? to .
 283             ##if pattern is a directory and it lacks a trailing slash, add one
 284             if ((-d $value)) {
 285                 $value =~ s@([^/])$@$1/@;
 286             }
 287         } elsif ($type eq "K") {
 288             $keyword_hash{@typevalue} = $value;
 289         }
 290         push(@typevalue, "$type:$value");
 291     } elsif (!/^(\s)*$/) {
 292         $line =~ s/\n$//g;
 293         push(@typevalue, $line);
 294     }
 295 }
 296 close($maint);
 297
 298
 299 #
 300 # Read mail address map
 301 #
 302
 303 my $mailmap = read_mailmap();
 304
 305 sub read_mailmap {
 306     my $mailmap = {
 307         names => {},
 308         addresses => {}
 309     };
 310
 311     if (!$email_remove_duplicates) {
 312         return $mailmap;
 313     }
 314
 315     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 316         or warn "$P: Can't open .mailmap: $!\n";
 317
 318     while (<$mailmap_file>) {
 319         s/#.*$//; #strip comments
 320         s/^\s+|\s+$//g; #trim
 321
 322         next if (/^\s*$/); #skip empty lines
 323         #entries have one of the following formats:
 324         # name1 <mail1>
 325         # <mail1> <mail2>
 326         # name1 <mail1> <mail2>
 327         # name1 <mail1> name2 <mail2>
 328         # (see man git-shortlog)
 329         if (/^(.+)<(.+)>$/) {
 330             my $real_name = $1;
 331             my $address = $2;
 332
 333             $real_name =~ s/\s+$//;
 334             $mailmap->{names}->{$address} = $real_name;
 335
 336         } elsif (/^<([^\s]+)>\s*<([^\s]+)>$/) {
 337             my $real_address = $1;
 338             my $wrong_address = $2;
 339
 340             $mailmap->{addresses}->{$wrong_address} = $real_address;
 341
 342         } elsif (/^(.+)<([^\s]+)>\s*<([^\s]+)>$/) {
 343             my $real_name= $1;
 344             my $real_address = $2;
 345             my $wrong_address = $3;
 346
 347             $real_name =~ s/\s+$//;
 348
 349             $mailmap->{names}->{$wrong_address} = $real_name;
 350             $mailmap->{addresses}->{$wrong_address} = $real_address;
 351
 352         } elsif (/^(.+)<([^\s]+)>\s*([^\s].*)<([^\s]+)>$/) {
 353             my $real_name = $1;
 354             my $real_address = $2;
 355             my $wrong_name = $3;
 356             my $wrong_address = $4;
 357
 358             $real_name =~ s/\s+$//;
 359             $wrong_name =~ s/\s+$//;
 360
 361             $mailmap->{names}->{format_email($wrong_name,$wrong_address,1)} = $real_name;
 362             $mailmap->{addresses}->{format_email($wrong_name,$wrong_address,1)} = $real_address;
 363         }
 364     }
 365     close($mailmap_file);
 366
 367     return $mailmap;
 368 }
 369
 370 ## use the filenames on the command line or find the filenames in the patchfiles
 371
 372 my @files = ();
 373 my @range = ();
 374 my @keyword_tvi = ();
 375 my @file_emails = ();
 376
 377 if (!@ARGV) {
 378     push(@ARGV, "&STDIN");
 379 }
 380
 381 foreach my $file (@ARGV) {
 382     if ($file ne "&STDIN") {
 383         ##if $file is a directory and it lacks a trailing slash, add one
 384         if ((-d $file)) {
 385             $file =~ s@([^/])$@$1/@;
 386         } elsif (!(-f $file)) {
 387             die "$P: file '${file}' not found\n";
 388         }
 389     }
 390     if ($from_filename) {
 391         push(@files, $file);
 392         if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
 393             open(my $f, '<', $file)
 394                 or die "$P: Can't open $file: $!\n";
 395             my $text = do { local($/) ; <$f> };
 396             close($f);
 397             if ($keywords) {
 398                 foreach my $line (keys %keyword_hash) {
 399                     if ($text =~ m/$keyword_hash{$line}/x) {
 400                         push(@keyword_tvi, $line);
 401                     }
 402                 }
 403             }
 404             if ($file_emails) {
 405                 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;
 406                 push(@file_emails, clean_file_emails(@poss_addr));
 407             }
 408         }
 409     } else {
 410         my $file_cnt = @files;
 411         my $lastfile;
 412
 413         open(my $patch, "< $file")
 414             or die "$P: Can't open $file: $!\n";
 415         while (<$patch>) {
 416             my $patch_line = $_;
 417             if (m/^\+\+\+\s+(\S+)/) {
 418                 my $filename = $1;
 419                 $filename =~ s@^[^/]*/@@;
 420                 $filename =~ s@\n@@;
 421                 $lastfile = $filename;
 422                 push(@files, $filename);
 423             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 424                 if ($email_git_blame) {
 425                     push(@range, "$lastfile:$1:$2");
 426                 }
 427             } elsif ($keywords) {
 428                 foreach my $line (keys %keyword_hash) {
 429                     if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
 430                         push(@keyword_tvi, $line);
 431                     }
 432                 }
 433             }
 434         }
 435         close($patch);
 436
 437         if ($file_cnt == @files) {
 438             warn "$P: file '${file}' doesn't appear to be a patch.  "
 439                 . "Add -f to options?\n";
 440         }
 441         @files = sort_and_uniq(@files);
 442     }
 443 }
 444
 445 @file_emails = uniq(@file_emails);
 446
 447 my %email_hash_name;
 448 my %email_hash_address;
 449 my @email_to = ();
 450 my %hash_list_to;
 451 my @list_to = ();
 452 my @scm = ();
 453 my @web = ();
 454 my @subsystem = ();
 455 my @status = ();
 456 my @interactive_to = ();
 457 my $signature_pattern;
 458
 459 my @maintainers = get_maintainers();
 460
 461 if (@maintainers) {
 462     @maintainers = merge_email(@maintainers);
 463     output(@maintainers);
 464 }
 465
 466 if ($scm) {
 467     @scm = uniq(@scm);
 468     output(@scm);
 469 }
 470
 471 if ($status) {
 472     @status = uniq(@status);
 473     output(@status);
 474 }
 475
 476 if ($subsystem) {
 477     @subsystem = uniq(@subsystem);
 478     output(@subsystem);
 479 }
 480
 481 if ($web) {
 482     @web = uniq(@web);
 483     output(@web);
 484 }
 485
 486 exit($exit);
 487
 488 sub get_maintainers {
 489     %email_hash_name = ();
 490     %email_hash_address = ();
 491     %commit_author_hash = ();
 492     %commit_signer_hash = ();
 493     @email_to = ();
 494     %hash_list_to = ();
 495     @list_to = ();
 496     @scm = ();
 497     @web = ();
 498     @subsystem = ();
 499     @status = ();
 500     @interactive_to = ();
 501     if ($email_git_all_signature_types) {
 502         $signature_pattern = "(.+?)[Bb][Yy]:";
 503     } else {
 504         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 505     }
 506
 507     # Find responsible parties
 508
 509     my %exact_pattern_match_hash;
 510
 511     foreach my $file (@files) {
 512
 513         my %hash;
 514         my $tvi = find_first_section();
 515         while ($tvi < @typevalue) {
 516             my $start = find_starting_index($tvi);
 517             my $end = find_ending_index($tvi);
 518             my $exclude = 0;
 519             my $i;
 520
 521             #Do not match excluded file patterns
 522
 523             for ($i = $start; $i < $end; $i++) {
 524                 my $line = $typevalue[$i];
 525                 if ($line =~ m/^(\C):\s*(.*)/) {
 526                     my $type = $1;
 527                     my $value = $2;
 528                     if ($type eq 'X') {
 529                         if (file_match_pattern($file, $value)) {
 530                             $exclude = 1;
 531                             last;
 532                         }
 533                     }
 534                 }
 535             }
 536
 537             if (!$exclude) {
 538                 for ($i = $start; $i < $end; $i++) {
 539                     my $line = $typevalue[$i];
 540                     if ($line =~ m/^(\C):\s*(.*)/) {
 541                         my $type = $1;
 542                         my $value = $2;
 543                         if ($type eq 'F') {
 544                             if (file_match_pattern($file, $value)) {
 545                                 my $value_pd = ($value =~ tr@/@@);
 546                                 my $file_pd = ($file  =~ tr@/@@);
 547                                 $value_pd++ if (substr($value,-1,1) ne "/");
 548                                 $value_pd = -1 if ($value =~ /^\.\*/);
 549                                 if ($value_pd >= $file_pd) {
 550                                     $exact_pattern_match_hash{$file} = 1;
 551                                 }
 552                                 if ($pattern_depth == 0 ||
 553                                     (($file_pd - $value_pd) < $pattern_depth)) {
 554                                     $hash{$tvi} = $value_pd;
 555                                 }
 556                             }
 557                         }
 558                     }
 559                 }
 560             }
 561             $tvi = $end + 1;
 562         }
 563
 564         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 565             add_categories($line);
 566             if ($sections) {
 567                 my $i;
 568                 my $start = find_starting_index($line);
 569                 my $end = find_ending_index($line);
 570                 for ($i = $start; $i < $end; $i++) {
 571                     my $line = $typevalue[$i];
 572                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 573                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 574                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 575                         $line =~ s/\\\./\./g;           ##Convert \. to .
 576                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 577                     }
 578                     $line =~ s/^([A-Z]):/$1:\t/g;
 579                     print("$line\n");
 580                 }
 581                 print("\n");
 582             }
 583         }
 584     }
 585
 586     if ($keywords) {
 587         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 588         foreach my $line (@keyword_tvi) {
 589             add_categories($line);
 590         }
 591     }
 592
 593     @interactive_to = (@email_to, @list_to);
 594
 595     foreach my $file (@files) {
 596         if ($email &&
 597             ($email_git || ($email_git_fallback &&
 598                             !$exact_pattern_match_hash{$file}))) {
 599             vcs_file_signoffs($file);
 600         }
 601         if ($email && $email_git_blame) {
 602             vcs_file_blame($file);
 603         }
 604     }
 605
 606     if ($email) {
 607         foreach my $chief (@penguin_chief) {
 608             if ($chief =~ m/^(.*):(.*)/) {
 609                 my $email_address;
 610
 611                 $email_address = format_email($1, $2, $email_usename);
 612                 if ($email_git_penguin_chiefs) {
 613                     push(@email_to, [$email_address, 'chief penguin']);
 614                 } else {
 615                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 616                 }
 617             }
 618         }
 619
 620         foreach my $email (@file_emails) {
 621             my ($name, $address) = parse_email($email);
 622
 623             my $tmp_email = format_email($name, $address, $email_usename);
 624             push_email_address($tmp_email, '');
 625             add_role($tmp_email, 'in file');
 626         }
 627     }
 628
 629     my @to = ();
 630     if ($email || $email_list) {
 631         if ($email) {
 632             @to = (@to, @email_to);
 633         }
 634         if ($email_list) {
 635             @to = (@to, @list_to);
 636         }
 637     }
 638
 639     if ($interactive) {
 640         @interactive_to = @to;
 641         @to = interactive_get_maintainers(\@interactive_to);
 642     }
 643
 644     return @to;
 645 }
 646
 647 sub file_match_pattern {
 648     my ($file, $pattern) = @_;
 649     if (substr($pattern, -1) eq "/") {
 650         if ($file =~ m@^$pattern@) {
 651             return 1;
 652         }
 653     } else {
 654         if ($file =~ m@^$pattern@) {
 655             my $s1 = ($file =~ tr@/@@);
 656             my $s2 = ($pattern =~ tr@/@@);
 657             if ($s1 == $s2) {
 658                 return 1;
 659             }
 660         }
 661     }
 662     return 0;
 663 }
 664
 665 sub usage {
 666     print <<EOT;
 667 usage: $P [options] patchfile
 668        $P [options] -f file|directory
 669 version: $V
 670
 671 MAINTAINER field selection options:
 672   --email => print email address(es) if any
 673     --git => include recent git \*-by: signers
 674     --git-all-signature-types => include signers regardless of signature type
 675         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
 676     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
 677     --git-chief-penguins => include ${penguin_chiefs}
 678     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
 679     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
 680     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
 681     --git-blame => use git blame to find modified commits for patch or file
 682     --git-since => git history to use (default: $email_git_since)
 683     --hg-since => hg history to use (default: $email_hg_since)
 684     --interactive => display a menu (mostly useful if used with the --git option)
 685     --m => include maintainer(s) if any
 686     --n => include name 'Full Name <addr\@domain.tld>'
 687     --l => include list(s) if any
 688     --s => include subscriber only list(s) if any
 689     --remove-duplicates => minimize duplicate email names/addresses
 690     --roles => show roles (status:subsystem, git-signer, list, etc...)
 691     --rolestats => show roles and statistics (commits/total_commits, %)
 692     --file-emails => add email addresses found in -f file (default: 0 (off))
 693   --scm => print SCM tree(s) if any
 694   --status => print status if any
 695   --subsystem => print subsystem name if any
 696   --web => print website(s) if any
 697
 698 Output type options:
 699   --separator [, ] => separator for multiple entries on 1 line
 700     using --separator also sets --nomultiline if --separator is not [, ]
 701   --multiline => print 1 entry per line
 702
 703 Other options:
 704   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 705   --keywords => scan patch for keywords (default: 1 (on))
 706   --sections => print the entire subsystem sections with pattern matches
 707   --version => show version
 708   --help => show this help information
 709
 710 Default options:
 711   [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
 712
 713 Notes:
 714   Using "-f directory" may give unexpected results:
 715       Used with "--git", git signators for _all_ files in and below
 716           directory are examined as git recurses directories.
 717           Any specified X: (exclude) pattern matches are _not_ ignored.
 718       Used with "--nogit", directory is used as a pattern match,
 719           no individual file within the directory or subdirectory
 720           is matched.
 721       Used with "--git-blame", does not iterate all files in directory
 722   Using "--git-blame" is slow and may add old committers and authors
 723       that are no longer active maintainers to the output.
 724   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
 725       other automated tools that expect only ["name"] <email address>
 726       may not work because of additional output after <email address>.
 727   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
 728       not the percentage of the entire file authored.  # of commits is
 729       not a good measure of amount of code authored.  1 major commit may
 730       contain a thousand lines, 5 trivial commits may modify a single line.
 731   If git is not installed, but mercurial (hg) is installed and an .hg
 732       repository exists, the following options apply to mercurial:
 733           --git,
 734           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
 735           --git-blame
 736       Use --hg-since not --git-since to control date selection
 737   File ".get_maintainer.conf", if it exists in the linux kernel source root
 738       directory, can change whatever get_maintainer defaults are desired.
 739       Entries in this file can be any command line argument.
 740       This file is prepended to any additional command line arguments.
 741       Multiple lines and # comments are allowed.
 742 EOT
 743 }
 744
 745 sub top_of_kernel_tree {
 746     my ($lk_path) = @_;
 747
 748     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 749         $lk_path .= "/";
 750     }
 751     if (   (-f "${lk_path}COPYING")
 752         && (-f "${lk_path}CREDITS")
 753         && (-f "${lk_path}Kbuild")
 754         && (-f "${lk_path}MAINTAINERS")
 755         && (-f "${lk_path}Makefile")
 756         && (-f "${lk_path}README")
 757         && (-d "${lk_path}Documentation")
 758         && (-d "${lk_path}arch")
 759         && (-d "${lk_path}include")
 760         && (-d "${lk_path}drivers")
 761         && (-d "${lk_path}fs")
 762         && (-d "${lk_path}init")
 763         && (-d "${lk_path}ipc")
 764         && (-d "${lk_path}kernel")
 765         && (-d "${lk_path}lib")
 766         && (-d "${lk_path}scripts")) {
 767         return 1;
 768     }
 769     return 0;
 770 }
 771
 772 sub parse_email {
 773     my ($formatted_email) = @_;
 774
 775     my $name = "";
 776     my $address = "";
 777
 778     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
 779         $name = $1;
 780         $address = $2;
 781     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
 782         $address = $1;
 783     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
 784         $address = $1;
 785     }
 786
 787     $name =~ s/^\s+|\s+$//g;
 788     $name =~ s/^\"|\"$//g;
 789     $address =~ s/^\s+|\s+$//g;
 790
 791     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 792         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 793         $name = "\"$name\"";
 794     }
 795
 796     return ($name, $address);
 797 }
 798
 799 sub format_email {
 800     my ($name, $address, $usename) = @_;
 801
 802     my $formatted_email;
 803
 804     $name =~ s/^\s+|\s+$//g;
 805     $name =~ s/^\"|\"$//g;
 806     $address =~ s/^\s+|\s+$//g;
 807
 808     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 809         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 810         $name = "\"$name\"";
 811     }
 812
 813     if ($usename) {
 814         if ("$name" eq "") {
 815             $formatted_email = "$address";
 816         } else {
 817             $formatted_email = "$name <$address>";
 818         }
 819     } else {
 820         $formatted_email = $address;
 821     }
 822
 823     return $formatted_email;
 824 }
 825
 826 sub find_first_section {
 827     my $index = 0;
 828
 829     while ($index < @typevalue) {
 830         my $tv = $typevalue[$index];
 831         if (($tv =~ m/^(\C):\s*(.*)/)) {
 832             last;
 833         }
 834         $index++;
 835     }
 836
 837     return $index;
 838 }
 839
 840 sub find_starting_index {
 841     my ($index) = @_;
 842
 843     while ($index > 0) {
 844         my $tv = $typevalue[$index];
 845         if (!($tv =~ m/^(\C):\s*(.*)/)) {
 846             last;
 847         }
 848         $index--;
 849     }
 850
 851     return $index;
 852 }
 853
 854 sub find_ending_index {
 855     my ($index) = @_;
 856
 857     while ($index < @typevalue) {
 858         my $tv = $typevalue[$index];
 859         if (!($tv =~ m/^(\C):\s*(.*)/)) {
 860             last;
 861         }
 862         $index++;
 863     }
 864
 865     return $index;
 866 }
 867
 868 sub get_maintainer_role {
 869     my ($index) = @_;
 870
 871     my $i;
 872     my $start = find_starting_index($index);
 873     my $end = find_ending_index($index);
 874
 875     my $role;
 876     my $subsystem = $typevalue[$start];
 877     if (length($subsystem) > 20) {
 878         $subsystem = substr($subsystem, 0, 17);
 879         $subsystem =~ s/\s*$//;
 880         $subsystem = $subsystem . "...";
 881     }
 882
 883     for ($i = $start + 1; $i < $end; $i++) {
 884         my $tv = $typevalue[$i];
 885         if ($tv =~ m/^(\C):\s*(.*)/) {
 886             my $ptype = $1;
 887             my $pvalue = $2;
 888             if ($ptype eq "S") {
 889                 $role = $pvalue;
 890             }
 891         }
 892     }
 893
 894     $role = lc($role);
 895     if      ($role eq "supported") {
 896         $role = "supporter";
 897     } elsif ($role eq "maintained") {
 898         $role = "maintainer";
 899     } elsif ($role eq "odd fixes") {
 900         $role = "odd fixer";
 901     } elsif ($role eq "orphan") {
 902         $role = "orphan minder";
 903     } elsif ($role eq "obsolete") {
 904         $role = "obsolete minder";
 905     } elsif ($role eq "buried alive in reporters") {
 906         $role = "chief penguin";
 907     }
 908
 909     return $role . ":" . $subsystem;
 910 }
 911
 912 sub get_list_role {
 913     my ($index) = @_;
 914
 915     my $i;
 916     my $start = find_starting_index($index);
 917     my $end = find_ending_index($index);
 918
 919     my $subsystem = $typevalue[$start];
 920     if (length($subsystem) > 20) {
 921         $subsystem = substr($subsystem, 0, 17);
 922         $subsystem =~ s/\s*$//;
 923         $subsystem = $subsystem . "...";
 924     }
 925
 926     if ($subsystem eq "THE REST") {
 927         $subsystem = "";
 928     }
 929
 930     return $subsystem;
 931 }
 932
 933 sub add_categories {
 934     my ($index) = @_;
 935
 936     my $i;
 937     my $start = find_starting_index($index);
 938     my $end = find_ending_index($index);
 939
 940     push(@subsystem, $typevalue[$start]);
 941
 942     for ($i = $start + 1; $i < $end; $i++) {
 943         my $tv = $typevalue[$i];
 944         if ($tv =~ m/^(\C):\s*(.*)/) {
 945             my $ptype = $1;
 946             my $pvalue = $2;
 947             if ($ptype eq "L") {
 948                 my $list_address = $pvalue;
 949                 my $list_additional = "";
 950                 my $list_role = get_list_role($i);
 951
 952                 if ($list_role ne "") {
 953                     $list_role = ":" . $list_role;
 954                 }
 955                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
 956                     $list_address = $1;
 957                     $list_additional = $2;
 958                 }
 959                 if ($list_additional =~ m/subscribers-only/) {
 960                     if ($email_subscriber_list) {
 961                         if (!$hash_list_to{lc($list_address)}) {
 962                             $hash_list_to{lc($list_address)} = 1;
 963                             push(@list_to, [$list_address,
 964                                             "subscriber list${list_role}"]);
 965                         }
 966                     }
 967                 } else {
 968                     if ($email_list) {
 969                         if (!$hash_list_to{lc($list_address)}) {
 970                             $hash_list_to{lc($list_address)} = 1;
 971                             push(@list_to, [$list_address,
 972                                             "open list${list_role}"]);
 973                         }
 974                     }
 975                 }
 976             } elsif ($ptype eq "M") {
 977                 my ($name, $address) = parse_email($pvalue);
 978                 if ($name eq "") {
 979                     if ($i > 0) {
 980                         my $tv = $typevalue[$i - 1];
 981                         if ($tv =~ m/^(\C):\s*(.*)/) {
 982                             if ($1 eq "P") {
 983                                 $name = $2;
 984                                 $pvalue = format_email($name, $address, $email_usename);
 985                             }
 986                         }
 987                     }
 988                 }
 989                 if ($email_maintainer) {
 990                     my $role = get_maintainer_role($i);
 991                     push_email_addresses($pvalue, $role);
 992                 }
 993             } elsif ($ptype eq "T") {
 994                 push(@scm, $pvalue);
 995             } elsif ($ptype eq "W") {
 996                 push(@web, $pvalue);
 997             } elsif ($ptype eq "S") {
 998                 push(@status, $pvalue);
 999             }
1000         }
1001     }
1002 }
1003
1004 sub email_inuse {
1005     my ($name, $address) = @_;
1006
1007     return 1 if (($name eq "") && ($address eq ""));
1008     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1009     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1010
1011     return 0;
1012 }
1013
1014 sub push_email_address {
1015     my ($line, $role) = @_;
1016
1017     my ($name, $address) = parse_email($line);
1018
1019     if ($address eq "") {
1020         return 0;
1021     }
1022
1023     if (!$email_remove_duplicates) {
1024         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1025     } elsif (!email_inuse($name, $address)) {
1026         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1027         $email_hash_name{lc($name)}++;
1028         $email_hash_address{lc($address)}++;
1029     }
1030
1031     return 1;
1032 }
1033
1034 sub push_email_addresses {
1035     my ($address, $role) = @_;
1036
1037     my @address_list = ();
1038
1039     if (rfc822_valid($address)) {
1040         push_email_address($address, $role);
1041     } elsif (@address_list = rfc822_validlist($address)) {
1042         my $array_count = shift(@address_list);
1043         while (my $entry = shift(@address_list)) {
1044             push_email_address($entry, $role);
1045         }
1046     } else {
1047         if (!push_email_address($address, $role)) {
1048             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1049         }
1050     }
1051 }
1052
1053 sub add_role {
1054     my ($line, $role) = @_;
1055
1056     my ($name, $address) = parse_email($line);
1057     my $email = format_email($name, $address, $email_usename);
1058
1059     foreach my $entry (@email_to) {
1060         if ($email_remove_duplicates) {
1061             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1062             if (($name eq $entry_name || $address eq $entry_address)
1063                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1064             ) {
1065                 if ($entry->[1] eq "") {
1066                     $entry->[1] = "$role";
1067                 } else {
1068                     $entry->[1] = "$entry->[1],$role";
1069                 }
1070             }
1071         } else {
1072             if ($email eq $entry->[0]
1073                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1074             ) {
1075                 if ($entry->[1] eq "") {
1076                     $entry->[1] = "$role";
1077                 } else {
1078                     $entry->[1] = "$entry->[1],$role";
1079                 }
1080             }
1081         }
1082     }
1083 }
1084
1085 sub which {
1086     my ($bin) = @_;
1087
1088     foreach my $path (split(/:/, $ENV{PATH})) {
1089         if (-e "$path/$bin") {
1090             return "$path/$bin";
1091         }
1092     }
1093
1094     return "";
1095 }
1096
1097 sub which_conf {
1098     my ($conf) = @_;
1099
1100     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1101         if (-e "$path/$conf") {
1102             return "$path/$conf";
1103         }
1104     }
1105
1106     return "";
1107 }
1108
1109 sub mailmap_email {
1110     my $line = shift;
1111
1112     my ($name, $address) = parse_email($line);
1113     my $email = format_email($name, $address, 1);
1114     my $real_name = $name;
1115     my $real_address = $address;
1116
1117     if (exists $mailmap->{names}->{$email} ||
1118         exists $mailmap->{addresses}->{$email}) {
1119         if (exists $mailmap->{names}->{$email}) {
1120             $real_name = $mailmap->{names}->{$email};
1121         }
1122         if (exists $mailmap->{addresses}->{$email}) {
1123             $real_address = $mailmap->{addresses}->{$email};
1124         }
1125     } else {
1126         if (exists $mailmap->{names}->{$address}) {
1127             $real_name = $mailmap->{names}->{$address};
1128         }
1129         if (exists $mailmap->{addresses}->{$address}) {
1130             $real_address = $mailmap->{addresses}->{$address};
1131         }
1132     }
1133     return format_email($real_name, $real_address, 1);
1134 }
1135
1136 sub mailmap {
1137     my (@addresses) = @_;
1138
1139     my @ret = ();
1140     foreach my $line (@addresses) {
1141         push(@ret, mailmap_email($line), 1);
1142     }
1143
1144     merge_by_realname(@ret) if $email_remove_duplicates;
1145
1146     return @ret;
1147 }
1148
1149 sub merge_by_realname {
1150     my %address_map;
1151     my (@emails) = @_;
1152     foreach my $email (@emails) {
1153         my ($name, $address) = parse_email($email);
1154         if (!exists $address_map{$name}) {
1155             $address_map{$name} = $address;
1156         } else {
1157             $address = $address_map{$name};
1158             $email = format_email($name,$address,1);
1159         }
1160     }
1161 }
1162
1163 sub git_execute_cmd {
1164     my ($cmd) = @_;
1165     my @lines = ();
1166
1167     my $output = `$cmd`;
1168     $output =~ s/^\s*//gm;
1169     @lines = split("\n", $output);
1170
1171     return @lines;
1172 }
1173
1174 sub hg_execute_cmd {
1175     my ($cmd) = @_;
1176     my @lines = ();
1177
1178     my $output = `$cmd`;
1179     @lines = split("\n", $output);
1180
1181     return @lines;
1182 }
1183
1184 sub extract_formatted_signatures {
1185     my (@signature_lines) = @_;
1186
1187     my @type = @signature_lines;
1188
1189     s/\s*(.*):.*/$1/ for (@type);
1190
1191     # cut -f2- -d":"
1192     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1193
1194 ## Reformat email addresses (with names) to avoid badly written signatures
1195
1196     foreach my $signer (@signature_lines) {
1197         my ($name, $address) = parse_email($signer);
1198         $signer = format_email($name, $address, 1);
1199     }
1200
1201     return (\@type, \@signature_lines);
1202 }
1203
1204 sub vcs_find_signers {
1205     my ($cmd) = @_;
1206     my $commits;
1207     my @lines = ();
1208     my @signatures = ();
1209
1210     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1211
1212     my $pattern = $VCS_cmds{"commit_pattern"};
1213
1214     $commits = grep(/$pattern/, @lines);        # of commits
1215
1216     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1217
1218     return (0, @signatures) if !@signatures;
1219
1220     save_commits_by_author(@lines) if ($interactive);
1221     save_commits_by_signer(@lines) if ($interactive);
1222
1223     if (!$email_git_penguin_chiefs) {
1224         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1225     }
1226
1227     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1228
1229     return ($commits, @$signers_ref);
1230 }
1231
1232 sub vcs_find_author {
1233     my ($cmd) = @_;
1234     my @lines = ();
1235
1236     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1237
1238     if (!$email_git_penguin_chiefs) {
1239         @lines = grep(!/${penguin_chiefs}/i, @lines);
1240     }
1241
1242     return @lines if !@lines;
1243
1244     my @authors = ();
1245     foreach my $line (@lines) {
1246         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1247             my $author = $1;
1248             my ($name, $address) = parse_email($author);
1249             $author = format_email($name, $address, 1);
1250             push(@authors, $author);
1251         }
1252     }
1253
1254     save_commits_by_author(@lines) if ($interactive);
1255     save_commits_by_signer(@lines) if ($interactive);
1256
1257     return @authors;
1258 }
1259
1260 sub vcs_save_commits {
1261     my ($cmd) = @_;
1262     my @lines = ();
1263     my @commits = ();
1264
1265     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1266
1267     foreach my $line (@lines) {
1268         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1269             push(@commits, $1);
1270         }
1271     }
1272
1273     return @commits;
1274 }
1275
1276 sub vcs_blame {
1277     my ($file) = @_;
1278     my $cmd;
1279     my @commits = ();
1280
1281     return @commits if (!(-f $file));
1282
1283     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1284         my @all_commits = ();
1285
1286         $cmd = $VCS_cmds{"blame_file_cmd"};
1287         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1288         @all_commits = vcs_save_commits($cmd);
1289
1290         foreach my $file_range_diff (@range) {
1291             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1292             my $diff_file = $1;
1293             my $diff_start = $2;
1294             my $diff_length = $3;
1295             next if ("$file" ne "$diff_file");
1296             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1297                 push(@commits, $all_commits[$i]);
1298             }
1299         }
1300     } elsif (@range) {
1301         foreach my $file_range_diff (@range) {
1302             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1303             my $diff_file = $1;
1304             my $diff_start = $2;
1305             my $diff_length = $3;
1306             next if ("$file" ne "$diff_file");
1307             $cmd = $VCS_cmds{"blame_range_cmd"};
1308             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1309             push(@commits, vcs_save_commits($cmd));
1310         }
1311     } else {
1312         $cmd = $VCS_cmds{"blame_file_cmd"};
1313         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1314         @commits = vcs_save_commits($cmd);
1315     }
1316
1317     foreach my $commit (@commits) {
1318         $commit =~ s/^\^//g;
1319     }
1320
1321     return @commits;
1322 }
1323
1324 my $printed_novcs = 0;
1325 sub vcs_exists {
1326     %VCS_cmds = %VCS_cmds_git;
1327     return 1 if eval $VCS_cmds{"available"};
1328     %VCS_cmds = %VCS_cmds_hg;
1329     return 2 if eval $VCS_cmds{"available"};
1330     %VCS_cmds = ();
1331     if (!$printed_novcs) {
1332         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1333         warn("Using a git repository produces better results.\n");
1334         warn("Try Linus Torvalds' latest git repository using:\n");
1335         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n");
1336         $printed_novcs = 1;
1337     }
1338     return 0;
1339 }
1340
1341 sub vcs_is_git {
1342     return $vcs_used == 1;
1343 }
1344
1345 sub vcs_is_hg {
1346     return $vcs_used == 2;
1347 }
1348
1349 sub interactive_get_maintainers {
1350     my ($list_ref) = @_;
1351     my @list = @$list_ref;
1352
1353     vcs_exists();
1354
1355     my %selected;
1356     my %authored;
1357     my %signed;
1358     my $count = 0;
1359     my $maintained = 0;
1360     #select maintainers by default
1361     foreach my $entry (@list) {
1362         my $role = $entry->[1];
1363         $selected{$count} = ($role =~ /^(maintainer|supporter|open list)/i);
1364         $maintained = 1 if ($role =~ /^(maintainer|supporter)/i);
1365         $authored{$count} = 0;
1366         $signed{$count} = 0;
1367         $count++;
1368     }
1369
1370     #menu loop
1371     my $done = 0;
1372     my $print_options = 0;
1373     my $redraw = 1;
1374     while (!$done) {
1375         $count = 0;
1376         if ($redraw) {
1377             printf STDERR "\n%1s %2s %-65s",
1378                           "*", "#", "email/list and role:stats";
1379             if ($email_git ||
1380                 ($email_git_fallback && !$maintained) ||
1381                 $email_git_blame) {
1382                 print STDERR "auth sign";
1383             }
1384             print STDERR "\n";
1385             foreach my $entry (@list) {
1386                 my $email = $entry->[0];
1387                 my $role = $entry->[1];
1388                 my $sel = "";
1389                 $sel = "*" if ($selected{$count});
1390                 my $commit_author = $commit_author_hash{$email};
1391                 my $commit_signer = $commit_signer_hash{$email};
1392                 my $authored = 0;
1393                 my $signed = 0;
1394                 $authored++ for (@{$commit_author});
1395                 $signed++ for (@{$commit_signer});
1396                 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1397                 printf STDERR "%4d %4d", $authored, $signed
1398                     if ($authored > 0 || $signed > 0);
1399                 printf STDERR "\n     %s\n", $role;
1400                 if ($authored{$count}) {
1401                     my $commit_author = $commit_author_hash{$email};
1402                     foreach my $ref (@{$commit_author}) {
1403                         print STDERR "     Author: @{$ref}[1]\n";
1404                     }
1405                 }
1406                 if ($signed{$count}) {
1407                     my $commit_signer = $commit_signer_hash{$email};
1408                     foreach my $ref (@{$commit_signer}) {
1409                         print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1410                     }
1411                 }
1412
1413                 $count++;
1414             }
1415         }
1416         my $date_ref = \$email_git_since;
1417         $date_ref = \$email_hg_since if (vcs_is_hg());
1418         if ($print_options) {
1419             $print_options = 0;
1420             if (vcs_exists()) {
1421                 print STDERR
1422 "\nVersion Control options:\n" .
1423 "g  use git history      [$email_git]\n" .
1424 "gf use git-fallback     [$email_git_fallback]\n" .
1425 "b  use git blame        [$email_git_blame]\n" .
1426 "bs use blame signatures [$email_git_blame_signatures]\n" .
1427 "c# minimum commits      [$email_git_min_signatures]\n" .
1428 "%# min percent          [$email_git_min_percent]\n" .
1429 "d# history to use       [$$date_ref]\n" .
1430 "x# max maintainers      [$email_git_max_maintainers]\n" .
1431 "t  all signature types  [$email_git_all_signature_types]\n";
1432             }
1433             print STDERR "\nAdditional options:\n" .
1434 "0  toggle all\n" .
1435 "f  emails in file       [$file_emails]\n" .
1436 "k  keywords in file     [$keywords]\n" .
1437 "r  remove duplicates    [$email_remove_duplicates]\n" .
1438 "p# pattern match depth  [$pattern_depth]\n";
1439         }
1440         print STDERR
1441 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1442
1443         my $input = <STDIN>;
1444         chomp($input);
1445
1446         $redraw = 1;
1447         my $rerun = 0;
1448         my @wish = split(/[, ]+/, $input);
1449         foreach my $nr (@wish) {
1450             $nr = lc($nr);
1451             my $sel = substr($nr, 0, 1);
1452             my $str = substr($nr, 1);
1453             my $val = 0;
1454             $val = $1 if $str =~ /^(\d+)$/;
1455
1456             if ($sel eq "y") {
1457                 $interactive = 0;
1458                 $done = 1;
1459                 $output_rolestats = 0;
1460                 $output_roles = 0;
1461                 last;
1462             } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1463                 $selected{$nr - 1} = !$selected{$nr - 1};
1464             } elsif ($sel eq "*" || $sel eq '^') {
1465                 my $toggle = 0;
1466                 $toggle = 1 if ($sel eq '*');
1467                 for (my $i = 0; $i < $count; $i++) {
1468                     $selected{$i} = $toggle;
1469                 }
1470             } elsif ($sel eq "0") {
1471                 for (my $i = 0; $i < $count; $i++) {
1472                     $selected{$i} = !$selected{$i};
1473                 }
1474             } elsif ($sel eq "a") {
1475                 if ($val > 0 && $val <= $count) {
1476                     $authored{$val - 1} = !$authored{$val - 1};
1477                 } elsif ($str eq '*' || $str eq '^') {
1478                     my $toggle = 0;
1479                     $toggle = 1 if ($str eq '*');
1480                     for (my $i = 0; $i < $count; $i++) {
1481                         $authored{$i} = $toggle;
1482                     }
1483                 }
1484             } elsif ($sel eq "s") {
1485                 if ($val > 0 && $val <= $count) {
1486                     $signed{$val - 1} = !$signed{$val - 1};
1487                 } elsif ($str eq '*' || $str eq '^') {
1488                     my $toggle = 0;
1489                     $toggle = 1 if ($str eq '*');
1490                     for (my $i = 0; $i < $count; $i++) {
1491                         $signed{$i} = $toggle;
1492                     }
1493                 }
1494             } elsif ($sel eq "o") {
1495                 $print_options = 1;
1496                 $redraw = 1;
1497             } elsif ($sel eq "g") {
1498                 if ($str eq "f") {
1499                     bool_invert(\$email_git_fallback);
1500                 } else {
1501                     bool_invert(\$email_git);
1502                 }
1503                 $rerun = 1;
1504             } elsif ($sel eq "b") {
1505                 if ($str eq "s") {
1506                     bool_invert(\$email_git_blame_signatures);
1507                 } else {
1508                     bool_invert(\$email_git_blame);
1509                 }
1510                 $rerun = 1;
1511             } elsif ($sel eq "c") {
1512                 if ($val > 0) {
1513                     $email_git_min_signatures = $val;
1514                     $rerun = 1;
1515                 }
1516             } elsif ($sel eq "x") {
1517                 if ($val > 0) {
1518                     $email_git_max_maintainers = $val;
1519                     $rerun = 1;
1520                 }
1521             } elsif ($sel eq "%") {
1522                 if ($str ne "" && $val >= 0) {
1523                     $email_git_min_percent = $val;
1524                     $rerun = 1;
1525                 }
1526             } elsif ($sel eq "d") {
1527                 if (vcs_is_git()) {
1528                     $email_git_since = $str;
1529                 } elsif (vcs_is_hg()) {
1530                     $email_hg_since = $str;
1531                 }
1532                 $rerun = 1;
1533             } elsif ($sel eq "t") {
1534                 bool_invert(\$email_git_all_signature_types);
1535                 $rerun = 1;
1536             } elsif ($sel eq "f") {
1537                 bool_invert(\$file_emails);
1538                 $rerun = 1;
1539             } elsif ($sel eq "r") {
1540                 bool_invert(\$email_remove_duplicates);
1541                 $rerun = 1;
1542             } elsif ($sel eq "k") {
1543                 bool_invert(\$keywords);
1544                 $rerun = 1;
1545             } elsif ($sel eq "p") {
1546                 if ($str ne "" && $val >= 0) {
1547                     $pattern_depth = $val;
1548                     $rerun = 1;
1549                 }
1550             } elsif ($sel eq "h" || $sel eq "?") {
1551                 print STDERR <<EOT
1552
1553 Interactive mode allows you to select the various maintainers, submitters,
1554 commit signers and mailing lists that could be CC'd on a patch.
1555
1556 Any *'d entry is selected.
1557
1558 If you have git or hg installed, you can choose to summarize the commit
1559 history of files in the patch.  Also, each line of the current file can
1560 be matched to its commit author and that commits signers with blame.
1561
1562 Various knobs exist to control the length of time for active commit
1563 tracking, the maximum number of commit authors and signers to add,
1564 and such.
1565
1566 Enter selections at the prompt until you are satisfied that the selected
1567 maintainers are appropriate.  You may enter multiple selections separated
1568 by either commas or spaces.
1569
1570 EOT
1571             } else {
1572                 print STDERR "invalid option: '$nr'\n";
1573                 $redraw = 0;
1574             }
1575         }
1576         if ($rerun) {
1577             print STDERR "git-blame can be very slow, please have patience..."
1578                 if ($email_git_blame);
1579             goto &get_maintainers;
1580         }
1581     }
1582
1583     #drop not selected entries
1584     $count = 0;
1585     my @new_emailto = ();
1586     foreach my $entry (@list) {
1587         if ($selected{$count}) {
1588             push(@new_emailto, $list[$count]);
1589         }
1590         $count++;
1591     }
1592     return @new_emailto;
1593 }
1594
1595 sub bool_invert {
1596     my ($bool_ref) = @_;
1597
1598     if ($$bool_ref) {
1599         $$bool_ref = 0;
1600     } else {
1601         $$bool_ref = 1;
1602     }
1603 }
1604
1605 sub save_commits_by_author {
1606     my (@lines) = @_;
1607
1608     my @authors = ();
1609     my @commits = ();
1610     my @subjects = ();
1611
1612     foreach my $line (@lines) {
1613         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1614             my $matched = 0;
1615             my $author = $1;
1616             my ($name, $address) = parse_email($author);
1617             foreach my $to (@interactive_to) {
1618                 my ($to_name, $to_address) = parse_email($to->[0]);
1619                 if ($email_remove_duplicates &&
1620                     ((lc($name) eq lc($to_name)) ||
1621                      (lc($address) eq lc($to_address)))) {
1622                     $author = $to->[0];
1623                     $matched = 1;
1624                     last;
1625                 }
1626             }
1627             $author = format_email($name, $address, 1) if (!$matched);
1628             push(@authors, $author);
1629         }
1630         push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1631         push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1632     }
1633
1634     for (my $i = 0; $i < @authors; $i++) {
1635         my $exists = 0;
1636         foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1637             if (@{$ref}[0] eq $commits[$i] &&
1638                 @{$ref}[1] eq $subjects[$i]) {
1639                 $exists = 1;
1640                 last;
1641             }
1642         }
1643         if (!$exists) {
1644             push(@{$commit_author_hash{$authors[$i]}},
1645                  [ ($commits[$i], $subjects[$i]) ]);
1646         }
1647     }
1648 }
1649
1650 sub save_commits_by_signer {
1651     my (@lines) = @_;
1652
1653     my $commit = "";
1654     my $subject = "";
1655
1656     foreach my $line (@lines) {
1657         $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1658         $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1659         if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1660             my @signatures = ($line);
1661             my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1662             my @types = @$types_ref;
1663             my @signers = @$signers_ref;
1664
1665             my $type = $types[0];
1666             my $signer = $signers[0];
1667
1668             my $matched = 0;
1669             my ($name, $address) = parse_email($signer);
1670             foreach my $to (@interactive_to) {
1671                 my ($to_name, $to_address) = parse_email($to->[0]);
1672                 if ($email_remove_duplicates &&
1673                     ((lc($name) eq lc($to_name)) ||
1674                      (lc($address) eq lc($to_address)))) {
1675                     $signer = $to->[0];
1676                     $matched = 1;
1677                     last;
1678                 }
1679                 $signer = format_email($name, $address, 1) if (!$matched);
1680             }
1681
1682             my $exists = 0;
1683             foreach my $ref(@{$commit_signer_hash{$signer}}) {
1684                 if (@{$ref}[0] eq $commit &&
1685                     @{$ref}[1] eq $subject &&
1686                     @{$ref}[2] eq $type) {
1687                     $exists = 1;
1688                     last;
1689                 }
1690             }
1691             if (!$exists) {
1692                 push(@{$commit_signer_hash{$signer}},
1693                      [ ($commit, $subject, $type) ]);
1694             }
1695         }
1696     }
1697 }
1698
1699 sub vcs_assign {
1700     my ($role, $divisor, @lines) = @_;
1701
1702     my %hash;
1703     my $count = 0;
1704
1705     return if (@lines <= 0);
1706
1707     if ($divisor <= 0) {
1708         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1709         $divisor = 1;
1710     }
1711
1712     @lines = mailmap(@lines);
1713
1714     return if (@lines <= 0);
1715
1716     @lines = sort(@lines);
1717
1718     # uniq -c
1719     $hash{$_}++ for @lines;
1720
1721     # sort -rn
1722     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1723         my $sign_offs = $hash{$line};
1724         my $percent = $sign_offs * 100 / $divisor;
1725
1726         $percent = 100 if ($percent > 100);
1727         $count++;
1728         last if ($sign_offs < $email_git_min_signatures ||
1729                  $count > $email_git_max_maintainers ||
1730                  $percent < $email_git_min_percent);
1731         push_email_address($line, '');
1732         if ($output_rolestats) {
1733             my $fmt_percent = sprintf("%.0f", $percent);
1734             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1735         } else {
1736             add_role($line, $role);
1737         }
1738     }
1739 }
1740
1741 sub vcs_file_signoffs {
1742     my ($file) = @_;
1743
1744     my @signers = ();
1745     my $commits;
1746
1747     $vcs_used = vcs_exists();
1748     return if (!$vcs_used);
1749
1750     my $cmd = $VCS_cmds{"find_signers_cmd"};
1751     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
1752
1753     ($commits, @signers) = vcs_find_signers($cmd);
1754     vcs_assign("commit_signer", $commits, @signers);
1755 }
1756
1757 sub vcs_file_blame {
1758     my ($file) = @_;
1759
1760     my @signers = ();
1761     my @all_commits = ();
1762     my @commits = ();
1763     my $total_commits;
1764     my $total_lines;
1765
1766     $vcs_used = vcs_exists();
1767     return if (!$vcs_used);
1768
1769     @all_commits = vcs_blame($file);
1770     @commits = uniq(@all_commits);
1771     $total_commits = @commits;
1772     $total_lines = @all_commits;
1773
1774     if ($email_git_blame_signatures) {
1775         if (vcs_is_hg()) {
1776             my $commit_count;
1777             my @commit_signers = ();
1778             my $commit = join(" -r ", @commits);
1779             my $cmd;
1780
1781             $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1782             $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
1783
1784             ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1785
1786             push(@signers, @commit_signers);
1787         } else {
1788             foreach my $commit (@commits) {
1789                 my $commit_count;
1790                 my @commit_signers = ();
1791                 my $cmd;
1792
1793                 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1794                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
1795
1796                 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1797
1798                 push(@signers, @commit_signers);
1799             }
1800         }
1801     }
1802
1803     if ($from_filename) {
1804         if ($output_rolestats) {
1805             my @blame_signers;
1806             if (vcs_is_hg()) {{         # Double brace for last exit
1807                 my $commit_count;
1808                 my @commit_signers = ();
1809                 @commits = uniq(@commits);
1810                 @commits = sort(@commits);
1811                 my $commit = join(" -r ", @commits);
1812                 my $cmd;
1813
1814                 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1815                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
1816
1817                 my @lines = ();
1818
1819                 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1820
1821                 if (!$email_git_penguin_chiefs) {
1822                     @lines = grep(!/${penguin_chiefs}/i, @lines);
1823                 }
1824
1825                 last if !@lines;
1826
1827                 my @authors = ();
1828                 foreach my $line (@lines) {
1829                     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1830                         my $author = $1;
1831                         my ($name, $address) = parse_email($author);
1832                         $author = format_email($name, $address, 1);
1833                         push(@authors, $1);
1834                     }
1835                 }
1836
1837                 save_commits_by_author(@lines) if ($interactive);
1838                 save_commits_by_signer(@lines) if ($interactive);
1839
1840                 push(@signers, @authors);
1841             }}
1842             else {
1843                 foreach my $commit (@commits) {
1844                     my $i;
1845                     my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1846                     $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
1847                     my @author = vcs_find_author($cmd);
1848                     next if !@author;
1849                     my $count = grep(/$commit/, @all_commits);
1850                     for ($i = 0; $i < $count ; $i++) {
1851                         push(@blame_signers, $author[0]);
1852                     }
1853                 }
1854             }
1855             if (@blame_signers) {
1856                 vcs_assign("authored lines", $total_lines, @blame_signers);
1857             }
1858         }
1859         vcs_assign("commits", $total_commits, @signers);
1860     } else {
1861         vcs_assign("modified commits", $total_commits, @signers);
1862     }
1863 }
1864
1865 sub uniq {
1866     my (@parms) = @_;
1867
1868     my %saw;
1869     @parms = grep(!$saw{$_}++, @parms);
1870     return @parms;
1871 }
1872
1873 sub sort_and_uniq {
1874     my (@parms) = @_;
1875
1876     my %saw;
1877     @parms = sort @parms;
1878     @parms = grep(!$saw{$_}++, @parms);
1879     return @parms;
1880 }
1881
1882 sub clean_file_emails {
1883     my (@file_emails) = @_;
1884     my @fmt_emails = ();
1885
1886     foreach my $email (@file_emails) {
1887         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1888         my ($name, $address) = parse_email($email);
1889         if ($name eq '"[,\.]"') {
1890             $name = "";
1891         }
1892
1893         my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1894         if (@nw > 2) {
1895             my $first = $nw[@nw - 3];
1896             my $middle = $nw[@nw - 2];
1897             my $last = $nw[@nw - 1];
1898
1899             if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1900                  (length($first) == 2 && substr($first, -1) eq ".")) ||
1901                 (length($middle) == 1 ||
1902                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
1903                 $name = "$first $middle $last";
1904             } else {
1905                 $name = "$middle $last";
1906             }
1907         }
1908
1909         if (substr($name, -1) =~ /[,\.]/) {
1910             $name = substr($name, 0, length($name) - 1);
1911         } elsif (substr($name, -2) =~ /[,\.]"/) {
1912             $name = substr($name, 0, length($name) - 2) . '"';
1913         }
1914
1915         if (substr($name, 0, 1) =~ /[,\.]/) {
1916             $name = substr($name, 1, length($name) - 1);
1917         } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
1918             $name = '"' . substr($name, 2, length($name) - 2);
1919         }
1920
1921         my $fmt_email = format_email($name, $address, $email_usename);
1922         push(@fmt_emails, $fmt_email);
1923     }
1924     return @fmt_emails;
1925 }
1926
1927 sub merge_email {
1928     my @lines;
1929     my %saw;
1930
1931     for (@_) {
1932         my ($address, $role) = @$_;
1933         if (!$saw{$address}) {
1934             if ($output_roles) {
1935                 push(@lines, "$address ($role)");
1936             } else {
1937                 push(@lines, $address);
1938             }
1939             $saw{$address} = 1;
1940         }
1941     }
1942
1943     return @lines;
1944 }
1945
1946 sub output {
1947     my (@parms) = @_;
1948
1949     if ($output_multiline) {
1950         foreach my $line (@parms) {
1951             print("${line}\n");
1952         }
1953     } else {
1954         print(join($output_separator, @parms));
1955         print("\n");
1956     }
1957 }
1958
1959 my $rfc822re;
1960
1961 sub make_rfc822re {
1962 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
1963 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
1964 #   This regexp will only work on addresses which have had comments stripped
1965 #   and replaced with rfc822_lwsp.
1966
1967     my $specials = '()<>@,;:\\\\".\\[\\]';
1968     my $controls = '\\000-\\037\\177';
1969
1970     my $dtext = "[^\\[\\]\\r\\\\]";
1971     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
1972
1973     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
1974
1975 #   Use zero-width assertion to spot the limit of an atom.  A simple
1976 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
1977     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
1978     my $word = "(?:$atom|$quoted_string)";
1979     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
1980
1981     my $sub_domain = "(?:$atom|$domain_literal)";
1982     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
1983
1984     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
1985
1986     my $phrase = "$word*";
1987     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
1988     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
1989     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
1990
1991     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
1992     my $address = "(?:$mailbox|$group)";
1993
1994     return "$rfc822_lwsp*$address";
1995 }
1996
1997 sub rfc822_strip_comments {
1998     my $s = shift;
1999 #   Recursively remove comments, and replace with a single space.  The simpler
2000 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2001 #   chars in atoms, for example.
2002
2003     while ($s =~ s/^((?:[^"\\]|\\.)*
2004                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2005                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2006     return $s;
2007 }
2008
2009 #   valid: returns true if the parameter is an RFC822 valid address
2010 #
2011 sub rfc822_valid {
2012     my $s = rfc822_strip_comments(shift);
2013
2014     if (!$rfc822re) {
2015         $rfc822re = make_rfc822re();
2016     }
2017
2018     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2019 }
2020
2021 #   validlist: In scalar context, returns true if the parameter is an RFC822
2022 #              valid list of addresses.
2023 #
2024 #              In list context, returns an empty list on failure (an invalid
2025 #              address was found); otherwise a list whose first element is the
2026 #              number of addresses found and whose remaining elements are the
2027 #              addresses.  This is needed to disambiguate failure (invalid)
2028 #              from success with no addresses found, because an empty string is
2029 #              a valid list.
2030
2031 sub rfc822_validlist {
2032     my $s = rfc822_strip_comments(shift);
2033
2034     if (!$rfc822re) {
2035         $rfc822re = make_rfc822re();
2036     }
2037     # * null list items are valid according to the RFC
2038     # * the '1' business is to aid in distinguishing failure from no results
2039
2040     my @r;
2041     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2042         $s =~ m/^$rfc822_char*$/) {
2043         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2044             push(@r, $1);
2045         }
2046         return wantarray ? (scalar(@r), @r) : 1;
2047     }
2048     return wantarray ? () : 0;
2049 }