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