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