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