scripts/get_reviewer.pl

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