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