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