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