Statistics
| Branch: | Revision:

root / scripts / get_maintainer.pl @ a22f123c

History | View | Annotate | Download (53.5 kB)

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