kernel/scripts/get_maintainer.pl

   1 #!/usr/bin/perl -w
   2 # (c) 2007, Joe Perches <joe@perches.com>
   3 #           created from checkpatch.pl
   4 #
   5 # Print selected MAINTAINERS information for
   6 # the files modified in a patch or for a file
   7 #
   8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
   9 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
  10 #
  11 # Licensed under the terms of the GNU GPL License version 2
  12
  13 use strict;
  14
  15 my $P = $0;
  16 my $V = '0.26';
  17
  18 use Getopt::Long qw(:config no_auto_abbrev);
  19
  20 my $lk_path = "./";
  21 my $email = 1;
  22 my $email_usename = 1;
  23 my $email_maintainer = 1;
  24 my $email_reviewer = 1;
  25 my $email_list = 1;
  26 my $email_subscriber_list = 0;
  27 my $email_git_penguin_chiefs = 0;
  28 my $email_git = 0;
  29 my $email_git_all_signature_types = 0;
  30 my $email_git_blame = 0;
  31 my $email_git_blame_signatures = 1;
  32 my $email_git_fallback = 1;
  33 my $email_git_min_signatures = 1;
  34 my $email_git_max_maintainers = 5;
  35 my $email_git_min_percent = 5;
  36 my $email_git_since = "1-year-ago";
  37 my $email_hg_since = "-365";
  38 my $interactive = 0;
  39 my $email_remove_duplicates = 1;
  40 my $email_use_mailmap = 1;
  41 my $output_multiline = 1;
  42 my $output_separator = ", ";
  43 my $output_roles = 0;
  44 my $output_rolestats = 1;
  45 my $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, "Linus Torvalds:torvalds\@linux-foundation.org");
  66 #Andrew wants in on most everything - 2009/01/14
  67 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  68
  69 my @penguin_chief_names = ();
  70 foreach my $chief (@penguin_chief) {
  71     if ($chief =~ m/^(.*):(.*)/) {
  72         my $chief_name = $1;
  73         my $chief_addr = $2;
  74         push(@penguin_chief_names, $chief_name);
  75     }
  76 }
  77 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  78
  79 # Signature types of people who are either
  80 #       a) responsible for the code in question, or
  81 #       b) familiar enough with it to give relevant feedback
  82 my @signature_tags = ();
  83 push(@signature_tags, "Signed-off-by:");
  84 push(@signature_tags, "Reviewed-by:");
  85 push(@signature_tags, "Acked-by:");
  86
  87 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
  88
  89 # rfc822 email address - preloaded methods go here.
  90 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  91 my $rfc822_char = '[\\000-\\377]';
  92
  93 # VCS command support: class-like functions and strings
  94
  95 my %VCS_cmds;
  96
  97 my %VCS_cmds_git = (
  98     "execute_cmd" => \&git_execute_cmd,
  99     "available" => '(which("git") ne "") && (-e ".git")',
 100     "find_signers_cmd" =>
 101         "git log --no-color --follow --since=\$email_git_since " .
 102             '--numstat --no-merges ' .
 103             '--format="GitCommit: %H%n' .
 104                       'GitAuthor: %an <%ae>%n' .
 105                       'GitDate: %aD%n' .
 106                       'GitSubject: %s%n' .
 107                       '%b%n"' .
 108             " -- \$file",
 109     "find_commit_signers_cmd" =>
 110         "git log --no-color " .
 111             '--numstat ' .
 112             '--format="GitCommit: %H%n' .
 113                       'GitAuthor: %an <%ae>%n' .
 114                       'GitDate: %aD%n' .
 115                       'GitSubject: %s%n' .
 116                       '%b%n"' .
 117             " -1 \$commit",
 118     "find_commit_author_cmd" =>
 119         "git log --no-color " .
 120             '--numstat ' .
 121             '--format="GitCommit: %H%n' .
 122                       'GitAuthor: %an <%ae>%n' .
 123                       'GitDate: %aD%n' .
 124                       'GitSubject: %s%n"' .
 125             " -1 \$commit",
 126     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 127     "blame_file_cmd" => "git blame -l \$file",
 128     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 129     "blame_commit_pattern" => "^([0-9a-f]+) ",
 130     "author_pattern" => "^GitAuthor: (.*)",
 131     "subject_pattern" => "^GitSubject: (.*)",
 132     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 133 );
 134
 135 my %VCS_cmds_hg = (
 136     "execute_cmd" => \&hg_execute_cmd,
 137     "available" => '(which("hg") ne "") && (-d ".hg")',
 138     "find_signers_cmd" =>
 139         "hg log --date=\$email_hg_since " .
 140             "--template='HgCommit: {node}\\n" .
 141                         "HgAuthor: {author}\\n" .
 142                         "HgSubject: {desc}\\n'" .
 143             " -- \$file",
 144     "find_commit_signers_cmd" =>
 145         "hg log " .
 146             "--template='HgSubject: {desc}\\n'" .
 147             " -r \$commit",
 148     "find_commit_author_cmd" =>
 149         "hg log " .
 150             "--template='HgCommit: {node}\\n" .
 151                         "HgAuthor: {author}\\n" .
 152                         "HgSubject: {desc|firstline}\\n'" .
 153             " -r \$commit",
 154     "blame_range_cmd" => "",            # not supported
 155     "blame_file_cmd" => "hg blame -n \$file",
 156     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 157     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 158     "author_pattern" => "^HgAuthor: (.*)",
 159     "subject_pattern" => "^HgSubject: (.*)",
 160     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 161 );
 162
 163 my $conf = which_conf(".get_maintainer.conf");
 164 if (-f $conf) {
 165     my @conf_args;
 166     open(my $conffile, '<', "$conf")
 167         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 168
 169     while (<$conffile>) {
 170         my $line = $_;
 171
 172         $line =~ s/\s*\n?$//g;
 173         $line =~ s/^\s*//g;
 174         $line =~ s/\s+/ /g;
 175
 176         next if ($line =~ m/^\s*#/);
 177         next if ($line =~ m/^\s*$/);
 178
 179         my @words = split(" ", $line);
 180         foreach my $word (@words) {
 181             last if ($word =~ m/^#/);
 182             push (@conf_args, $word);
 183         }
 184     }
 185     close($conffile);
 186     unshift(@ARGV, @conf_args) if @conf_args;
 187 }
 188
 189 if (!GetOptions(
 190                 'email!' => \$email,
 191                 'git!' => \$email_git,
 192                 'git-all-signature-types!' => \$email_git_all_signature_types,
 193                 'git-blame!' => \$email_git_blame,
 194                 'git-blame-signatures!' => \$email_git_blame_signatures,
 195                 'git-fallback!' => \$email_git_fallback,
 196                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 197                 'git-min-signatures=i' => \$email_git_min_signatures,
 198                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 199                 'git-min-percent=i' => \$email_git_min_percent,
 200                 'git-since=s' => \$email_git_since,
 201                 'hg-since=s' => \$email_hg_since,
 202                 'i|interactive!' => \$interactive,
 203                 'remove-duplicates!' => \$email_remove_duplicates,
 204                 'mailmap!' => \$email_use_mailmap,
 205                 'm!' => \$email_maintainer,
 206                 'r!' => \$email_reviewer,
 207                 'n!' => \$email_usename,
 208                 'l!' => \$email_list,
 209                 's!' => \$email_subscriber_list,
 210                 'multiline!' => \$output_multiline,
 211                 'roles!' => \$output_roles,
 212                 'rolestats!' => \$output_rolestats,
 213                 'separator=s' => \$output_separator,
 214                 'subsystem!' => \$subsystem,
 215                 'status!' => \$status,
 216                 'scm!' => \$scm,
 217                 'web!' => \$web,
 218                 'pattern-depth=i' => \$pattern_depth,
 219                 'k|keywords!' => \$keywords,
 220                 'sections!' => \$sections,
 221                 'fe|file-emails!' => \$file_emails,
 222                 'f|file' => \$from_filename,
 223                 'v|version' => \$version,
 224                 'h|help|usage' => \$help,
 225                 )) {
 226     die "$P: invalid argument - use --help if necessary\n";
 227 }
 228
 229 if ($help != 0) {
 230     usage();
 231     exit 0;
 232 }
 233
 234 if ($version != 0) {
 235     print("${P} ${V}\n");
 236     exit 0;
 237 }
 238
 239 if (-t STDIN && !@ARGV) {
 240     # We're talking to a terminal, but have no command line arguments.
 241     die "$P: missing patchfile or -f file - use --help if necessary\n";
 242 }
 243
 244 $output_multiline = 0 if ($output_separator ne ", ");
 245 $output_rolestats = 1 if ($interactive);
 246 $output_roles = 1 if ($output_rolestats);
 247
 248 if ($sections) {
 249     $email = 0;
 250     $email_list = 0;
 251     $scm = 0;
 252     $status = 0;
 253     $subsystem = 0;
 254     $web = 0;
 255     $keywords = 0;
 256     $interactive = 0;
 257 } else {
 258     my $selections = $email + $scm + $status + $subsystem + $web;
 259     if ($selections == 0) {
 260         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 261     }
 262 }
 263
 264 if ($email &&
 265     ($email_maintainer + $email_reviewer +
 266      $email_list + $email_subscriber_list +
 267      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 268     die "$P: Please select at least 1 email option\n";
 269 }
 270
 271 if (!top_of_kernel_tree($lk_path)) {
 272     die "$P: The current directory does not appear to be "
 273         . "a linux kernel source tree.\n";
 274 }
 275
 276 ## Read MAINTAINERS for type/value pairs
 277
 278 my @typevalue = ();
 279 my %keyword_hash;
 280
 281 open (my $maint, '<', "${lk_path}MAINTAINERS")
 282     or die "$P: Can't open MAINTAINERS: $!\n";
 283 while (<$maint>) {
 284     my $line = $_;
 285
 286     if ($line =~ m/^(\C):\s*(.*)/) {
 287         my $type = $1;
 288         my $value = $2;
 289
 290         ##Filename pattern matching
 291         if ($type eq "F" || $type eq "X") {
 292             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 293             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 294             $value =~ s/\?/\./g;         ##Convert ? to .
 295             ##if pattern is a directory and it lacks a trailing slash, add one
 296             if ((-d $value)) {
 297                 $value =~ s@([^/])$@$1/@;
 298             }
 299         } elsif ($type eq "K") {
 300             $keyword_hash{@typevalue} = $value;
 301         }
 302         push(@typevalue, "$type:$value");
 303     } elsif (!/^(\s)*$/) {
 304         $line =~ s/\n$//g;
 305         push(@typevalue, $line);
 306     }
 307 }
 308 close($maint);
 309
 310
 311 #
 312 # Read mail address map
 313 #
 314
 315 my $mailmap;
 316
 317 read_mailmap();
 318
 319 sub read_mailmap {
 320     $mailmap = {
 321         names => {},
 322         addresses => {}
 323     };
 324
 325     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 326
 327     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 328         or warn "$P: Can't open .mailmap: $!\n";
 329
 330     while (<$mailmap_file>) {
 331         s/#.*$//; #strip comments
 332         s/^\s+|\s+$//g; #trim
 333
 334         next if (/^\s*$/); #skip empty lines
 335         #entries have one of the following formats:
 336         # name1 <mail1>
 337         # <mail1> <mail2>
 338         # name1 <mail1> <mail2>
 339         # name1 <mail1> name2 <mail2>
 340         # (see man git-shortlog)
 341
 342         if (/^([^<]+)<([^>]+)>$/) {
 343             my $real_name = $1;
 344             my $address = $2;
 345
 346             $real_name =~ s/\s+$//;
 347             ($real_name, $address) = parse_email("$real_name <$address>");
 348             $mailmap->{names}->{$address} = $real_name;
 349
 350         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 351             my $real_address = $1;
 352             my $wrong_address = $2;
 353
 354             $mailmap->{addresses}->{$wrong_address} = $real_address;
 355
 356         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 357             my $real_name = $1;
 358             my $real_address = $2;
 359             my $wrong_address = $3;
 360
 361             $real_name =~ s/\s+$//;
 362             ($real_name, $real_address) =
 363                 parse_email("$real_name <$real_address>");
 364             $mailmap->{names}->{$wrong_address} = $real_name;
 365             $mailmap->{addresses}->{$wrong_address} = $real_address;
 366
 367         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 368             my $real_name = $1;
 369             my $real_address = $2;
 370             my $wrong_name = $3;
 371             my $wrong_address = $4;
 372
 373             $real_name =~ s/\s+$//;
 374             ($real_name, $real_address) =
 375                 parse_email("$real_name <$real_address>");
 376
 377             $wrong_name =~ s/\s+$//;
 378             ($wrong_name, $wrong_address) =
 379                 parse_email("$wrong_name <$wrong_address>");
 380
 381             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 382             $mailmap->{names}->{$wrong_email} = $real_name;
 383             $mailmap->{addresses}->{$wrong_email} = $real_address;
 384         }
 385     }
 386     close($mailmap_file);
 387 }
 388
 389 ## use the filenames on the command line or find the filenames in the patchfiles
 390
 391 my @files = ();
 392 my @range = ();
 393 my @keyword_tvi = ();
 394 my @file_emails = ();
 395
 396 if (!@ARGV) {
 397     push(@ARGV, "&STDIN");
 398 }
 399
 400 foreach my $file (@ARGV) {
 401     if ($file ne "&STDIN") {
 402         ##if $file is a directory and it lacks a trailing slash, add one
 403         if ((-d $file)) {
 404             $file =~ s@([^/])$@$1/@;
 405         } elsif (!(-f $file)) {
 406             die "$P: file '${file}' not found\n";
 407         }
 408     }
 409     if ($from_filename) {
 410         push(@files, $file);
 411         if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
 412             open(my $f, '<', $file)
 413                 or die "$P: Can't open $file: $!\n";
 414             my $text = do { local($/) ; <$f> };
 415             close($f);
 416             if ($keywords) {
 417                 foreach my $line (keys %keyword_hash) {
 418                     if ($text =~ m/$keyword_hash{$line}/x) {
 419                         push(@keyword_tvi, $line);
 420                     }
 421                 }
 422             }
 423             if ($file_emails) {
 424                 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;
 425                 push(@file_emails, clean_file_emails(@poss_addr));
 426             }
 427         }
 428     } else {
 429         my $file_cnt = @files;
 430         my $lastfile;
 431
 432         open(my $patch, "< $file")
 433             or die "$P: Can't open $file: $!\n";
 434
 435         # We can check arbitrary information before the patch
 436         # like the commit message, mail headers, etc...
 437         # This allows us to match arbitrary keywords against any part
 438         # of a git format-patch generated file (subject tags, etc...)
 439
 440         my $patch_prefix = "";                  #Parsing the intro
 441
 442         while (<$patch>) {
 443             my $patch_line = $_;
 444             if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 445                 my $filename = $1;
 446                 $filename =~ s@^[^/]*/@@;
 447                 $filename =~ s@\n@@;
 448                 $lastfile = $filename;
 449                 push(@files, $filename);
 450                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 451             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 452                 if ($email_git_blame) {
 453                     push(@range, "$lastfile:$1:$2");
 454                 }
 455             } elsif ($keywords) {
 456                 foreach my $line (keys %keyword_hash) {
 457                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 458                         push(@keyword_tvi, $line);
 459                     }
 460                 }
 461             }
 462         }
 463         close($patch);
 464
 465         if ($file_cnt == @files) {
 466             warn "$P: file '${file}' doesn't appear to be a patch.  "
 467                 . "Add -f to options?\n";
 468         }
 469         @files = sort_and_uniq(@files);
 470     }
 471 }
 472
 473 @file_emails = uniq(@file_emails);
 474
 475 my %email_hash_name;
 476 my %email_hash_address;
 477 my @email_to = ();
 478 my %hash_list_to;
 479 my @list_to = ();
 480 my @scm = ();
 481 my @web = ();
 482 my @subsystem = ();
 483 my @status = ();
 484 my %deduplicate_name_hash = ();
 485 my %deduplicate_address_hash = ();
 486
 487 my @maintainers = get_maintainers();
 488
 489 if (@maintainers) {
 490     @maintainers = merge_email(@maintainers);
 491     output(@maintainers);
 492 }
 493
 494 if ($scm) {
 495     @scm = uniq(@scm);
 496     output(@scm);
 497 }
 498
 499 if ($status) {
 500     @status = uniq(@status);
 501     output(@status);
 502 }
 503
 504 if ($subsystem) {
 505     @subsystem = uniq(@subsystem);
 506     output(@subsystem);
 507 }
 508
 509 if ($web) {
 510     @web = uniq(@web);
 511     output(@web);
 512 }
 513
 514 exit($exit);
 515
 516 sub range_is_maintained {
 517     my ($start, $end) = @_;
 518
 519     for (my $i = $start; $i < $end; $i++) {
 520         my $line = $typevalue[$i];
 521         if ($line =~ m/^(\C):\s*(.*)/) {
 522             my $type = $1;
 523             my $value = $2;
 524             if ($type eq 'S') {
 525                 if ($value =~ /(maintain|support)/i) {
 526                     return 1;
 527                 }
 528             }
 529         }
 530     }
 531     return 0;
 532 }
 533
 534 sub range_has_maintainer {
 535     my ($start, $end) = @_;
 536
 537     for (my $i = $start; $i < $end; $i++) {
 538         my $line = $typevalue[$i];
 539         if ($line =~ m/^(\C):\s*(.*)/) {
 540             my $type = $1;
 541             my $value = $2;
 542             if ($type eq 'M') {
 543                 return 1;
 544             }
 545         }
 546     }
 547     return 0;
 548 }
 549
 550 sub get_maintainers {
 551     %email_hash_name = ();
 552     %email_hash_address = ();
 553     %commit_author_hash = ();
 554     %commit_signer_hash = ();
 555     @email_to = ();
 556     %hash_list_to = ();
 557     @list_to = ();
 558     @scm = ();
 559     @web = ();
 560     @subsystem = ();
 561     @status = ();
 562     %deduplicate_name_hash = ();
 563     %deduplicate_address_hash = ();
 564     if ($email_git_all_signature_types) {
 565         $signature_pattern = "(.+?)[Bb][Yy]:";
 566     } else {
 567         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 568     }
 569
 570     # Find responsible parties
 571
 572     my %exact_pattern_match_hash = ();
 573
 574     foreach my $file (@files) {
 575
 576         my %hash;
 577         my $tvi = find_first_section();
 578         while ($tvi < @typevalue) {
 579             my $start = find_starting_index($tvi);
 580             my $end = find_ending_index($tvi);
 581             my $exclude = 0;
 582             my $i;
 583
 584             #Do not match excluded file patterns
 585
 586             for ($i = $start; $i < $end; $i++) {
 587                 my $line = $typevalue[$i];
 588                 if ($line =~ m/^(\C):\s*(.*)/) {
 589                     my $type = $1;
 590                     my $value = $2;
 591                     if ($type eq 'X') {
 592                         if (file_match_pattern($file, $value)) {
 593                             $exclude = 1;
 594                             last;
 595                         }
 596                     }
 597                 }
 598             }
 599
 600             if (!$exclude) {
 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 'F') {
 607                             if (file_match_pattern($file, $value)) {
 608                                 my $value_pd = ($value =~ tr@/@@);
 609                                 my $file_pd = ($file  =~ tr@/@@);
 610                                 $value_pd++ if (substr($value,-1,1) ne "/");
 611                                 $value_pd = -1 if ($value =~ /^\.\*/);
 612                                 if ($value_pd >= $file_pd &&
 613                                     range_is_maintained($start, $end) &&
 614                                     range_has_maintainer($start, $end)) {
 615                                     $exact_pattern_match_hash{$file} = 1;
 616                                 }
 617                                 if ($pattern_depth == 0 ||
 618                                     (($file_pd - $value_pd) < $pattern_depth)) {
 619                                     $hash{$tvi} = $value_pd;
 620                                 }
 621                             }
 622                         } elsif ($type eq 'N') {
 623                             if ($file =~ m/$value/x) {
 624                                 $hash{$tvi} = 0;
 625                             }
 626                         }
 627                     }
 628                 }
 629             }
 630             $tvi = $end + 1;
 631         }
 632
 633         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 634             add_categories($line);
 635             if ($sections) {
 636                 my $i;
 637                 my $start = find_starting_index($line);
 638                 my $end = find_ending_index($line);
 639                 for ($i = $start; $i < $end; $i++) {
 640                     my $line = $typevalue[$i];
 641                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 642                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 643                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 644                         $line =~ s/\\\./\./g;           ##Convert \. to .
 645                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 646                     }
 647                     $line =~ s/^([A-Z]):/$1:\t/g;
 648                     print("$line\n");
 649                 }
 650                 print("\n");
 651             }
 652         }
 653     }
 654
 655     if ($keywords) {
 656         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 657         foreach my $line (@keyword_tvi) {
 658             add_categories($line);
 659         }
 660     }
 661
 662     foreach my $email (@email_to, @list_to) {
 663         $email->[0] = deduplicate_email($email->[0]);
 664     }
 665
 666     foreach my $file (@files) {
 667         if ($email &&
 668             ($email_git || ($email_git_fallback &&
 669                             !$exact_pattern_match_hash{$file}))) {
 670             vcs_file_signoffs($file);
 671         }
 672         if ($email && $email_git_blame) {
 673             vcs_file_blame($file);
 674         }
 675     }
 676
 677     if ($email) {
 678         foreach my $chief (@penguin_chief) {
 679             if ($chief =~ m/^(.*):(.*)/) {
 680                 my $email_address;
 681
 682                 $email_address = format_email($1, $2, $email_usename);
 683                 if ($email_git_penguin_chiefs) {
 684                     push(@email_to, [$email_address, 'chief penguin']);
 685                 } else {
 686                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 687                 }
 688             }
 689         }
 690
 691         foreach my $email (@file_emails) {
 692             my ($name, $address) = parse_email($email);
 693
 694             my $tmp_email = format_email($name, $address, $email_usename);
 695             push_email_address($tmp_email, '');
 696             add_role($tmp_email, 'in file');
 697         }
 698     }
 699
 700     my @to = ();
 701     if ($email || $email_list) {
 702         if ($email) {
 703             @to = (@to, @email_to);
 704         }
 705         if ($email_list) {
 706             @to = (@to, @list_to);
 707         }
 708     }
 709
 710     if ($interactive) {
 711         @to = interactive_get_maintainers(\@to);
 712     }
 713
 714     return @to;
 715 }
 716
 717 sub file_match_pattern {
 718     my ($file, $pattern) = @_;
 719     if (substr($pattern, -1) eq "/") {
 720         if ($file =~ m@^$pattern@) {
 721             return 1;
 722         }
 723     } else {
 724         if ($file =~ m@^$pattern@) {
 725             my $s1 = ($file =~ tr@/@@);
 726             my $s2 = ($pattern =~ tr@/@@);
 727             if ($s1 == $s2) {
 728                 return 1;
 729             }
 730         }
 731     }
 732     return 0;
 733 }
 734
 735 sub usage {
 736     print <<EOT;
 737 usage: $P [options] patchfile
 738        $P [options] -f file|directory
 739 version: $V
 740
 741 MAINTAINER field selection options:
 742   --email => print email address(es) if any
 743     --git => include recent git \*-by: signers
 744     --git-all-signature-types => include signers regardless of signature type
 745         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
 746     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
 747     --git-chief-penguins => include ${penguin_chiefs}
 748     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
 749     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
 750     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
 751     --git-blame => use git blame to find modified commits for patch or file
 752     --git-since => git history to use (default: $email_git_since)
 753     --hg-since => hg history to use (default: $email_hg_since)
 754     --interactive => display a menu (mostly useful if used with the --git option)
 755     --m => include maintainer(s) if any
 756     --r => include reviewer(s) if any
 757     --n => include name 'Full Name <addr\@domain.tld>'
 758     --l => include list(s) if any
 759     --s => include subscriber only list(s) if any
 760     --remove-duplicates => minimize duplicate email names/addresses
 761     --roles => show roles (status:subsystem, git-signer, list, etc...)
 762     --rolestats => show roles and statistics (commits/total_commits, %)
 763     --file-emails => add email addresses found in -f file (default: 0 (off))
 764   --scm => print SCM tree(s) if any
 765   --status => print status if any
 766   --subsystem => print subsystem name if any
 767   --web => print website(s) if any
 768
 769 Output type options:
 770   --separator [, ] => separator for multiple entries on 1 line
 771     using --separator also sets --nomultiline if --separator is not [, ]
 772   --multiline => print 1 entry per line
 773
 774 Other options:
 775   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 776   --keywords => scan patch for keywords (default: $keywords)
 777   --sections => print all of the subsystem sections with pattern matches
 778   --mailmap => use .mailmap file (default: $email_use_mailmap)
 779   --version => show version
 780   --help => show this help information
 781
 782 Default options:
 783   [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
 784    --remove-duplicates --rolestats]
 785
 786 Notes:
 787   Using "-f directory" may give unexpected results:
 788       Used with "--git", git signators for _all_ files in and below
 789           directory are examined as git recurses directories.
 790           Any specified X: (exclude) pattern matches are _not_ ignored.
 791       Used with "--nogit", directory is used as a pattern match,
 792           no individual file within the directory or subdirectory
 793           is matched.
 794       Used with "--git-blame", does not iterate all files in directory
 795   Using "--git-blame" is slow and may add old committers and authors
 796       that are no longer active maintainers to the output.
 797   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
 798       other automated tools that expect only ["name"] <email address>
 799       may not work because of additional output after <email address>.
 800   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
 801       not the percentage of the entire file authored.  # of commits is
 802       not a good measure of amount of code authored.  1 major commit may
 803       contain a thousand lines, 5 trivial commits may modify a single line.
 804   If git is not installed, but mercurial (hg) is installed and an .hg
 805       repository exists, the following options apply to mercurial:
 806           --git,
 807           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
 808           --git-blame
 809       Use --hg-since not --git-since to control date selection
 810   File ".get_maintainer.conf", if it exists in the linux kernel source root
 811       directory, can change whatever get_maintainer defaults are desired.
 812       Entries in this file can be any command line argument.
 813       This file is prepended to any additional command line arguments.
 814       Multiple lines and # comments are allowed.
 815 EOT
 816 }
 817
 818 sub top_of_kernel_tree {
 819     my ($lk_path) = @_;
 820
 821     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 822         $lk_path .= "/";
 823     }
 824     if (   (-f "${lk_path}COPYING")
 825         && (-f "${lk_path}CREDITS")
 826         && (-f "${lk_path}Kbuild")
 827         && (-f "${lk_path}MAINTAINERS")
 828         && (-f "${lk_path}Makefile")
 829         && (-f "${lk_path}README")
 830         && (-d "${lk_path}Documentation")
 831         && (-d "${lk_path}arch")
 832         && (-d "${lk_path}include")
 833         && (-d "${lk_path}drivers")
 834         && (-d "${lk_path}fs")
 835         && (-d "${lk_path}init")
 836         && (-d "${lk_path}ipc")
 837         && (-d "${lk_path}kernel")
 838         && (-d "${lk_path}lib")
 839         && (-d "${lk_path}scripts")) {
 840         return 1;
 841     }
 842     return 0;
 843 }
 844
 845 sub parse_email {
 846     my ($formatted_email) = @_;
 847
 848     my $name = "";
 849     my $address = "";
 850
 851     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
 852         $name = $1;
 853         $address = $2;
 854     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
 855         $address = $1;
 856     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
 857         $address = $1;
 858     }
 859
 860     $name =~ s/^\s+|\s+$//g;
 861     $name =~ s/^\"|\"$//g;
 862     $address =~ s/^\s+|\s+$//g;
 863
 864     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 865         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 866         $name = "\"$name\"";
 867     }
 868
 869     return ($name, $address);
 870 }
 871
 872 sub format_email {
 873     my ($name, $address, $usename) = @_;
 874
 875     my $formatted_email;
 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     if ($usename) {
 887         if ("$name" eq "") {
 888             $formatted_email = "$address";
 889         } else {
 890             $formatted_email = "$name <$address>";
 891         }
 892     } else {
 893         $formatted_email = $address;
 894     }
 895
 896     return $formatted_email;
 897 }
 898
 899 sub find_first_section {
 900     my $index = 0;
 901
 902     while ($index < @typevalue) {
 903         my $tv = $typevalue[$index];
 904         if (($tv =~ m/^(\C):\s*(.*)/)) {
 905             last;
 906         }
 907         $index++;
 908     }
 909
 910     return $index;
 911 }
 912
 913 sub find_starting_index {
 914     my ($index) = @_;
 915
 916     while ($index > 0) {
 917         my $tv = $typevalue[$index];
 918         if (!($tv =~ m/^(\C):\s*(.*)/)) {
 919             last;
 920         }
 921         $index--;
 922     }
 923
 924     return $index;
 925 }
 926
 927 sub find_ending_index {
 928     my ($index) = @_;
 929
 930     while ($index < @typevalue) {
 931         my $tv = $typevalue[$index];
 932         if (!($tv =~ m/^(\C):\s*(.*)/)) {
 933             last;
 934         }
 935         $index++;
 936     }
 937
 938     return $index;
 939 }
 940
 941 sub get_maintainer_role {
 942     my ($index) = @_;
 943
 944     my $i;
 945     my $start = find_starting_index($index);
 946     my $end = find_ending_index($index);
 947
 948     my $role = "unknown";
 949     my $subsystem = $typevalue[$start];
 950     if (length($subsystem) > 20) {
 951         $subsystem = substr($subsystem, 0, 17);
 952         $subsystem =~ s/\s*$//;
 953         $subsystem = $subsystem . "...";
 954     }
 955
 956     for ($i = $start + 1; $i < $end; $i++) {
 957         my $tv = $typevalue[$i];
 958         if ($tv =~ m/^(\C):\s*(.*)/) {
 959             my $ptype = $1;
 960             my $pvalue = $2;
 961             if ($ptype eq "S") {
 962                 $role = $pvalue;
 963             }
 964         }
 965     }
 966
 967     $role = lc($role);
 968     if      ($role eq "supported") {
 969         $role = "supporter";
 970     } elsif ($role eq "maintained") {
 971         $role = "maintainer";
 972     } elsif ($role eq "odd fixes") {
 973         $role = "odd fixer";
 974     } elsif ($role eq "orphan") {
 975         $role = "orphan minder";
 976     } elsif ($role eq "obsolete") {
 977         $role = "obsolete minder";
 978     } elsif ($role eq "buried alive in reporters") {
 979         $role = "chief penguin";
 980     }
 981
 982     return $role . ":" . $subsystem;
 983 }
 984
 985 sub get_list_role {
 986     my ($index) = @_;
 987
 988     my $i;
 989     my $start = find_starting_index($index);
 990     my $end = find_ending_index($index);
 991
 992     my $subsystem = $typevalue[$start];
 993     if (length($subsystem) > 20) {
 994         $subsystem = substr($subsystem, 0, 17);
 995         $subsystem =~ s/\s*$//;
 996         $subsystem = $subsystem . "...";
 997     }
 998
 999     if ($subsystem eq "THE REST") {
1000         $subsystem = "";
1001     }
1002
1003     return $subsystem;
1004 }
1005
1006 sub add_categories {
1007     my ($index) = @_;
1008
1009     my $i;
1010     my $start = find_starting_index($index);
1011     my $end = find_ending_index($index);
1012
1013     push(@subsystem, $typevalue[$start]);
1014
1015     for ($i = $start + 1; $i < $end; $i++) {
1016         my $tv = $typevalue[$i];
1017         if ($tv =~ m/^(\C):\s*(.*)/) {
1018             my $ptype = $1;
1019             my $pvalue = $2;
1020             if ($ptype eq "L") {
1021                 my $list_address = $pvalue;
1022                 my $list_additional = "";
1023                 my $list_role = get_list_role($i);
1024
1025                 if ($list_role ne "") {
1026                     $list_role = ":" . $list_role;
1027                 }
1028                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1029                     $list_address = $1;
1030                     $list_additional = $2;
1031                 }
1032                 if ($list_additional =~ m/subscribers-only/) {
1033                     if ($email_subscriber_list) {
1034                         if (!$hash_list_to{lc($list_address)}) {
1035                             $hash_list_to{lc($list_address)} = 1;
1036                             push(@list_to, [$list_address,
1037                                             "subscriber list${list_role}"]);
1038                         }
1039                     }
1040                 } else {
1041                     if ($email_list) {
1042                         if (!$hash_list_to{lc($list_address)}) {
1043                             $hash_list_to{lc($list_address)} = 1;
1044                             if ($list_additional =~ m/moderated/) {
1045                                 push(@list_to, [$list_address,
1046                                                 "moderated list${list_role}"]);
1047                             } else {
1048                                 push(@list_to, [$list_address,
1049                                                 "open list${list_role}"]);
1050                             }
1051                         }
1052                     }
1053                 }
1054             } elsif ($ptype eq "M") {
1055                 my ($name, $address) = parse_email($pvalue);
1056                 if ($name eq "") {
1057                     if ($i > 0) {
1058                         my $tv = $typevalue[$i - 1];
1059                         if ($tv =~ m/^(\C):\s*(.*)/) {
1060                             if ($1 eq "P") {
1061                                 $name = $2;
1062                                 $pvalue = format_email($name, $address, $email_usename);
1063                             }
1064                         }
1065                     }
1066                 }
1067                 if ($email_maintainer) {
1068                     my $role = get_maintainer_role($i);
1069                     push_email_addresses($pvalue, $role);
1070                 }
1071             } elsif ($ptype eq "R") {
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_reviewer) {
1085                     push_email_addresses($pvalue, 'reviewer');
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 }