scripts/get_reviewer.pl

   1 #!/usr/bin/perl -w
   2 # (c) 2007, Joe Perches <joe@perches.com>
   3 #           created from checkpatch.pl
   4 #
   5 # Print selected REVIEWERS information for
   6 # the files modified in a patch or for a file
   7 #
   8 # usage: perl scripts/get_reviewer.pl [OPTIONS] <patch>
   9 #        perl scripts/get_reviewer.pl [OPTIONS] -f <file>
  10 #
  11 # A minimally modified version of get_maintainer.pl from the
  12 # Linux source tree, adapted for use in mesa.
  13 #
  14 # Licensed under the terms of the GNU GPL License version 2
  15
  16 use strict;
  17
  18 my $P = $0;
  19 my $V = '0.26';
  20
  21 use Getopt::Long qw(:config no_auto_abbrev);
  22 use Cwd;
  23
  24 my $cur_path = fastgetcwd() . '/';
  25 my $lk_path = "./";
  26 my $email = 1;
  27 my $email_usename = 1;
  28 my $email_maintainer = 1;
  29 my $email_reviewer = 1;
  30 my $email_list = 1;
  31 my $email_subscriber_list = 0;
  32 my $email_git_penguin_chiefs = 0;
  33 my $email_git = 0;
  34 my $email_git_all_signature_types = 0;
  35 my $email_git_blame = 0;
  36 my $email_git_blame_signatures = 1;
  37 my $email_git_fallback = 1;
  38 my $email_git_min_signatures = 1;
  39 my $email_git_max_maintainers = 5;
  40 my $email_git_min_percent = 15;
  41 my $email_git_since = "1-year-ago";
  42 my $email_hg_since = "-365";
  43 my $interactive = 0;
  44 my $email_remove_duplicates = 1;
  45 my $email_use_mailmap = 1;
  46 my $output_multiline = 1;
  47 my $output_separator = ", ";
  48 my $output_roles = 0;
  49 my $output_rolestats = 1;
  50 my $output_section_maxlen = 50;
  51 my $scm = 0;
  52 my $web = 0;
  53 my $subsystem = 0;
  54 my $status = 0;
  55 my $keywords = 1;
  56 my $sections = 0;
  57 my $file_emails = 0;
  58 my $from_filename = 0;
  59 my $pattern_depth = 0;
  60 my $version = 0;
  61 my $help = 0;
  62
  63 my $vcs_used = 0;
  64
  65 my $exit = 0;
  66
  67 my %commit_author_hash;
  68 my %commit_signer_hash;
  69
  70 my @penguin_chief = ();
  71 #push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
  72 #Andrew wants in on most everything - 2009/01/14
  73 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  74
  75 my @penguin_chief_names = ();
  76 foreach my $chief (@penguin_chief) {
  77     if ($chief =~ m/^(.*):(.*)/) {
  78         my $chief_name = $1;
  79         my $chief_addr = $2;
  80         push(@penguin_chief_names, $chief_name);
  81     }
  82 }
  83 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  84
  85 # Signature types of people who are either
  86 #       a) responsible for the code in question, or
  87 #       b) familiar enough with it to give relevant feedback
  88 my @signature_tags = ();
  89 push(@signature_tags, "Signed-off-by:");
  90 push(@signature_tags, "Reviewed-by:");
  91 push(@signature_tags, "Acked-by:");
  92
  93 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
  94
  95 # rfc822 email address - preloaded methods go here.
  96 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  97 my $rfc822_char = '[\\000-\\377]';
  98
  99 # VCS command support: class-like functions and strings
 100
 101 my %VCS_cmds;
 102
 103 my %VCS_cmds_git = (
 104     "execute_cmd" => \&git_execute_cmd,
 105     "available" => '(which("git") ne "") && (-e ".git")',
 106     "find_signers_cmd" =>
 107         "git log --no-color --follow --since=\$email_git_since " .
 108             '--numstat --no-merges ' .
 109             '--format="GitCommit: %H%n' .
 110                       'GitAuthor: %an <%ae>%n' .
 111                       'GitDate: %aD%n' .
 112                       'GitSubject: %s%n' .
 113                       '%b%n"' .
 114             " -- \$file",
 115     "find_commit_signers_cmd" =>
 116         "git log --no-color " .
 117             '--numstat ' .
 118             '--format="GitCommit: %H%n' .
 119                       'GitAuthor: %an <%ae>%n' .
 120                       'GitDate: %aD%n' .
 121                       'GitSubject: %s%n' .
 122                       '%b%n"' .
 123             " -1 \$commit",
 124     "find_commit_author_cmd" =>
 125         "git log --no-color " .
 126             '--numstat ' .
 127             '--format="GitCommit: %H%n' .
 128                       'GitAuthor: %an <%ae>%n' .
 129                       'GitDate: %aD%n' .
 130                       'GitSubject: %s%n"' .
 131             " -1 \$commit",
 132     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 133     "blame_file_cmd" => "git blame -l \$file",
 134     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 135     "blame_commit_pattern" => "^([0-9a-f]+) ",
 136     "author_pattern" => "^GitAuthor: (.*)",
 137     "subject_pattern" => "^GitSubject: (.*)",
 138     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 139 );
 140
 141 my %VCS_cmds_hg = (
 142     "execute_cmd" => \&hg_execute_cmd,
 143     "available" => '(which("hg") ne "") && (-d ".hg")',
 144     "find_signers_cmd" =>
 145         "hg log --date=\$email_hg_since " .
 146             "--template='HgCommit: {node}\\n" .
 147                         "HgAuthor: {author}\\n" .
 148                         "HgSubject: {desc}\\n'" .
 149             " -- \$file",
 150     "find_commit_signers_cmd" =>
 151         "hg log " .
 152             "--template='HgSubject: {desc}\\n'" .
 153             " -r \$commit",
 154     "find_commit_author_cmd" =>
 155         "hg log " .
 156             "--template='HgCommit: {node}\\n" .
 157                         "HgAuthor: {author}\\n" .
 158                         "HgSubject: {desc|firstline}\\n'" .
 159             " -r \$commit",
 160     "blame_range_cmd" => "",            # not supported
 161     "blame_file_cmd" => "hg blame -n \$file",
 162     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 163     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 164     "author_pattern" => "^HgAuthor: (.*)",
 165     "subject_pattern" => "^HgSubject: (.*)",
 166     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 167 );
 168
 169 my $conf = which_conf(".get_maintainer.conf");
 170 if (-f $conf) {
 171     my @conf_args;
 172     open(my $conffile, '<', "$conf")
 173         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 174
 175     while (<$conffile>) {
 176         my $line = $_;
 177
 178         $line =~ s/\s*\n?$//g;
 179         $line =~ s/^\s*//g;
 180         $line =~ s/\s+/ /g;
 181
 182         next if ($line =~ m/^\s*#/);
 183         next if ($line =~ m/^\s*$/);
 184
 185         my @words = split(" ", $line);
 186         foreach my $word (@words) {
 187             last if ($word =~ m/^#/);
 188             push (@conf_args, $word);
 189         }
 190     }
 191     close($conffile);
 192     unshift(@ARGV, @conf_args) if @conf_args;
 193 }
 194
 195 my @ignore_emails = ();
 196 my $ignore_file = which_conf(".get_maintainer.ignore");
 197 if (-f $ignore_file) {
 198     open(my $ignore, '<', "$ignore_file")
 199         or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
 200     while (<$ignore>) {
 201         my $line = $_;
 202
 203         $line =~ s/\s*\n?$//;
 204         $line =~ s/^\s*//;
 205         $line =~ s/\s+$//;
 206         $line =~ s/#.*$//;
 207
 208         next if ($line =~ m/^\s*$/);
 209         if (rfc822_valid($line)) {
 210             push(@ignore_emails, $line);
 211         }
 212     }
 213     close($ignore);
 214 }
 215
 216 if (!GetOptions(
 217                 'email!' => \$email,
 218                 'git!' => \$email_git,
 219                 'git-all-signature-types!' => \$email_git_all_signature_types,
 220                 'git-blame!' => \$email_git_blame,
 221                 'git-blame-signatures!' => \$email_git_blame_signatures,
 222                 'git-fallback!' => \$email_git_fallback,
 223                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 224                 'git-min-signatures=i' => \$email_git_min_signatures,
 225                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 226                 'git-min-percent=i' => \$email_git_min_percent,
 227                 'git-since=s' => \$email_git_since,
 228                 'hg-since=s' => \$email_hg_since,
 229                 'i|interactive!' => \$interactive,
 230                 'remove-duplicates!' => \$email_remove_duplicates,
 231                 'mailmap!' => \$email_use_mailmap,
 232                 'm!' => \$email_maintainer,
 233                 'r!' => \$email_reviewer,
 234                 'n!' => \$email_usename,
 235                 'l!' => \$email_list,
 236                 's!' => \$email_subscriber_list,
 237                 'multiline!' => \$output_multiline,
 238                 'roles!' => \$output_roles,
 239                 'rolestats!' => \$output_rolestats,
 240                 'separator=s' => \$output_separator,
 241                 'subsystem!' => \$subsystem,
 242                 'status!' => \$status,
 243                 'scm!' => \$scm,
 244                 'web!' => \$web,
 245                 'pattern-depth=i' => \$pattern_depth,
 246                 'k|keywords!' => \$keywords,
 247                 'sections!' => \$sections,
 248                 'fe|file-emails!' => \$file_emails,
 249                 'f|file' => \$from_filename,
 250                 'v|version' => \$version,
 251                 'h|help|usage' => \$help,
 252                 )) {
 253     die "$P: invalid argument - use --help if necessary\n";
 254 }
 255
 256 if ($help != 0) {
 257     usage();
 258     exit 0;
 259 }
 260
 261 if ($version != 0) {
 262     print("${P} ${V}\n");
 263     exit 0;
 264 }
 265
 266 if (-t STDIN && !@ARGV) {
 267     # We're talking to a terminal, but have no command line arguments.
 268     die "$P: missing patchfile or -f file - use --help if necessary\n";
 269 }
 270
 271 $output_multiline = 0 if ($output_separator ne ", ");
 272 $output_rolestats = 1 if ($interactive);
 273 $output_roles = 1 if ($output_rolestats);
 274
 275 if ($sections) {
 276     $email = 0;
 277     $email_list = 0;
 278     $scm = 0;
 279     $status = 0;
 280     $subsystem = 0;
 281     $web = 0;
 282     $keywords = 0;
 283     $interactive = 0;
 284 } else {
 285     my $selections = $email + $scm + $status + $subsystem + $web;
 286     if ($selections == 0) {
 287         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 288     }
 289 }
 290
 291 if ($email &&
 292     ($email_maintainer + $email_reviewer +
 293      $email_list + $email_subscriber_list +
 294      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 295     die "$P: Please select at least 1 email option\n";
 296 }
 297
 298 if (!top_of_mesa_tree($lk_path)) {
 299     die "$P: The current directory does not appear to be "
 300         . "a mesa source tree.\n";
 301 }
 302
 303 ## Read REVIEWERS for type/value pairs
 304
 305 my @typevalue = ();
 306 my %keyword_hash;
 307
 308 open (my $maint, '<', "${lk_path}REVIEWERS")
 309     or die "$P: Can't open REVIEWERS: $!\n";
 310 while (<$maint>) {
 311     my $line = $_;
 312
 313     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 314         my $type = $1;
 315         my $value = $2;
 316
 317         ##Filename pattern matching
 318         if ($type eq "F" || $type eq "X") {
 319             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 320             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 321             $value =~ s/\?/\./g;         ##Convert ? to .
 322             ##if pattern is a directory and it lacks a trailing slash, add one
 323             if ((-d $value)) {
 324                 $value =~ s@([^/])$@$1/@;
 325             }
 326         } elsif ($type eq "K") {
 327             $keyword_hash{@typevalue} = $value;
 328         }
 329         push(@typevalue, "$type:$value");
 330     } elsif (!/^(\s)*$/) {
 331         $line =~ s/\n$//g;
 332         push(@typevalue, $line);
 333     }
 334 }
 335 close($maint);
 336
 337
 338 #
 339 # Read mail address map
 340 #
 341
 342 my $mailmap;
 343
 344 read_mailmap();
 345
 346 sub read_mailmap {
 347     $mailmap = {
 348         names => {},
 349         addresses => {}
 350     };
 351
 352     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 353
 354     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 355         or warn "$P: Can't open .mailmap: $!\n";
 356
 357     while (<$mailmap_file>) {
 358         s/#.*$//; #strip comments
 359         s/^\s+|\s+$//g; #trim
 360
 361         next if (/^\s*$/); #skip empty lines
 362         #entries have one of the following formats:
 363         # name1 <mail1>
 364         # <mail1> <mail2>
 365         # name1 <mail1> <mail2>
 366         # name1 <mail1> name2 <mail2>
 367         # (see man git-shortlog)
 368
 369         if (/^([^<]+)<([^>]+)>$/) {
 370             my $real_name = $1;
 371             my $address = $2;
 372
 373             $real_name =~ s/\s+$//;
 374             ($real_name, $address) = parse_email("$real_name <$address>");
 375             $mailmap->{names}->{$address} = $real_name;
 376
 377         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 378             my $real_address = $1;
 379             my $wrong_address = $2;
 380
 381             $mailmap->{addresses}->{$wrong_address} = $real_address;
 382
 383         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 384             my $real_name = $1;
 385             my $real_address = $2;
 386             my $wrong_address = $3;
 387
 388             $real_name =~ s/\s+$//;
 389             ($real_name, $real_address) =
 390                 parse_email("$real_name <$real_address>");
 391             $mailmap->{names}->{$wrong_address} = $real_name;
 392             $mailmap->{addresses}->{$wrong_address} = $real_address;
 393
 394         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 395             my $real_name = $1;
 396             my $real_address = $2;
 397             my $wrong_name = $3;
 398             my $wrong_address = $4;
 399
 400             $real_name =~ s/\s+$//;
 401             ($real_name, $real_address) =
 402                 parse_email("$real_name <$real_address>");
 403
 404             $wrong_name =~ s/\s+$//;
 405             ($wrong_name, $wrong_address) =
 406                 parse_email("$wrong_name <$wrong_address>");
 407
 408             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 409             $mailmap->{names}->{$wrong_email} = $real_name;
 410             $mailmap->{addresses}->{$wrong_email} = $real_address;
 411         }
 412     }
 413     close($mailmap_file);
 414 }
 415
 416 ## use the filenames on the command line or find the filenames in the patchfiles
 417
 418 my @files = ();
 419 my @range = ();
 420 my @keyword_tvi = ();
 421 my @file_emails = ();
 422
 423 if (!@ARGV) {
 424     push(@ARGV, "&STDIN");
 425 }
 426
 427 foreach my $file (@ARGV) {
 428     if ($file ne "&STDIN") {
 429         ##if $file is a directory and it lacks a trailing slash, add one
 430         if ((-d $file)) {
 431             $file =~ s@([^/])$@$1/@;
 432         } elsif (!(-f $file)) {
 433             die "$P: file '${file}' not found\n";
 434         }
 435     }
 436     if ($from_filename) {
 437         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
 438         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
 439         push(@files, $file);
 440         if ($file ne "REVIEWERS" && -f $file && ($keywords || $file_emails)) {
 441             open(my $f, '<', $file)
 442                 or die "$P: Can't open $file: $!\n";
 443             my $text = do { local($/) ; <$f> };
 444             close($f);
 445             if ($keywords) {
 446                 foreach my $line (keys %keyword_hash) {
 447                     if ($text =~ m/$keyword_hash{$line}/x) {
 448                         push(@keyword_tvi, $line);
 449                     }
 450                 }
 451             }
 452             if ($file_emails) {
 453                 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;
 454                 push(@file_emails, clean_file_emails(@poss_addr));
 455             }
 456         }
 457     } else {
 458         my $file_cnt = @files;
 459         my $lastfile;
 460
 461         open(my $patch, "< $file")
 462             or die "$P: Can't open $file: $!\n";
 463
 464         # We can check arbitrary information before the patch
 465         # like the commit message, mail headers, etc...
 466         # This allows us to match arbitrary keywords against any part
 467         # of a git format-patch generated file (subject tags, etc...)
 468
 469         my $patch_prefix = "";                  #Parsing the intro
 470
 471         while (<$patch>) {
 472             my $patch_line = $_;
 473             if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 474                 my $filename = $1;
 475                 $filename =~ s@^[^/]*/@@;
 476                 $filename =~ s@\n@@;
 477                 $lastfile = $filename;
 478                 push(@files, $filename);
 479                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 480             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 481                 if ($email_git_blame) {
 482                     push(@range, "$lastfile:$1:$2");
 483                 }
 484             } elsif ($keywords) {
 485                 foreach my $line (keys %keyword_hash) {
 486                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 487                         push(@keyword_tvi, $line);
 488                     }
 489                 }
 490             }
 491         }
 492         close($patch);
 493
 494         if ($file_cnt == @files) {
 495             warn "$P: file '${file}' doesn't appear to be a patch.  "
 496                 . "Add -f to options?\n";
 497         }
 498         @files = sort_and_uniq(@files);
 499     }
 500 }
 501
 502 @file_emails = uniq(@file_emails);
 503
 504 my %email_hash_name;
 505 my %email_hash_address;
 506 my @email_to = ();
 507 my %hash_list_to;
 508 my @list_to = ();
 509 my @scm = ();
 510 my @web = ();
 511 my @subsystem = ();
 512 my @status = ();
 513 my %deduplicate_name_hash = ();
 514 my %deduplicate_address_hash = ();
 515
 516 my @maintainers = get_maintainers();
 517
 518 if (@maintainers) {
 519     @maintainers = merge_email(@maintainers);
 520     output(@maintainers);
 521 }
 522
 523 if ($scm) {
 524     @scm = uniq(@scm);
 525     output(@scm);
 526 }
 527
 528 if ($status) {
 529     @status = uniq(@status);
 530     output(@status);
 531 }
 532
 533 if ($subsystem) {
 534     @subsystem = uniq(@subsystem);
 535     output(@subsystem);
 536 }
 537
 538 if ($web) {
 539     @web = uniq(@web);
 540     output(@web);
 541 }
 542
 543 exit($exit);
 544
 545 sub ignore_email_address {
 546     my ($address) = @_;
 547
 548     foreach my $ignore (@ignore_emails) {
 549         return 1 if ($ignore eq $address);
 550     }
 551
 552     return 0;
 553 }
 554
 555 sub range_is_maintained {
 556     my ($start, $end) = @_;
 557
 558     for (my $i = $start; $i < $end; $i++) {
 559         my $line = $typevalue[$i];
 560         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 561             my $type = $1;
 562             my $value = $2;
 563             if ($type eq 'S') {
 564                 if ($value =~ /(maintain|support)/i) {
 565                     return 1;
 566                 }
 567             }
 568         }
 569     }
 570     return 0;
 571 }
 572
 573 sub range_has_maintainer {
 574     my ($start, $end) = @_;
 575
 576     for (my $i = $start; $i < $end; $i++) {
 577         my $line = $typevalue[$i];
 578         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 579             my $type = $1;
 580             my $value = $2;
 581             if ($type eq 'M') {
 582                 return 1;
 583             }
 584         }
 585     }
 586     return 0;
 587 }
 588
 589 sub get_maintainers {
 590     %email_hash_name = ();
 591     %email_hash_address = ();
 592     %commit_author_hash = ();
 593     %commit_signer_hash = ();
 594     @email_to = ();
 595     %hash_list_to = ();
 596     @list_to = ();
 597     @scm = ();
 598     @web = ();
 599     @subsystem = ();
 600     @status = ();
 601     %deduplicate_name_hash = ();
 602     %deduplicate_address_hash = ();
 603     if ($email_git_all_signature_types) {
 604         $signature_pattern = "(.+?)[Bb][Yy]:";
 605     } else {
 606         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 607     }
 608
 609     # Find responsible parties
 610
 611     my %exact_pattern_match_hash = ();
 612
 613     foreach my $file (@files) {
 614
 615         my %hash;
 616         my $tvi = find_first_section();
 617         while ($tvi < @typevalue) {
 618             my $start = find_starting_index($tvi);
 619             my $end = find_ending_index($tvi);
 620             my $exclude = 0;
 621             my $i;
 622
 623             #Do not match excluded file patterns
 624
 625             for ($i = $start; $i < $end; $i++) {
 626                 my $line = $typevalue[$i];
 627                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
 628                     my $type = $1;
 629                     my $value = $2;
 630                     if ($type eq 'X') {
 631                         if (file_match_pattern($file, $value)) {
 632                             $exclude = 1;
 633                             last;
 634                         }
 635                     }
 636                 }
 637             }
 638
 639             if (!$exclude) {
 640                 for ($i = $start; $i < $end; $i++) {
 641                     my $line = $typevalue[$i];
 642                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 643                         my $type = $1;
 644                         my $value = $2;
 645                         if ($type eq 'F') {
 646                             if (file_match_pattern($file, $value)) {
 647                                 my $value_pd = ($value =~ tr@/@@);
 648                                 my $file_pd = ($file  =~ tr@/@@);
 649                                 $value_pd++ if (substr($value,-1,1) ne "/");
 650                                 $value_pd = -1 if ($value =~ /^\.\*/);
 651                                 if ($value_pd >= $file_pd &&
 652                                     range_is_maintained($start, $end) &&
 653                                     range_has_maintainer($start, $end)) {
 654                                     $exact_pattern_match_hash{$file} = 1;
 655                                 }
 656                                 if ($pattern_depth == 0 ||
 657                                     (($file_pd - $value_pd) < $pattern_depth)) {
 658                                     $hash{$tvi} = $value_pd;
 659                                 }
 660                             }
 661                         } elsif ($type eq 'N') {
 662                             if ($file =~ m/$value/x) {
 663                                 $hash{$tvi} = 0;
 664                             }
 665                         }
 666                     }
 667                 }
 668             }
 669             $tvi = $end + 1;
 670         }
 671
 672         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 673             add_categories($line);
 674             if ($sections) {
 675                 my $i;
 676                 my $start = find_starting_index($line);
 677                 my $end = find_ending_index($line);
 678                 for ($i = $start; $i < $end; $i++) {
 679                     my $line = $typevalue[$i];
 680                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 681                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 682                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 683                         $line =~ s/\\\./\./g;           ##Convert \. to .
 684                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 685                     }
 686                     $line =~ s/^([A-Z]):/$1:\t/g;
 687                     print("$line\n");
 688                 }
 689                 print("\n");
 690             }
 691         }
 692     }
 693
 694     if ($keywords) {
 695         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 696         foreach my $line (@keyword_tvi) {
 697             add_categories($line);
 698         }
 699     }
 700
 701     foreach my $email (@email_to, @list_to) {
 702         $email->[0] = deduplicate_email($email->[0]);
 703     }
 704
 705     foreach my $file (@files) {
 706         if ($email &&
 707             ($email_git || ($email_git_fallback &&
 708                             !$exact_pattern_match_hash{$file}))) {
 709             vcs_file_signoffs($file);
 710         }
 711         if ($email && $email_git_blame) {
 712             vcs_file_blame($file);
 713         }
 714     }
 715
 716     if ($email) {
 717         foreach my $chief (@penguin_chief) {
 718             if ($chief =~ m/^(.*):(.*)/) {
 719                 my $email_address;
 720
 721                 $email_address = format_email($1, $2, $email_usename);
 722                 if ($email_git_penguin_chiefs) {
 723                     push(@email_to, [$email_address, 'chief penguin']);
 724                 } else {
 725                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 726                 }
 727             }
 728         }
 729
 730         foreach my $email (@file_emails) {
 731             my ($name, $address) = parse_email($email);
 732
 733             my $tmp_email = format_email($name, $address, $email_usename);
 734             push_email_address($tmp_email, '');
 735             add_role($tmp_email, 'in file');
 736         }
 737     }
 738
 739     my @to = ();
 740     if ($email || $email_list) {
 741         if ($email) {
 742             @to = (@to, @email_to);
 743         }
 744         if ($email_list) {
 745             @to = (@to, @list_to);
 746         }
 747     }
 748
 749     if ($interactive) {
 750         @to = interactive_get_maintainers(\@to);
 751     }
 752
 753     return @to;
 754 }
 755
 756 sub file_match_pattern {
 757     my ($file, $pattern) = @_;
 758     if (substr($pattern, -1) eq "/") {
 759         if ($file =~ m@^$pattern@) {
 760             return 1;
 761         }
 762     } else {
 763         if ($file =~ m@^$pattern@) {
 764             my $s1 = ($file =~ tr@/@@);
 765             my $s2 = ($pattern =~ tr@/@@);
 766             if ($s1 == $s2) {
 767                 return 1;
 768             }
 769         }
 770     }
 771     return 0;
 772 }
 773
 774 sub usage {
 775     print <<EOT;
 776 usage: $P [options] patchfile
 777        $P [options] -f file|directory
 778 version: $V
 779
 780 REVIEWER field selection options:
 781   --email => print email address(es) if any
 782     --git => include recent git \*-by: signers
 783     --git-all-signature-types => include signers regardless of signature type
 784         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
 785     --git-fallback => use git when no exact REVIEWERS pattern (default: $email_git_fallback)
 786     --git-chief-penguins => include ${penguin_chiefs}
 787     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
 788     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
 789     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
 790     --git-blame => use git blame to find modified commits for patch or file
 791     --git-blame-signatures => when used with --git-blame, also include all commit signers
 792     --git-since => git history to use (default: $email_git_since)
 793     --hg-since => hg history to use (default: $email_hg_since)
 794     --interactive => display a menu (mostly useful if used with the --git option)
 795     --m => include maintainer(s) if any
 796     --r => include reviewer(s) if any
 797     --n => include name 'Full Name <addr\@domain.tld>'
 798     --l => include list(s) if any
 799     --s => include subscriber only list(s) if any
 800     --remove-duplicates => minimize duplicate email names/addresses
 801     --roles => show roles (status:subsystem, git-signer, list, etc...)
 802     --rolestats => show roles and statistics (commits/total_commits, %)
 803     --file-emails => add email addresses found in -f file (default: 0 (off))
 804   --scm => print SCM tree(s) if any
 805   --status => print status if any
 806   --subsystem => print subsystem name if any
 807   --web => print website(s) if any
 808
 809 Output type options:
 810   --separator [, ] => separator for multiple entries on 1 line
 811     using --separator also sets --nomultiline if --separator is not [, ]
 812   --multiline => print 1 entry per line
 813
 814 Other options:
 815   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 816   --keywords => scan patch for keywords (default: $keywords)
 817   --sections => print all of the subsystem sections with pattern matches
 818   --mailmap => use .mailmap file (default: $email_use_mailmap)
 819   --version => show version
 820   --help => show this help information
 821
 822 Default options:
 823   [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
 824    --remove-duplicates --rolestats]
 825
 826 Notes:
 827   Using "-f directory" may give unexpected results:
 828       Used with "--git", git signators for _all_ files in and below
 829           directory are examined as git recurses directories.
 830           Any specified X: (exclude) pattern matches are _not_ ignored.
 831       Used with "--nogit", directory is used as a pattern match,
 832           no individual file within the directory or subdirectory
 833           is matched.
 834       Used with "--git-blame", does not iterate all files in directory
 835   Using "--git-blame" is slow and may add old committers and authors
 836       that are no longer active maintainers to the output.
 837   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
 838       other automated tools that expect only ["name"] <email address>
 839       may not work because of additional output after <email address>.
 840   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
 841       not the percentage of the entire file authored.  # of commits is
 842       not a good measure of amount of code authored.  1 major commit may
 843       contain a thousand lines, 5 trivial commits may modify a single line.
 844   If git is not installed, but mercurial (hg) is installed and an .hg
 845       repository exists, the following options apply to mercurial:
 846           --git,
 847           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
 848           --git-blame
 849       Use --hg-since not --git-since to control date selection
 850   File ".get_maintainer.conf", if it exists in the linux kernel source root
 851       directory, can change whatever get_maintainer defaults are desired.
 852       Entries in this file can be any command line argument.
 853       This file is prepended to any additional command line arguments.
 854       Multiple lines and # comments are allowed.
 855   Most options have both positive and negative forms.
 856       The negative forms for --<foo> are --no<foo> and --no-<foo>.
 857
 858 EOT
 859 }
 860
 861 sub top_of_mesa_tree {
 862     my ($lk_path) = @_;
 863
 864     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 865         $lk_path .= "/";
 866     }
 867     if (   (-f "${lk_path}docs/mesa.css")
 868         && (-f "${lk_path}docs/features.txt")
 869         && (-f "${lk_path}src/mesa/main/version.c")
 870         && (-f "${lk_path}REVIEWERS")
 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_subsystem_name {
 974     my ($index) = @_;
 975
 976     my $start = find_starting_index($index);
 977
 978     my $subsystem = $typevalue[$start];
 979     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
 980         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
 981         $subsystem =~ s/\s*$//;
 982         $subsystem = $subsystem . "...";
 983     }
 984     return $subsystem;
 985 }
 986
 987 sub get_maintainer_role {
 988     my ($index) = @_;
 989
 990     my $i;
 991     my $start = find_starting_index($index);
 992     my $end = find_ending_index($index);
 993
 994     my $role = "unknown";
 995     my $subsystem = get_subsystem_name($index);
 996
 997     for ($i = $start + 1; $i < $end; $i++) {
 998         my $tv = $typevalue[$i];
 999         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1000             my $ptype = $1;
1001             my $pvalue = $2;
1002             if ($ptype eq "S") {
1003                 $role = $pvalue;
1004             }
1005         }
1006     }
1007
1008     $role = lc($role);
1009     if      ($role eq "supported") {
1010         $role = "supporter";
1011     } elsif ($role eq "maintained") {
1012         $role = "maintainer";
1013     } elsif ($role eq "odd fixes") {
1014         $role = "odd fixer";
1015     } elsif ($role eq "orphan") {
1016         $role = "orphan minder";
1017     } elsif ($role eq "obsolete") {
1018         $role = "obsolete minder";
1019     } elsif ($role eq "buried alive in reporters") {
1020         $role = "chief penguin";
1021     }
1022
1023     return $role . ":" . $subsystem;
1024 }
1025
1026 sub get_list_role {
1027     my ($index) = @_;
1028
1029     my $subsystem = get_subsystem_name($index);
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                     my $subsystem = get_subsystem_name($i);
1118                     push_email_addresses($pvalue, "reviewer:$subsystem");
1119                 }
1120             } elsif ($ptype eq "T") {
1121                 push(@scm, $pvalue);
1122             } elsif ($ptype eq "W") {
1123                 push(@web, $pvalue);
1124             } elsif ($ptype eq "S") {
1125                 push(@status, $pvalue);
1126             }
1127         }
1128     }
1129 }
1130
1131 sub email_inuse {
1132     my ($name, $address) = @_;
1133
1134     return 1 if (($name eq "") && ($address eq ""));
1135     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1136     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1137
1138     return 0;
1139 }
1140
1141 sub push_email_address {
1142     my ($line, $role) = @_;
1143
1144     my ($name, $address) = parse_email($line);
1145
1146     if ($address eq "") {
1147         return 0;
1148     }
1149
1150     if (!$email_remove_duplicates) {
1151         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1152     } elsif (!email_inuse($name, $address)) {
1153         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1154         $email_hash_name{lc($name)}++ if ($name ne "");
1155         $email_hash_address{lc($address)}++;
1156     }
1157
1158     return 1;
1159 }
1160
1161 sub push_email_addresses {
1162     my ($address, $role) = @_;
1163
1164     my @address_list = ();
1165
1166     if (rfc822_valid($address)) {
1167         push_email_address($address, $role);
1168     } elsif (@address_list = rfc822_validlist($address)) {
1169         my $array_count = shift(@address_list);
1170         while (my $entry = shift(@address_list)) {
1171             push_email_address($entry, $role);
1172         }
1173     } else {
1174         if (!push_email_address($address, $role)) {
1175             warn("Invalid REVIEWERS address: '" . $address . "'\n");
1176         }
1177     }
1178 }
1179
1180 sub add_role {
1181     my ($line, $role) = @_;
1182
1183     my ($name, $address) = parse_email($line);
1184     my $email = format_email($name, $address, $email_usename);
1185
1186     foreach my $entry (@email_to) {
1187         if ($email_remove_duplicates) {
1188             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1189             if (($name eq $entry_name || $address eq $entry_address)
1190                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1191             ) {
1192                 if ($entry->[1] eq "") {
1193                     $entry->[1] = "$role";
1194                 } else {
1195                     $entry->[1] = "$entry->[1],$role";
1196                 }
1197             }
1198         } else {
1199             if ($email eq $entry->[0]
1200                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1201             ) {
1202                 if ($entry->[1] eq "") {
1203                     $entry->[1] = "$role";
1204                 } else {
1205                     $entry->[1] = "$entry->[1],$role";
1206                 }
1207             }
1208         }
1209     }
1210 }
1211
1212 sub which {
1213     my ($bin) = @_;
1214
1215     foreach my $path (split(/:/, $ENV{PATH})) {
1216         if (-e "$path/$bin") {
1217             return "$path/$bin";
1218         }
1219     }
1220
1221     return "";
1222 }
1223
1224 sub which_conf {
1225     my ($conf) = @_;
1226
1227     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1228         if (-e "$path/$conf") {
1229             return "$path/$conf";
1230         }
1231     }
1232
1233     return "";
1234 }
1235
1236 sub mailmap_email {
1237     my ($line) = @_;
1238
1239     my ($name, $address) = parse_email($line);
1240     my $email = format_email($name, $address, 1);
1241     my $real_name = $name;
1242     my $real_address = $address;
1243
1244     if (exists $mailmap->{names}->{$email} ||
1245         exists $mailmap->{addresses}->{$email}) {
1246         if (exists $mailmap->{names}->{$email}) {
1247             $real_name = $mailmap->{names}->{$email};
1248         }
1249         if (exists $mailmap->{addresses}->{$email}) {
1250             $real_address = $mailmap->{addresses}->{$email};
1251         }
1252     } else {
1253         if (exists $mailmap->{names}->{$address}) {
1254             $real_name = $mailmap->{names}->{$address};
1255         }
1256         if (exists $mailmap->{addresses}->{$address}) {
1257             $real_address = $mailmap->{addresses}->{$address};
1258         }
1259     }
1260     return format_email($real_name, $real_address, 1);
1261 }
1262
1263 sub mailmap {
1264     my (@addresses) = @_;
1265
1266     my @mapped_emails = ();
1267     foreach my $line (@addresses) {
1268         push(@mapped_emails, mailmap_email($line));
1269     }
1270     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1271     return @mapped_emails;
1272 }
1273
1274 sub merge_by_realname {
1275     my %address_map;
1276     my (@emails) = @_;
1277
1278     foreach my $email (@emails) {
1279         my ($name, $address) = parse_email($email);
1280         if (exists $address_map{$name}) {
1281             $address = $address_map{$name};
1282             $email = format_email($name, $address, 1);
1283         } else {
1284             $address_map{$name} = $address;
1285         }
1286     }
1287 }
1288
1289 sub git_execute_cmd {
1290     my ($cmd) = @_;
1291     my @lines = ();
1292
1293     my $output = `$cmd`;
1294     $output =~ s/^\s*//gm;
1295     @lines = split("\n", $output);
1296
1297     return @lines;
1298 }
1299
1300 sub hg_execute_cmd {
1301     my ($cmd) = @_;
1302     my @lines = ();
1303
1304     my $output = `$cmd`;
1305     @lines = split("\n", $output);
1306
1307     return @lines;
1308 }
1309
1310 sub extract_formatted_signatures {
1311     my (@signature_lines) = @_;
1312
1313     my @type = @signature_lines;
1314
1315     s/\s*(.*):.*/$1/ for (@type);
1316
1317     # cut -f2- -d":"
1318     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1319
1320 ## Reformat email addresses (with names) to avoid badly written signatures
1321
1322     foreach my $signer (@signature_lines) {
1323         $signer = deduplicate_email($signer);
1324     }
1325
1326     return (\@type, \@signature_lines);
1327 }
1328
1329 sub vcs_find_signers {
1330     my ($cmd, $file) = @_;
1331     my $commits;
1332     my @lines = ();
1333     my @signatures = ();
1334     my @authors = ();
1335     my @stats = ();
1336
1337     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1338
1339     my $pattern = $VCS_cmds{"commit_pattern"};
1340     my $author_pattern = $VCS_cmds{"author_pattern"};
1341     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1342
1343     $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1344
1345     $commits = grep(/$pattern/, @lines);        # of commits
1346
1347     @authors = grep(/$author_pattern/, @lines);
1348     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1349     @stats = grep(/$stat_pattern/, @lines);
1350
1351 #    print("stats: <@stats>\n");
1352
1353     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1354
1355     save_commits_by_author(@lines) if ($interactive);
1356     save_commits_by_signer(@lines) if ($interactive);
1357
1358     if (!$email_git_penguin_chiefs) {
1359         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1360     }
1361
1362     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1363     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1364
1365     return ($commits, $signers_ref, $authors_ref, \@stats);
1366 }
1367
1368 sub vcs_find_author {
1369     my ($cmd) = @_;
1370     my @lines = ();
1371
1372     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1373
1374     if (!$email_git_penguin_chiefs) {
1375         @lines = grep(!/${penguin_chiefs}/i, @lines);
1376     }
1377
1378     return @lines if !@lines;
1379
1380     my @authors = ();
1381     foreach my $line (@lines) {
1382         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1383             my $author = $1;
1384             my ($name, $address) = parse_email($author);
1385             $author = format_email($name, $address, 1);
1386             push(@authors, $author);
1387         }
1388     }
1389
1390     save_commits_by_author(@lines) if ($interactive);
1391     save_commits_by_signer(@lines) if ($interactive);
1392
1393     return @authors;
1394 }
1395
1396 sub vcs_save_commits {
1397     my ($cmd) = @_;
1398     my @lines = ();
1399     my @commits = ();
1400
1401     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1402
1403     foreach my $line (@lines) {
1404         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1405             push(@commits, $1);
1406         }
1407     }
1408
1409     return @commits;
1410 }
1411
1412 sub vcs_blame {
1413     my ($file) = @_;
1414     my $cmd;
1415     my @commits = ();
1416
1417     return @commits if (!(-f $file));
1418
1419     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1420         my @all_commits = ();
1421
1422         $cmd = $VCS_cmds{"blame_file_cmd"};
1423         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1424         @all_commits = vcs_save_commits($cmd);
1425
1426         foreach my $file_range_diff (@range) {
1427             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1428             my $diff_file = $1;
1429             my $diff_start = $2;
1430             my $diff_length = $3;
1431             next if ("$file" ne "$diff_file");
1432             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1433                 push(@commits, $all_commits[$i]);
1434             }
1435         }
1436     } elsif (@range) {
1437         foreach my $file_range_diff (@range) {
1438             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1439             my $diff_file = $1;
1440             my $diff_start = $2;
1441             my $diff_length = $3;
1442             next if ("$file" ne "$diff_file");
1443             $cmd = $VCS_cmds{"blame_range_cmd"};
1444             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1445             push(@commits, vcs_save_commits($cmd));
1446         }
1447     } else {
1448         $cmd = $VCS_cmds{"blame_file_cmd"};
1449         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1450         @commits = vcs_save_commits($cmd);
1451     }
1452
1453     foreach my $commit (@commits) {
1454         $commit =~ s/^\^//g;
1455     }
1456
1457     return @commits;
1458 }
1459
1460 my $printed_novcs = 0;
1461 sub vcs_exists {
1462     %VCS_cmds = %VCS_cmds_git;
1463     return 1 if eval $VCS_cmds{"available"};
1464     %VCS_cmds = %VCS_cmds_hg;
1465     return 2 if eval $VCS_cmds{"available"};
1466     %VCS_cmds = ();
1467     if (!$printed_novcs) {
1468         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1469         warn("Using a git repository produces better results.\n");
1470         $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 }