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