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