Linux Audio

Check our new training course

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