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