scripts/get_maintainer.pl

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