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