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