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