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