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