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