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