Linux Audio

Check our new training course

Embedded Linux training

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