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 --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 EOT
 849 }
 850
 851 sub top_of_kernel_tree {
 852     my ($lk_path) = @_;
 853
 854     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 855         $lk_path .= "/";
 856     }
 857     if (   (-f "${lk_path}COPYING")
 858         && (-f "${lk_path}CREDITS")
 859         && (-f "${lk_path}Kbuild")
 860         && (-f "${lk_path}MAINTAINERS")
 861         && (-f "${lk_path}Makefile")
 862         && (-f "${lk_path}README")
 863         && (-d "${lk_path}Documentation")
 864         && (-d "${lk_path}arch")
 865         && (-d "${lk_path}include")
 866         && (-d "${lk_path}drivers")
 867         && (-d "${lk_path}fs")
 868         && (-d "${lk_path}init")
 869         && (-d "${lk_path}ipc")
 870         && (-d "${lk_path}kernel")
 871         && (-d "${lk_path}lib")
 872         && (-d "${lk_path}scripts")) {
 873         return 1;
 874     }
 875     return 0;
 876 }
 877
 878 sub parse_email {
 879     my ($formatted_email) = @_;
 880
 881     my $name = "";
 882     my $address = "";
 883
 884     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
 885         $name = $1;
 886         $address = $2;
 887     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
 888         $address = $1;
 889     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
 890         $address = $1;
 891     }
 892
 893     $name =~ s/^\s+|\s+$//g;
 894     $name =~ s/^\"|\"$//g;
 895     $address =~ s/^\s+|\s+$//g;
 896
 897     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 898         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 899         $name = "\"$name\"";
 900     }
 901
 902     return ($name, $address);
 903 }
 904
 905 sub format_email {
 906     my ($name, $address, $usename) = @_;
 907
 908     my $formatted_email;
 909
 910     $name =~ s/^\s+|\s+$//g;
 911     $name =~ s/^\"|\"$//g;
 912     $address =~ s/^\s+|\s+$//g;
 913
 914     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 915         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 916         $name = "\"$name\"";
 917     }
 918
 919     if ($usename) {
 920         if ("$name" eq "") {
 921             $formatted_email = "$address";
 922         } else {
 923             $formatted_email = "$name <$address>";
 924         }
 925     } else {
 926         $formatted_email = $address;
 927     }
 928
 929     return $formatted_email;
 930 }
 931
 932 sub find_first_section {
 933     my $index = 0;
 934
 935     while ($index < @typevalue) {
 936         my $tv = $typevalue[$index];
 937         if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
 938             last;
 939         }
 940         $index++;
 941     }
 942
 943     return $index;
 944 }
 945
 946 sub find_starting_index {
 947     my ($index) = @_;
 948
 949     while ($index > 0) {
 950         my $tv = $typevalue[$index];
 951         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
 952             last;
 953         }
 954         $index--;
 955     }
 956
 957     return $index;
 958 }
 959
 960 sub find_ending_index {
 961     my ($index) = @_;
 962
 963     while ($index < @typevalue) {
 964         my $tv = $typevalue[$index];
 965         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
 966             last;
 967         }
 968         $index++;
 969     }
 970
 971     return $index;
 972 }
 973
 974 sub get_maintainer_role {
 975     my ($index) = @_;
 976
 977     my $i;
 978     my $start = find_starting_index($index);
 979     my $end = find_ending_index($index);
 980
 981     my $role = "unknown";
 982     my $subsystem = $typevalue[$start];
 983     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
 984         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
 985         $subsystem =~ s/\s*$//;
 986         $subsystem = $subsystem . "...";
 987     }
 988
 989     for ($i = $start + 1; $i < $end; $i++) {
 990         my $tv = $typevalue[$i];
 991         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
 992             my $ptype = $1;
 993             my $pvalue = $2;
 994             if ($ptype eq "S") {
 995                 $role = $pvalue;
 996             }
 997         }
 998     }
 999
1000     $role = lc($role);
1001     if      ($role eq "supported") {
1002         $role = "supporter";
1003     } elsif ($role eq "maintained") {
1004         $role = "maintainer";
1005     } elsif ($role eq "odd fixes") {
1006         $role = "odd fixer";
1007     } elsif ($role eq "orphan") {
1008         $role = "orphan minder";
1009     } elsif ($role eq "obsolete") {
1010         $role = "obsolete minder";
1011     } elsif ($role eq "buried alive in reporters") {
1012         $role = "chief penguin";
1013     }
1014
1015     return $role . ":" . $subsystem;
1016 }
1017
1018 sub get_list_role {
1019     my ($index) = @_;
1020
1021     my $i;
1022     my $start = find_starting_index($index);
1023     my $end = find_ending_index($index);
1024
1025     my $subsystem = $typevalue[$start];
1026     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1027         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1028         $subsystem =~ s/\s*$//;
1029         $subsystem = $subsystem . "...";
1030     }
1031
1032     if ($subsystem eq "THE REST") {
1033         $subsystem = "";
1034     }
1035
1036     return $subsystem;
1037 }
1038
1039 sub add_categories {
1040     my ($index) = @_;
1041
1042     my $i;
1043     my $start = find_starting_index($index);
1044     my $end = find_ending_index($index);
1045
1046     push(@subsystem, $typevalue[$start]);
1047
1048     for ($i = $start + 1; $i < $end; $i++) {
1049         my $tv = $typevalue[$i];
1050         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1051             my $ptype = $1;
1052             my $pvalue = $2;
1053             if ($ptype eq "L") {
1054                 my $list_address = $pvalue;
1055                 my $list_additional = "";
1056                 my $list_role = get_list_role($i);
1057
1058                 if ($list_role ne "") {
1059                     $list_role = ":" . $list_role;
1060                 }
1061                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1062                     $list_address = $1;
1063                     $list_additional = $2;
1064                 }
1065                 if ($list_additional =~ m/subscribers-only/) {
1066                     if ($email_subscriber_list) {
1067                         if (!$hash_list_to{lc($list_address)}) {
1068                             $hash_list_to{lc($list_address)} = 1;
1069                             push(@list_to, [$list_address,
1070                                             "subscriber list${list_role}"]);
1071                         }
1072                     }
1073                 } else {
1074                     if ($email_list) {
1075                         if (!$hash_list_to{lc($list_address)}) {
1076                             $hash_list_to{lc($list_address)} = 1;
1077                             if ($list_additional =~ m/moderated/) {
1078                                 push(@list_to, [$list_address,
1079                                                 "moderated list${list_role}"]);
1080                             } else {
1081                                 push(@list_to, [$list_address,
1082                                                 "open list${list_role}"]);
1083                             }
1084                         }
1085                     }
1086                 }
1087             } elsif ($ptype eq "M") {
1088                 my ($name, $address) = parse_email($pvalue);
1089                 if ($name eq "") {
1090                     if ($i > 0) {
1091                         my $tv = $typevalue[$i - 1];
1092                         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1093                             if ($1 eq "P") {
1094                                 $name = $2;
1095                                 $pvalue = format_email($name, $address, $email_usename);
1096                             }
1097                         }
1098                     }
1099                 }
1100                 if ($email_maintainer) {
1101                     my $role = get_maintainer_role($i);
1102                     push_email_addresses($pvalue, $role);
1103                 }
1104             } elsif ($ptype eq "R") {
1105                 my ($name, $address) = parse_email($pvalue);
1106                 if ($name eq "") {
1107                     if ($i > 0) {
1108                         my $tv = $typevalue[$i - 1];
1109                         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1110                             if ($1 eq "P") {
1111                                 $name = $2;
1112                                 $pvalue = format_email($name, $address, $email_usename);
1113                             }
1114                         }
1115                     }
1116                 }
1117                 if ($email_reviewer) {
1118                     push_email_addresses($pvalue, 'reviewer');
1119                 }
1120             } elsif ($ptype eq "T") {
1121                 push(@scm, $pvalue);
1122             } elsif ($ptype eq "W") {
1123                 push(@web, $pvalue);
1124             } elsif ($ptype eq "S") {
1125                 push(@status, $pvalue);
1126             }
1127         }
1128     }
1129 }
1130
1131 sub email_inuse {
1132     my ($name, $address) = @_;
1133
1134     return 1 if (($name eq "") && ($address eq ""));
1135     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1136     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1137
1138     return 0;
1139 }
1140
1141 sub push_email_address {
1142     my ($line, $role) = @_;
1143
1144     my ($name, $address) = parse_email($line);
1145
1146     if ($address eq "") {
1147         return 0;
1148     }
1149
1150     if (!$email_remove_duplicates) {
1151         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1152     } elsif (!email_inuse($name, $address)) {
1153         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1154         $email_hash_name{lc($name)}++ if ($name ne "");
1155         $email_hash_address{lc($address)}++;
1156     }
1157
1158     return 1;
1159 }
1160
1161 sub push_email_addresses {
1162     my ($address, $role) = @_;
1163
1164     my @address_list = ();
1165
1166     if (rfc822_valid($address)) {
1167         push_email_address($address, $role);
1168     } elsif (@address_list = rfc822_validlist($address)) {
1169         my $array_count = shift(@address_list);
1170         while (my $entry = shift(@address_list)) {
1171             push_email_address($entry, $role);
1172         }
1173     } else {
1174         if (!push_email_address($address, $role)) {
1175             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1176         }
1177     }
1178 }
1179
1180 sub add_role {
1181     my ($line, $role) = @_;
1182
1183     my ($name, $address) = parse_email($line);
1184     my $email = format_email($name, $address, $email_usename);
1185
1186     foreach my $entry (@email_to) {
1187         if ($email_remove_duplicates) {
1188             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1189             if (($name eq $entry_name || $address eq $entry_address)
1190                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1191             ) {
1192                 if ($entry->[1] eq "") {
1193                     $entry->[1] = "$role";
1194                 } else {
1195                     $entry->[1] = "$entry->[1],$role";
1196                 }
1197             }
1198         } else {
1199             if ($email eq $entry->[0]
1200                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1201             ) {
1202                 if ($entry->[1] eq "") {
1203                     $entry->[1] = "$role";
1204                 } else {
1205                     $entry->[1] = "$entry->[1],$role";
1206                 }
1207             }
1208         }
1209     }
1210 }
1211
1212 sub which {
1213     my ($bin) = @_;
1214
1215     foreach my $path (split(/:/, $ENV{PATH})) {
1216         if (-e "$path/$bin") {
1217             return "$path/$bin";
1218         }
1219     }
1220
1221     return "";
1222 }
1223
1224 sub which_conf {
1225     my ($conf) = @_;
1226
1227     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1228         if (-e "$path/$conf") {
1229             return "$path/$conf";
1230         }
1231     }
1232
1233     return "";
1234 }
1235
1236 sub mailmap_email {
1237     my ($line) = @_;
1238
1239     my ($name, $address) = parse_email($line);
1240     my $email = format_email($name, $address, 1);
1241     my $real_name = $name;
1242     my $real_address = $address;
1243
1244     if (exists $mailmap->{names}->{$email} ||
1245         exists $mailmap->{addresses}->{$email}) {
1246         if (exists $mailmap->{names}->{$email}) {
1247             $real_name = $mailmap->{names}->{$email};
1248         }
1249         if (exists $mailmap->{addresses}->{$email}) {
1250             $real_address = $mailmap->{addresses}->{$email};
1251         }
1252     } else {
1253         if (exists $mailmap->{names}->{$address}) {
1254             $real_name = $mailmap->{names}->{$address};
1255         }
1256         if (exists $mailmap->{addresses}->{$address}) {
1257             $real_address = $mailmap->{addresses}->{$address};
1258         }
1259     }
1260     return format_email($real_name, $real_address, 1);
1261 }
1262
1263 sub mailmap {
1264     my (@addresses) = @_;
1265
1266     my @mapped_emails = ();
1267     foreach my $line (@addresses) {
1268         push(@mapped_emails, mailmap_email($line));
1269     }
1270     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1271     return @mapped_emails;
1272 }
1273
1274 sub merge_by_realname {
1275     my %address_map;
1276     my (@emails) = @_;
1277
1278     foreach my $email (@emails) {
1279         my ($name, $address) = parse_email($email);
1280         if (exists $address_map{$name}) {
1281             $address = $address_map{$name};
1282             $email = format_email($name, $address, 1);
1283         } else {
1284             $address_map{$name} = $address;
1285         }
1286     }
1287 }
1288
1289 sub git_execute_cmd {
1290     my ($cmd) = @_;
1291     my @lines = ();
1292
1293     my $output = `$cmd`;
1294     $output =~ s/^\s*//gm;
1295     @lines = split("\n", $output);
1296
1297     return @lines;
1298 }
1299
1300 sub hg_execute_cmd {
1301     my ($cmd) = @_;
1302     my @lines = ();
1303
1304     my $output = `$cmd`;
1305     @lines = split("\n", $output);
1306
1307     return @lines;
1308 }
1309
1310 sub extract_formatted_signatures {
1311     my (@signature_lines) = @_;
1312
1313     my @type = @signature_lines;
1314
1315     s/\s*(.*):.*/$1/ for (@type);
1316
1317     # cut -f2- -d":"
1318     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1319
1320 ## Reformat email addresses (with names) to avoid badly written signatures
1321
1322     foreach my $signer (@signature_lines) {
1323         $signer = deduplicate_email($signer);
1324     }
1325
1326     return (\@type, \@signature_lines);
1327 }
1328
1329 sub vcs_find_signers {
1330     my ($cmd, $file) = @_;
1331     my $commits;
1332     my @lines = ();
1333     my @signatures = ();
1334     my @authors = ();
1335     my @stats = ();
1336
1337     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1338
1339     my $pattern = $VCS_cmds{"commit_pattern"};
1340     my $author_pattern = $VCS_cmds{"author_pattern"};
1341     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1342
1343     $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1344
1345     $commits = grep(/$pattern/, @lines);        # of commits
1346
1347     @authors = grep(/$author_pattern/, @lines);
1348     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1349     @stats = grep(/$stat_pattern/, @lines);
1350
1351 #    print("stats: <@stats>\n");
1352
1353     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1354
1355     save_commits_by_author(@lines) if ($interactive);
1356     save_commits_by_signer(@lines) if ($interactive);
1357
1358     if (!$email_git_penguin_chiefs) {
1359         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1360     }
1361
1362     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1363     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1364
1365     return ($commits, $signers_ref, $authors_ref, \@stats);
1366 }
1367
1368 sub vcs_find_author {
1369     my ($cmd) = @_;
1370     my @lines = ();
1371
1372     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1373
1374     if (!$email_git_penguin_chiefs) {
1375         @lines = grep(!/${penguin_chiefs}/i, @lines);
1376     }
1377
1378     return @lines if !@lines;
1379
1380     my @authors = ();
1381     foreach my $line (@lines) {
1382         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1383             my $author = $1;
1384             my ($name, $address) = parse_email($author);
1385             $author = format_email($name, $address, 1);
1386             push(@authors, $author);
1387         }
1388     }
1389
1390     save_commits_by_author(@lines) if ($interactive);
1391     save_commits_by_signer(@lines) if ($interactive);
1392
1393     return @authors;
1394 }
1395
1396 sub vcs_save_commits {
1397     my ($cmd) = @_;
1398     my @lines = ();
1399     my @commits = ();
1400
1401     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1402
1403     foreach my $line (@lines) {
1404         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1405             push(@commits, $1);
1406         }
1407     }
1408
1409     return @commits;
1410 }
1411
1412 sub vcs_blame {
1413     my ($file) = @_;
1414     my $cmd;
1415     my @commits = ();
1416
1417     return @commits if (!(-f $file));
1418
1419     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1420         my @all_commits = ();
1421
1422         $cmd = $VCS_cmds{"blame_file_cmd"};
1423         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1424         @all_commits = vcs_save_commits($cmd);
1425
1426         foreach my $file_range_diff (@range) {
1427             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1428             my $diff_file = $1;
1429             my $diff_start = $2;
1430             my $diff_length = $3;
1431             next if ("$file" ne "$diff_file");
1432             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1433                 push(@commits, $all_commits[$i]);
1434             }
1435         }
1436     } elsif (@range) {
1437         foreach my $file_range_diff (@range) {
1438             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1439             my $diff_file = $1;
1440             my $diff_start = $2;
1441             my $diff_length = $3;
1442             next if ("$file" ne "$diff_file");
1443             $cmd = $VCS_cmds{"blame_range_cmd"};
1444             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1445             push(@commits, vcs_save_commits($cmd));
1446         }
1447     } else {
1448         $cmd = $VCS_cmds{"blame_file_cmd"};
1449         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1450         @commits = vcs_save_commits($cmd);
1451     }
1452
1453     foreach my $commit (@commits) {
1454         $commit =~ s/^\^//g;
1455     }
1456
1457     return @commits;
1458 }
1459
1460 my $printed_novcs = 0;
1461 sub vcs_exists {
1462     %VCS_cmds = %VCS_cmds_git;
1463     return 1 if eval $VCS_cmds{"available"};
1464     %VCS_cmds = %VCS_cmds_hg;
1465     return 2 if eval $VCS_cmds{"available"};
1466     %VCS_cmds = ();
1467     if (!$printed_novcs) {
1468         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1469         warn("Using a git repository produces better results.\n");
1470         warn("Try Linus Torvalds' latest git repository using:\n");
1471         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1472         $printed_novcs = 1;
1473     }
1474     return 0;
1475 }
1476
1477 sub vcs_is_git {
1478     vcs_exists();
1479     return $vcs_used == 1;
1480 }
1481
1482 sub vcs_is_hg {
1483     return $vcs_used == 2;
1484 }
1485
1486 sub interactive_get_maintainers {
1487     my ($list_ref) = @_;
1488     my @list = @$list_ref;
1489
1490     vcs_exists();
1491
1492     my %selected;
1493     my %authored;
1494     my %signed;
1495     my $count = 0;
1496     my $maintained = 0;
1497     foreach my $entry (@list) {
1498         $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1499         $selected{$count} = 1;
1500         $authored{$count} = 0;
1501         $signed{$count} = 0;
1502         $count++;
1503     }
1504
1505     #menu loop
1506     my $done = 0;
1507     my $print_options = 0;
1508     my $redraw = 1;
1509     while (!$done) {
1510         $count = 0;
1511         if ($redraw) {
1512             printf STDERR "\n%1s %2s %-65s",
1513                           "*", "#", "email/list and role:stats";
1514             if ($email_git ||
1515                 ($email_git_fallback && !$maintained) ||
1516                 $email_git_blame) {
1517                 print STDERR "auth sign";
1518             }
1519             print STDERR "\n";
1520             foreach my $entry (@list) {
1521                 my $email = $entry->[0];
1522                 my $role = $entry->[1];
1523                 my $sel = "";
1524                 $sel = "*" if ($selected{$count});
1525                 my $commit_author = $commit_author_hash{$email};
1526                 my $commit_signer = $commit_signer_hash{$email};
1527                 my $authored = 0;
1528                 my $signed = 0;
1529                 $authored++ for (@{$commit_author});
1530                 $signed++ for (@{$commit_signer});
1531                 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1532                 printf STDERR "%4d %4d", $authored, $signed
1533                     if ($authored > 0 || $signed > 0);
1534                 printf STDERR "\n     %s\n", $role;
1535                 if ($authored{$count}) {
1536                     my $commit_author = $commit_author_hash{$email};
1537                     foreach my $ref (@{$commit_author}) {
1538                         print STDERR "     Author: @{$ref}[1]\n";
1539                     }
1540                 }
1541                 if ($signed{$count}) {
1542                     my $commit_signer = $commit_signer_hash{$email};
1543                     foreach my $ref (@{$commit_signer}) {
1544                         print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1545                     }
1546                 }
1547
1548                 $count++;
1549             }
1550         }
1551         my $date_ref = \$email_git_since;
1552         $date_ref = \$email_hg_since if (vcs_is_hg());
1553         if ($print_options) {
1554             $print_options = 0;
1555             if (vcs_exists()) {
1556                 print STDERR <<EOT
1557
1558 Version Control options:
1559 g  use git history      [$email_git]
1560 gf use git-fallback     [$email_git_fallback]
1561 b  use git blame        [$email_git_blame]
1562 bs use blame signatures [$email_git_blame_signatures]
1563 c# minimum commits      [$email_git_min_signatures]
1564 %# min percent          [$email_git_min_percent]
1565 d# history to use       [$$date_ref]
1566 x# max maintainers      [$email_git_max_maintainers]
1567 t  all signature types  [$email_git_all_signature_types]
1568 m  use .mailmap         [$email_use_mailmap]
1569 EOT
1570             }
1571             print STDERR <<EOT
1572
1573 Additional options:
1574 0  toggle all
1575 tm toggle maintainers
1576 tg toggle git entries
1577 tl toggle open list entries
1578 ts toggle subscriber list entries
1579 f  emails in file       [$file_emails]
1580 k  keywords in file     [$keywords]
1581 r  remove duplicates    [$email_remove_duplicates]
1582 p# pattern match depth  [$pattern_depth]
1583 EOT
1584         }
1585         print STDERR
1586 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1587
1588         my $input = <STDIN>;
1589         chomp($input);
1590
1591         $redraw = 1;
1592         my $rerun = 0;
1593         my @wish = split(/[, ]+/, $input);
1594         foreach my $nr (@wish) {
1595             $nr = lc($nr);
1596             my $sel = substr($nr, 0, 1);
1597             my $str = substr($nr, 1);
1598             my $val = 0;
1599             $val = $1 if $str =~ /^(\d+)$/;
1600
1601             if ($sel eq "y") {
1602                 $interactive = 0;
1603                 $done = 1;
1604                 $output_rolestats = 0;
1605                 $output_roles = 0;
1606                 last;
1607             } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1608                 $selected{$nr - 1} = !$selected{$nr - 1};
1609             } elsif ($sel eq "*" || $sel eq '^') {
1610                 my $toggle = 0;
1611                 $toggle = 1 if ($sel eq '*');
1612                 for (my $i = 0; $i < $count; $i++) {
1613                     $selected{$i} = $toggle;
1614                 }
1615             } elsif ($sel eq "0") {
1616                 for (my $i = 0; $i < $count; $i++) {
1617                     $selected{$i} = !$selected{$i};
1618                 }
1619             } elsif ($sel eq "t") {
1620                 if (lc($str) eq "m") {
1621                     for (my $i = 0; $i < $count; $i++) {
1622                         $selected{$i} = !$selected{$i}
1623                             if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1624                     }
1625                 } elsif (lc($str) eq "g") {
1626                     for (my $i = 0; $i < $count; $i++) {
1627                         $selected{$i} = !$selected{$i}
1628                             if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1629                     }
1630                 } elsif (lc($str) eq "l") {
1631                     for (my $i = 0; $i < $count; $i++) {
1632                         $selected{$i} = !$selected{$i}
1633                             if ($list[$i]->[1] =~ /^(open list)/i);
1634                     }
1635                 } elsif (lc($str) eq "s") {
1636                     for (my $i = 0; $i < $count; $i++) {
1637                         $selected{$i} = !$selected{$i}
1638                             if ($list[$i]->[1] =~ /^(subscriber list)/i);
1639                     }
1640                 }
1641             } elsif ($sel eq "a") {
1642                 if ($val > 0 && $val <= $count) {
1643                     $authored{$val - 1} = !$authored{$val - 1};
1644                 } elsif ($str eq '*' || $str eq '^') {
1645                     my $toggle = 0;
1646                     $toggle = 1 if ($str eq '*');
1647                     for (my $i = 0; $i < $count; $i++) {
1648                         $authored{$i} = $toggle;
1649                     }
1650                 }
1651             } elsif ($sel eq "s") {
1652                 if ($val > 0 && $val <= $count) {
1653                     $signed{$val - 1} = !$signed{$val - 1};
1654                 } elsif ($str eq '*' || $str eq '^') {
1655                     my $toggle = 0;
1656                     $toggle = 1 if ($str eq '*');
1657                     for (my $i = 0; $i < $count; $i++) {
1658                         $signed{$i} = $toggle;
1659                     }
1660                 }
1661             } elsif ($sel eq "o") {
1662                 $print_options = 1;
1663                 $redraw = 1;
1664             } elsif ($sel eq "g") {
1665                 if ($str eq "f") {
1666                     bool_invert(\$email_git_fallback);
1667                 } else {
1668                     bool_invert(\$email_git);
1669                 }
1670                 $rerun = 1;
1671             } elsif ($sel eq "b") {
1672                 if ($str eq "s") {
1673                     bool_invert(\$email_git_blame_signatures);
1674                 } else {
1675                     bool_invert(\$email_git_blame);
1676                 }
1677                 $rerun = 1;
1678             } elsif ($sel eq "c") {
1679                 if ($val > 0) {
1680                     $email_git_min_signatures = $val;
1681                     $rerun = 1;
1682                 }
1683             } elsif ($sel eq "x") {
1684                 if ($val > 0) {
1685                     $email_git_max_maintainers = $val;
1686                     $rerun = 1;
1687                 }
1688             } elsif ($sel eq "%") {
1689                 if ($str ne "" && $val >= 0) {
1690                     $email_git_min_percent = $val;
1691                     $rerun = 1;
1692                 }
1693             } elsif ($sel eq "d") {
1694                 if (vcs_is_git()) {
1695                     $email_git_since = $str;
1696                 } elsif (vcs_is_hg()) {
1697                     $email_hg_since = $str;
1698                 }
1699                 $rerun = 1;
1700             } elsif ($sel eq "t") {
1701                 bool_invert(\$email_git_all_signature_types);
1702                 $rerun = 1;
1703             } elsif ($sel eq "f") {
1704                 bool_invert(\$file_emails);
1705                 $rerun = 1;
1706             } elsif ($sel eq "r") {
1707                 bool_invert(\$email_remove_duplicates);
1708                 $rerun = 1;
1709             } elsif ($sel eq "m") {
1710                 bool_invert(\$email_use_mailmap);
1711                 read_mailmap();
1712                 $rerun = 1;
1713             } elsif ($sel eq "k") {
1714                 bool_invert(\$keywords);
1715                 $rerun = 1;
1716             } elsif ($sel eq "p") {
1717                 if ($str ne "" && $val >= 0) {
1718                     $pattern_depth = $val;
1719                     $rerun = 1;
1720                 }
1721             } elsif ($sel eq "h" || $sel eq "?") {
1722                 print STDERR <<EOT
1723
1724 Interactive mode allows you to select the various maintainers, submitters,
1725 commit signers and mailing lists that could be CC'd on a patch.
1726
1727 Any *'d entry is selected.
1728
1729 If you have git or hg installed, you can choose to summarize the commit
1730 history of files in the patch.  Also, each line of the current file can
1731 be matched to its commit author and that commits signers with blame.
1732
1733 Various knobs exist to control the length of time for active commit
1734 tracking, the maximum number of commit authors and signers to add,
1735 and such.
1736
1737 Enter selections at the prompt until you are satisfied that the selected
1738 maintainers are appropriate.  You may enter multiple selections separated
1739 by either commas or spaces.
1740
1741 EOT
1742             } else {
1743                 print STDERR "invalid option: '$nr'\n";
1744                 $redraw = 0;
1745             }
1746         }
1747         if ($rerun) {
1748             print STDERR "git-blame can be very slow, please have patience..."
1749                 if ($email_git_blame);
1750             goto &get_maintainers;
1751         }
1752     }
1753
1754     #drop not selected entries
1755     $count = 0;
1756     my @new_emailto = ();
1757     foreach my $entry (@list) {
1758         if ($selected{$count}) {
1759             push(@new_emailto, $list[$count]);
1760         }
1761         $count++;
1762     }
1763     return @new_emailto;
1764 }
1765
1766 sub bool_invert {
1767     my ($bool_ref) = @_;
1768
1769     if ($$bool_ref) {
1770         $$bool_ref = 0;
1771     } else {
1772         $$bool_ref = 1;
1773     }
1774 }
1775
1776 sub deduplicate_email {
1777     my ($email) = @_;
1778
1779     my $matched = 0;
1780     my ($name, $address) = parse_email($email);
1781     $email = format_email($name, $address, 1);
1782     $email = mailmap_email($email);
1783
1784     return $email if (!$email_remove_duplicates);
1785
1786     ($name, $address) = parse_email($email);
1787
1788     if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1789         $name = $deduplicate_name_hash{lc($name)}->[0];
1790         $address = $deduplicate_name_hash{lc($name)}->[1];
1791         $matched = 1;
1792     } elsif ($deduplicate_address_hash{lc($address)}) {
1793         $name = $deduplicate_address_hash{lc($address)}->[0];
1794         $address = $deduplicate_address_hash{lc($address)}->[1];
1795         $matched = 1;
1796     }
1797     if (!$matched) {
1798         $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1799         $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1800     }
1801     $email = format_email($name, $address, 1);
1802     $email = mailmap_email($email);
1803     return $email;
1804 }
1805
1806 sub save_commits_by_author {
1807     my (@lines) = @_;
1808
1809     my @authors = ();
1810     my @commits = ();
1811     my @subjects = ();
1812
1813     foreach my $line (@lines) {
1814         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1815             my $author = $1;
1816             $author = deduplicate_email($author);
1817             push(@authors, $author);
1818         }
1819         push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1820         push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1821     }
1822
1823     for (my $i = 0; $i < @authors; $i++) {
1824         my $exists = 0;
1825         foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1826             if (@{$ref}[0] eq $commits[$i] &&
1827                 @{$ref}[1] eq $subjects[$i]) {
1828                 $exists = 1;
1829                 last;
1830             }
1831         }
1832         if (!$exists) {
1833             push(@{$commit_author_hash{$authors[$i]}},
1834                  [ ($commits[$i], $subjects[$i]) ]);
1835         }
1836     }
1837 }
1838
1839 sub save_commits_by_signer {
1840     my (@lines) = @_;
1841
1842     my $commit = "";
1843     my $subject = "";
1844
1845     foreach my $line (@lines) {
1846         $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1847         $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1848         if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1849             my @signatures = ($line);
1850             my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1851             my @types = @$types_ref;
1852             my @signers = @$signers_ref;
1853
1854             my $type = $types[0];
1855             my $signer = $signers[0];
1856
1857             $signer = deduplicate_email($signer);
1858
1859             my $exists = 0;
1860             foreach my $ref(@{$commit_signer_hash{$signer}}) {
1861                 if (@{$ref}[0] eq $commit &&
1862                     @{$ref}[1] eq $subject &&
1863                     @{$ref}[2] eq $type) {
1864                     $exists = 1;
1865                     last;
1866                 }
1867             }
1868             if (!$exists) {
1869                 push(@{$commit_signer_hash{$signer}},
1870                      [ ($commit, $subject, $type) ]);
1871             }
1872         }
1873     }
1874 }
1875
1876 sub vcs_assign {
1877     my ($role, $divisor, @lines) = @_;
1878
1879     my %hash;
1880     my $count = 0;
1881
1882     return if (@lines <= 0);
1883
1884     if ($divisor <= 0) {
1885         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1886         $divisor = 1;
1887     }
1888
1889     @lines = mailmap(@lines);
1890
1891     return if (@lines <= 0);
1892
1893     @lines = sort(@lines);
1894
1895     # uniq -c
1896     $hash{$_}++ for @lines;
1897
1898     # sort -rn
1899     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1900         my $sign_offs = $hash{$line};
1901         my $percent = $sign_offs * 100 / $divisor;
1902
1903         $percent = 100 if ($percent > 100);
1904         next if (ignore_email_address($line));
1905         $count++;
1906         last if ($sign_offs < $email_git_min_signatures ||
1907                  $count > $email_git_max_maintainers ||
1908                  $percent < $email_git_min_percent);
1909         push_email_address($line, '');
1910         if ($output_rolestats) {
1911             my $fmt_percent = sprintf("%.0f", $percent);
1912             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1913         } else {
1914             add_role($line, $role);
1915         }
1916     }
1917 }
1918
1919 sub vcs_file_signoffs {
1920     my ($file) = @_;
1921
1922     my $authors_ref;
1923     my $signers_ref;
1924     my $stats_ref;
1925     my @authors = ();
1926     my @signers = ();
1927     my @stats = ();
1928     my $commits;
1929
1930     $vcs_used = vcs_exists();
1931     return if (!$vcs_used);
1932
1933     my $cmd = $VCS_cmds{"find_signers_cmd"};
1934     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
1935
1936     ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1937
1938     @signers = @{$signers_ref} if defined $signers_ref;
1939     @authors = @{$authors_ref} if defined $authors_ref;
1940     @stats = @{$stats_ref} if defined $stats_ref;
1941
1942 #    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1943
1944     foreach my $signer (@signers) {
1945         $signer = deduplicate_email($signer);
1946     }
1947
1948     vcs_assign("commit_signer", $commits, @signers);
1949     vcs_assign("authored", $commits, @authors);
1950     if ($#authors == $#stats) {
1951         my $stat_pattern = $VCS_cmds{"stat_pattern"};
1952         $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
1953
1954         my $added = 0;
1955         my $deleted = 0;
1956         for (my $i = 0; $i <= $#stats; $i++) {
1957             if ($stats[$i] =~ /$stat_pattern/) {
1958                 $added += $1;
1959                 $deleted += $2;
1960             }
1961         }
1962         my @tmp_authors = uniq(@authors);
1963         foreach my $author (@tmp_authors) {
1964             $author = deduplicate_email($author);
1965         }
1966         @tmp_authors = uniq(@tmp_authors);
1967         my @list_added = ();
1968         my @list_deleted = ();
1969         foreach my $author (@tmp_authors) {
1970             my $auth_added = 0;
1971             my $auth_deleted = 0;
1972             for (my $i = 0; $i <= $#stats; $i++) {
1973                 if ($author eq deduplicate_email($authors[$i]) &&
1974                     $stats[$i] =~ /$stat_pattern/) {
1975                     $auth_added += $1;
1976                     $auth_deleted += $2;
1977                 }
1978             }
1979             for (my $i = 0; $i < $auth_added; $i++) {
1980                 push(@list_added, $author);
1981             }
1982             for (my $i = 0; $i < $auth_deleted; $i++) {
1983                 push(@list_deleted, $author);
1984             }
1985         }
1986         vcs_assign("added_lines", $added, @list_added);
1987         vcs_assign("removed_lines", $deleted, @list_deleted);
1988     }
1989 }
1990
1991 sub vcs_file_blame {
1992     my ($file) = @_;
1993
1994     my @signers = ();
1995     my @all_commits = ();
1996     my @commits = ();
1997     my $total_commits;
1998     my $total_lines;
1999
2000     $vcs_used = vcs_exists();
2001     return if (!$vcs_used);
2002
2003     @all_commits = vcs_blame($file);
2004     @commits = uniq(@all_commits);
2005     $total_commits = @commits;
2006     $total_lines = @all_commits;
2007
2008     if ($email_git_blame_signatures) {
2009         if (vcs_is_hg()) {
2010             my $commit_count;
2011             my $commit_authors_ref;
2012             my $commit_signers_ref;
2013             my $stats_ref;
2014             my @commit_authors = ();
2015             my @commit_signers = ();
2016             my $commit = join(" -r ", @commits);
2017             my $cmd;
2018
2019             $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2020             $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2021
2022             ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2023             @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2024             @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2025
2026             push(@signers, @commit_signers);
2027         } else {
2028             foreach my $commit (@commits) {
2029                 my $commit_count;
2030                 my $commit_authors_ref;
2031                 my $commit_signers_ref;
2032                 my $stats_ref;
2033                 my @commit_authors = ();
2034                 my @commit_signers = ();
2035                 my $cmd;
2036
2037                 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2038                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2039
2040                 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2041                 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2042                 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2043
2044                 push(@signers, @commit_signers);
2045             }
2046         }
2047     }
2048
2049     if ($from_filename) {
2050         if ($output_rolestats) {
2051             my @blame_signers;
2052             if (vcs_is_hg()) {{         # Double brace for last exit
2053                 my $commit_count;
2054                 my @commit_signers = ();
2055                 @commits = uniq(@commits);
2056                 @commits = sort(@commits);
2057                 my $commit = join(" -r ", @commits);
2058                 my $cmd;
2059
2060                 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2061                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2062
2063                 my @lines = ();
2064
2065                 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2066
2067                 if (!$email_git_penguin_chiefs) {
2068                     @lines = grep(!/${penguin_chiefs}/i, @lines);
2069                 }
2070
2071                 last if !@lines;
2072
2073                 my @authors = ();
2074                 foreach my $line (@lines) {
2075                     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2076                         my $author = $1;
2077                         $author = deduplicate_email($author);
2078                         push(@authors, $author);
2079                     }
2080                 }
2081
2082                 save_commits_by_author(@lines) if ($interactive);
2083                 save_commits_by_signer(@lines) if ($interactive);
2084
2085                 push(@signers, @authors);
2086             }}
2087             else {
2088                 foreach my $commit (@commits) {
2089                     my $i;
2090                     my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2091                     $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2092                     my @author = vcs_find_author($cmd);
2093                     next if !@author;
2094
2095                     my $formatted_author = deduplicate_email($author[0]);
2096
2097                     my $count = grep(/$commit/, @all_commits);
2098                     for ($i = 0; $i < $count ; $i++) {
2099                         push(@blame_signers, $formatted_author);
2100                     }
2101                 }
2102             }
2103             if (@blame_signers) {
2104                 vcs_assign("authored lines", $total_lines, @blame_signers);
2105             }
2106         }
2107         foreach my $signer (@signers) {
2108             $signer = deduplicate_email($signer);
2109         }
2110         vcs_assign("commits", $total_commits, @signers);
2111     } else {
2112         foreach my $signer (@signers) {
2113             $signer = deduplicate_email($signer);
2114         }
2115         vcs_assign("modified commits", $total_commits, @signers);
2116     }
2117 }
2118
2119 sub uniq {
2120     my (@parms) = @_;
2121
2122     my %saw;
2123     @parms = grep(!$saw{$_}++, @parms);
2124     return @parms;
2125 }
2126
2127 sub sort_and_uniq {
2128     my (@parms) = @_;
2129
2130     my %saw;
2131     @parms = sort @parms;
2132     @parms = grep(!$saw{$_}++, @parms);
2133     return @parms;
2134 }
2135
2136 sub clean_file_emails {
2137     my (@file_emails) = @_;
2138     my @fmt_emails = ();
2139
2140     foreach my $email (@file_emails) {
2141         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2142         my ($name, $address) = parse_email($email);
2143         if ($name eq '"[,\.]"') {
2144             $name = "";
2145         }
2146
2147         my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2148         if (@nw > 2) {
2149             my $first = $nw[@nw - 3];
2150             my $middle = $nw[@nw - 2];
2151             my $last = $nw[@nw - 1];
2152
2153             if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2154                  (length($first) == 2 && substr($first, -1) eq ".")) ||
2155                 (length($middle) == 1 ||
2156                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
2157                 $name = "$first $middle $last";
2158             } else {
2159                 $name = "$middle $last";
2160             }
2161         }
2162
2163         if (substr($name, -1) =~ /[,\.]/) {
2164             $name = substr($name, 0, length($name) - 1);
2165         } elsif (substr($name, -2) =~ /[,\.]"/) {
2166             $name = substr($name, 0, length($name) - 2) . '"';
2167         }
2168
2169         if (substr($name, 0, 1) =~ /[,\.]/) {
2170             $name = substr($name, 1, length($name) - 1);
2171         } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2172             $name = '"' . substr($name, 2, length($name) - 2);
2173         }
2174
2175         my $fmt_email = format_email($name, $address, $email_usename);
2176         push(@fmt_emails, $fmt_email);
2177     }
2178     return @fmt_emails;
2179 }
2180
2181 sub merge_email {
2182     my @lines;
2183     my %saw;
2184
2185     for (@_) {
2186         my ($address, $role) = @$_;
2187         if (!$saw{$address}) {
2188             if ($output_roles) {
2189                 push(@lines, "$address ($role)");
2190             } else {
2191                 push(@lines, $address);
2192             }
2193             $saw{$address} = 1;
2194         }
2195     }
2196
2197     return @lines;
2198 }
2199
2200 sub output {
2201     my (@parms) = @_;
2202
2203     if ($output_multiline) {
2204         foreach my $line (@parms) {
2205             print("${line}\n");
2206         }
2207     } else {
2208         print(join($output_separator, @parms));
2209         print("\n");
2210     }
2211 }
2212
2213 my $rfc822re;
2214
2215 sub make_rfc822re {
2216 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2217 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2218 #   This regexp will only work on addresses which have had comments stripped
2219 #   and replaced with rfc822_lwsp.
2220
2221     my $specials = '()<>@,;:\\\\".\\[\\]';
2222     my $controls = '\\000-\\037\\177';
2223
2224     my $dtext = "[^\\[\\]\\r\\\\]";
2225     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2226
2227     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2228
2229 #   Use zero-width assertion to spot the limit of an atom.  A simple
2230 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2231     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2232     my $word = "(?:$atom|$quoted_string)";
2233     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2234
2235     my $sub_domain = "(?:$atom|$domain_literal)";
2236     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2237
2238     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2239
2240     my $phrase = "$word*";
2241     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2242     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2243     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2244
2245     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2246     my $address = "(?:$mailbox|$group)";
2247
2248     return "$rfc822_lwsp*$address";
2249 }
2250
2251 sub rfc822_strip_comments {
2252     my $s = shift;
2253 #   Recursively remove comments, and replace with a single space.  The simpler
2254 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2255 #   chars in atoms, for example.
2256
2257     while ($s =~ s/^((?:[^"\\]|\\.)*
2258                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2259                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2260     return $s;
2261 }
2262
2263 #   valid: returns true if the parameter is an RFC822 valid address
2264 #
2265 sub rfc822_valid {
2266     my $s = rfc822_strip_comments(shift);
2267
2268     if (!$rfc822re) {
2269         $rfc822re = make_rfc822re();
2270     }
2271
2272     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2273 }
2274
2275 #   validlist: In scalar context, returns true if the parameter is an RFC822
2276 #              valid list of addresses.
2277 #
2278 #              In list context, returns an empty list on failure (an invalid
2279 #              address was found); otherwise a list whose first element is the
2280 #              number of addresses found and whose remaining elements are the
2281 #              addresses.  This is needed to disambiguate failure (invalid)
2282 #              from success with no addresses found, because an empty string is
2283 #              a valid list.
2284
2285 sub rfc822_validlist {
2286     my $s = rfc822_strip_comments(shift);
2287
2288     if (!$rfc822re) {
2289         $rfc822re = make_rfc822re();
2290     }
2291     # * null list items are valid according to the RFC
2292     # * the '1' business is to aid in distinguishing failure from no results
2293
2294     my @r;
2295     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2296         $s =~ m/^$rfc822_char*$/) {
2297         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2298             push(@r, $1);
2299         }
2300         return wantarray ? (scalar(@r), @r) : 1;
2301     }
2302     return wantarray ? () : 0;
2303 }