Linux Audio

Check our new training course

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