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