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