Linux Audio

Check our new training course

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