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