Linux Audio

Check our new training course

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