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