blob: 81116e215e516f63d92a67a80f4b2c1975913d5f [file] [log] [blame]
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001#!/usr/bin/env perl
Trevor Woernere57c7c52021-06-15 03:30:29 -04002# SPDX-License-Identifier: GPL-2.0
3#
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02004# (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#
10# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
11# perl scripts/get_maintainer.pl [OPTIONS] -f <file>
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020012
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020013use warnings;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020014use strict;
15
16my $P = $0;
17my $V = '0.26';
18
19use Getopt::Long qw(:config no_auto_abbrev);
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020020use Cwd;
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +020021use File::Find;
Trevor Woernere57c7c52021-06-15 03:30:29 -040022use File::Spec::Functions;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020023
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020024my $cur_path = fastgetcwd() . '/';
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020025my $lk_path = "./";
26my $email = 1;
27my $email_usename = 1;
28my $email_maintainer = 1;
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020029my $email_reviewer = 1;
Trevor Woernere57c7c52021-06-15 03:30:29 -040030my $email_fixes = 1;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020031my $email_list = 1;
Trevor Woernere57c7c52021-06-15 03:30:29 -040032my $email_moderated_list = 1;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020033my $email_subscriber_list = 0;
34my $email_git_penguin_chiefs = 0;
35my $email_git = 0;
36my $email_git_all_signature_types = 0;
37my $email_git_blame = 0;
38my $email_git_blame_signatures = 1;
39my $email_git_fallback = 1;
40my $email_git_min_signatures = 1;
41my $email_git_max_maintainers = 5;
42my $email_git_min_percent = 5;
43my $email_git_since = "1-year-ago";
44my $email_hg_since = "-365";
45my $interactive = 0;
46my $email_remove_duplicates = 1;
47my $email_use_mailmap = 1;
48my $output_multiline = 1;
49my $output_separator = ", ";
50my $output_roles = 0;
51my $output_rolestats = 1;
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020052my $output_section_maxlen = 50;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020053my $scm = 0;
Trevor Woernere57c7c52021-06-15 03:30:29 -040054my $tree = 1;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020055my $web = 0;
56my $subsystem = 0;
57my $status = 0;
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +020058my $letters = "";
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020059my $keywords = 1;
60my $sections = 0;
Trevor Woernere57c7c52021-06-15 03:30:29 -040061my $email_file_emails = 0;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020062my $from_filename = 0;
63my $pattern_depth = 0;
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +020064my $self_test = undef;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020065my $version = 0;
66my $help = 0;
Trevor Woernere57c7c52021-06-15 03:30:29 -040067my $find_maintainer_files = 0;
68my $maintainer_path;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020069my $vcs_used = 0;
70
71my $exit = 0;
72
Trevor Woernere57c7c52021-06-15 03:30:29 -040073my @files = ();
74my @fixes = (); # If a patch description includes Fixes: lines
75my @range = ();
76my @keyword_tvi = ();
77my @file_emails = ();
78
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020079my %commit_author_hash;
80my %commit_signer_hash;
81
82my @penguin_chief = ();
Andy Flemingca746f02015-11-04 15:55:27 -060083push(@penguin_chief, "Tom Rini:trini\@konsulko.com");
Daniel Schwierzeck92bca392014-08-01 02:24:09 +020084
85my @penguin_chief_names = ();
86foreach my $chief (@penguin_chief) {
87 if ($chief =~ m/^(.*):(.*)/) {
88 my $chief_name = $1;
89 my $chief_addr = $2;
90 push(@penguin_chief_names, $chief_name);
91 }
92}
93my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
94
95# Signature types of people who are either
96# a) responsible for the code in question, or
97# b) familiar enough with it to give relevant feedback
98my @signature_tags = ();
99push(@signature_tags, "Signed-off-by:");
100push(@signature_tags, "Reviewed-by:");
101push(@signature_tags, "Acked-by:");
102
103my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
104
105# rfc822 email address - preloaded methods go here.
106my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
107my $rfc822_char = '[\\000-\\377]';
108
109# VCS command support: class-like functions and strings
110
111my %VCS_cmds;
112
113my %VCS_cmds_git = (
114 "execute_cmd" => \&git_execute_cmd,
115 "available" => '(which("git") ne "") && (-e ".git")',
116 "find_signers_cmd" =>
117 "git log --no-color --follow --since=\$email_git_since " .
118 '--numstat --no-merges ' .
119 '--format="GitCommit: %H%n' .
120 'GitAuthor: %an <%ae>%n' .
121 'GitDate: %aD%n' .
122 'GitSubject: %s%n' .
123 '%b%n"' .
124 " -- \$file",
125 "find_commit_signers_cmd" =>
126 "git log --no-color " .
127 '--numstat ' .
128 '--format="GitCommit: %H%n' .
129 'GitAuthor: %an <%ae>%n' .
130 'GitDate: %aD%n' .
131 'GitSubject: %s%n' .
132 '%b%n"' .
133 " -1 \$commit",
134 "find_commit_author_cmd" =>
135 "git log --no-color " .
136 '--numstat ' .
137 '--format="GitCommit: %H%n' .
138 'GitAuthor: %an <%ae>%n' .
139 'GitDate: %aD%n' .
140 'GitSubject: %s%n"' .
141 " -1 \$commit",
142 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
143 "blame_file_cmd" => "git blame -l \$file",
144 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
145 "blame_commit_pattern" => "^([0-9a-f]+) ",
146 "author_pattern" => "^GitAuthor: (.*)",
147 "subject_pattern" => "^GitSubject: (.*)",
148 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200149 "file_exists_cmd" => "git ls-files \$file",
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200150 "list_files_cmd" => "git ls-files \$file",
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200151);
152
153my %VCS_cmds_hg = (
154 "execute_cmd" => \&hg_execute_cmd,
155 "available" => '(which("hg") ne "") && (-d ".hg")',
156 "find_signers_cmd" =>
157 "hg log --date=\$email_hg_since " .
158 "--template='HgCommit: {node}\\n" .
159 "HgAuthor: {author}\\n" .
160 "HgSubject: {desc}\\n'" .
161 " -- \$file",
162 "find_commit_signers_cmd" =>
163 "hg log " .
164 "--template='HgSubject: {desc}\\n'" .
165 " -r \$commit",
166 "find_commit_author_cmd" =>
167 "hg log " .
168 "--template='HgCommit: {node}\\n" .
169 "HgAuthor: {author}\\n" .
170 "HgSubject: {desc|firstline}\\n'" .
171 " -r \$commit",
172 "blame_range_cmd" => "", # not supported
173 "blame_file_cmd" => "hg blame -n \$file",
174 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
175 "blame_commit_pattern" => "^([ 0-9a-f]+):",
176 "author_pattern" => "^HgAuthor: (.*)",
177 "subject_pattern" => "^HgSubject: (.*)",
178 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200179 "file_exists_cmd" => "hg files \$file",
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200180 "list_files_cmd" => "hg manifest -R \$file",
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200181);
182
183my $conf = which_conf(".get_maintainer.conf");
184if (-f $conf) {
185 my @conf_args;
186 open(my $conffile, '<', "$conf")
187 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
188
189 while (<$conffile>) {
190 my $line = $_;
191
192 $line =~ s/\s*\n?$//g;
193 $line =~ s/^\s*//g;
194 $line =~ s/\s+/ /g;
195
196 next if ($line =~ m/^\s*#/);
197 next if ($line =~ m/^\s*$/);
198
199 my @words = split(" ", $line);
200 foreach my $word (@words) {
201 last if ($word =~ m/^#/);
202 push (@conf_args, $word);
203 }
204 }
205 close($conffile);
206 unshift(@ARGV, @conf_args) if @conf_args;
207}
208
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200209my @ignore_emails = ();
210my $ignore_file = which_conf(".get_maintainer.ignore");
211if (-f $ignore_file) {
212 open(my $ignore, '<', "$ignore_file")
213 or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
214 while (<$ignore>) {
215 my $line = $_;
216
217 $line =~ s/\s*\n?$//;
218 $line =~ s/^\s*//;
219 $line =~ s/\s+$//;
220 $line =~ s/#.*$//;
221
222 next if ($line =~ m/^\s*$/);
223 if (rfc822_valid($line)) {
224 push(@ignore_emails, $line);
225 }
226 }
227 close($ignore);
228}
229
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200230if ($#ARGV > 0) {
231 foreach (@ARGV) {
232 if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
233 die "$P: using --self-test does not allow any other option or argument\n";
234 }
235 }
236}
237
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200238if (!GetOptions(
239 'email!' => \$email,
240 'git!' => \$email_git,
241 'git-all-signature-types!' => \$email_git_all_signature_types,
242 'git-blame!' => \$email_git_blame,
243 'git-blame-signatures!' => \$email_git_blame_signatures,
244 'git-fallback!' => \$email_git_fallback,
245 'git-chief-penguins!' => \$email_git_penguin_chiefs,
246 'git-min-signatures=i' => \$email_git_min_signatures,
247 'git-max-maintainers=i' => \$email_git_max_maintainers,
248 'git-min-percent=i' => \$email_git_min_percent,
249 'git-since=s' => \$email_git_since,
250 'hg-since=s' => \$email_hg_since,
251 'i|interactive!' => \$interactive,
252 'remove-duplicates!' => \$email_remove_duplicates,
253 'mailmap!' => \$email_use_mailmap,
254 'm!' => \$email_maintainer,
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200255 'r!' => \$email_reviewer,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200256 'n!' => \$email_usename,
257 'l!' => \$email_list,
Trevor Woernere57c7c52021-06-15 03:30:29 -0400258 'fixes!' => \$email_fixes,
259 'moderated!' => \$email_moderated_list,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200260 's!' => \$email_subscriber_list,
261 'multiline!' => \$output_multiline,
262 'roles!' => \$output_roles,
263 'rolestats!' => \$output_rolestats,
264 'separator=s' => \$output_separator,
265 'subsystem!' => \$subsystem,
266 'status!' => \$status,
267 'scm!' => \$scm,
Trevor Woernere57c7c52021-06-15 03:30:29 -0400268 'tree!' => \$tree,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200269 'web!' => \$web,
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200270 'letters=s' => \$letters,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200271 'pattern-depth=i' => \$pattern_depth,
272 'k|keywords!' => \$keywords,
273 'sections!' => \$sections,
Trevor Woernere57c7c52021-06-15 03:30:29 -0400274 'fe|file-emails!' => \$email_file_emails,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200275 'f|file' => \$from_filename,
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200276 'find-maintainer-files' => \$find_maintainer_files,
Trevor Woernere57c7c52021-06-15 03:30:29 -0400277 'mpath|maintainer-path=s' => \$maintainer_path,
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200278 'self-test:s' => \$self_test,
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200279 'v|version' => \$version,
280 'h|help|usage' => \$help,
281 )) {
282 die "$P: invalid argument - use --help if necessary\n";
283}
284
285if ($help != 0) {
286 usage();
287 exit 0;
288}
289
290if ($version != 0) {
291 print("${P} ${V}\n");
292 exit 0;
293}
294
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200295if (defined $self_test) {
296 read_all_maintainer_files();
297 self_test();
298 exit 0;
299}
300
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200301if (-t STDIN && !@ARGV) {
302 # We're talking to a terminal, but have no command line arguments.
303 die "$P: missing patchfile or -f file - use --help if necessary\n";
304}
305
306$output_multiline = 0 if ($output_separator ne ", ");
307$output_rolestats = 1 if ($interactive);
308$output_roles = 1 if ($output_rolestats);
309
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200310if ($sections || $letters ne "") {
311 $sections = 1;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200312 $email = 0;
313 $email_list = 0;
314 $scm = 0;
315 $status = 0;
316 $subsystem = 0;
317 $web = 0;
318 $keywords = 0;
319 $interactive = 0;
320} else {
321 my $selections = $email + $scm + $status + $subsystem + $web;
322 if ($selections == 0) {
323 die "$P: Missing required option: email, scm, status, subsystem or web\n";
324 }
325}
326
327if ($email &&
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200328 ($email_maintainer + $email_reviewer +
329 $email_list + $email_subscriber_list +
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200330 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
331 die "$P: Please select at least 1 email option\n";
332}
333
Trevor Woernere57c7c52021-06-15 03:30:29 -0400334if ($tree && !top_of_kernel_tree($lk_path)) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200335 die "$P: The current directory does not appear to be "
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200336 . "a U-Boot source tree.\n";
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200337}
338
339## Read MAINTAINERS for type/value pairs
340
341my @typevalue = ();
342my %keyword_hash;
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200343my @mfiles = ();
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200344my @self_test_info = ();
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200345
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200346sub read_maintainer_file {
347 my ($file) = @_;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200348
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200349 open (my $maint, '<', "$file")
350 or die "$P: Can't open MAINTAINERS file '$file': $!\n";
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200351 my $i = 1;
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +0200352 while (<$maint>) {
353 my $line = $_;
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200354 chomp $line;
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +0200355
Heiko Schocher35729212016-01-07 13:45:38 +0100356 if ($line =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +0200357 my $type = $1;
358 my $value = $2;
359
360 ##Filename pattern matching
361 if ($type eq "F" || $type eq "X") {
362 $value =~ s@\.@\\\.@g; ##Convert . to \.
363 $value =~ s/\*/\.\*/g; ##Convert * to .*
364 $value =~ s/\?/\./g; ##Convert ? to .
365 ##if pattern is a directory and it lacks a trailing slash, add one
366 if ((-d $value)) {
367 $value =~ s@([^/])$@$1/@;
368 }
369 } elsif ($type eq "K") {
370 $keyword_hash{@typevalue} = $value;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200371 }
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +0200372 push(@typevalue, "$type:$value");
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200373 } elsif (!(/^\s*$/ || /^\s*\#/)) {
Daniel Schwierzeck68dc8762014-08-01 02:24:11 +0200374 push(@typevalue, $line);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200375 }
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200376 if (defined $self_test) {
377 push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
378 }
379 $i++;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200380 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200381 close($maint);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200382}
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200383
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200384sub find_is_maintainer_file {
385 my ($file) = $_;
386 return if ($file !~ m@/MAINTAINERS$@);
387 $file = $File::Find::name;
388 return if (! -f $file);
389 push(@mfiles, $file);
390}
391
392sub find_ignore_git {
393 return grep { $_ !~ /^\.git$/; } @_;
394}
395
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200396read_all_maintainer_files();
397
398sub read_all_maintainer_files {
Trevor Woernere57c7c52021-06-15 03:30:29 -0400399 my $path = "${lk_path}MAINTAINERS";
400 if (defined $maintainer_path) {
401 $path = $maintainer_path;
402 # Perl Cookbook tilde expansion if necessary
403 $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200404 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200405
Trevor Woernere57c7c52021-06-15 03:30:29 -0400406 if (-d $path) {
407 $path .= '/' if ($path !~ m@/$@);
408 if ($find_maintainer_files) {
409 find( { wanted => \&find_is_maintainer_file,
410 preprocess => \&find_ignore_git,
411 no_chdir => 1,
412 }, "$path");
413 } else {
414 opendir(DIR, "$path") or die $!;
415 my @files = readdir(DIR);
416 closedir(DIR);
417 foreach my $file (@files) {
418 push(@mfiles, "$path$file") if ($file !~ /^\./);
419 }
420 }
421 } elsif (-f "$path") {
422 push(@mfiles, "$path");
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200423 } else {
Trevor Woernere57c7c52021-06-15 03:30:29 -0400424 die "$P: MAINTAINER file not found '$path'\n";
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200425 }
Trevor Woernere57c7c52021-06-15 03:30:29 -0400426 die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200427 foreach my $file (@mfiles) {
Trevor Woernere57c7c52021-06-15 03:30:29 -0400428 read_maintainer_file("$file");
429 }
430}
431
432sub maintainers_in_file {
433 my ($file) = @_;
434
435 return if ($file =~ m@\bMAINTAINERS$@);
436
437 if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) {
438 open(my $f, '<', $file)
439 or die "$P: Can't open $file: $!\n";
440 my $text = do { local($/) ; <$f> };
441 close($f);
442
443 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;
444 push(@file_emails, clean_file_emails(@poss_addr));
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200445 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200446}
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200447
448#
449# Read mail address map
450#
451
452my $mailmap;
453
454read_mailmap();
455
456sub read_mailmap {
457 $mailmap = {
458 names => {},
459 addresses => {}
460 };
461
462 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
463
464 open(my $mailmap_file, '<', "${lk_path}.mailmap")
465 or warn "$P: Can't open .mailmap: $!\n";
466
467 while (<$mailmap_file>) {
468 s/#.*$//; #strip comments
469 s/^\s+|\s+$//g; #trim
470
471 next if (/^\s*$/); #skip empty lines
472 #entries have one of the following formats:
473 # name1 <mail1>
474 # <mail1> <mail2>
475 # name1 <mail1> <mail2>
476 # name1 <mail1> name2 <mail2>
477 # (see man git-shortlog)
478
479 if (/^([^<]+)<([^>]+)>$/) {
480 my $real_name = $1;
481 my $address = $2;
482
483 $real_name =~ s/\s+$//;
484 ($real_name, $address) = parse_email("$real_name <$address>");
485 $mailmap->{names}->{$address} = $real_name;
486
487 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
488 my $real_address = $1;
489 my $wrong_address = $2;
490
491 $mailmap->{addresses}->{$wrong_address} = $real_address;
492
493 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
494 my $real_name = $1;
495 my $real_address = $2;
496 my $wrong_address = $3;
497
498 $real_name =~ s/\s+$//;
499 ($real_name, $real_address) =
500 parse_email("$real_name <$real_address>");
501 $mailmap->{names}->{$wrong_address} = $real_name;
502 $mailmap->{addresses}->{$wrong_address} = $real_address;
503
504 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
505 my $real_name = $1;
506 my $real_address = $2;
507 my $wrong_name = $3;
508 my $wrong_address = $4;
509
510 $real_name =~ s/\s+$//;
511 ($real_name, $real_address) =
512 parse_email("$real_name <$real_address>");
513
514 $wrong_name =~ s/\s+$//;
515 ($wrong_name, $wrong_address) =
516 parse_email("$wrong_name <$wrong_address>");
517
518 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
519 $mailmap->{names}->{$wrong_email} = $real_name;
520 $mailmap->{addresses}->{$wrong_email} = $real_address;
521 }
522 }
523 close($mailmap_file);
524}
525
526## use the filenames on the command line or find the filenames in the patchfiles
527
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200528if (!@ARGV) {
529 push(@ARGV, "&STDIN");
530}
531
532foreach my $file (@ARGV) {
533 if ($file ne "&STDIN") {
Trevor Woernere57c7c52021-06-15 03:30:29 -0400534 $file = canonpath($file);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200535 ##if $file is a directory and it lacks a trailing slash, add one
536 if ((-d $file)) {
537 $file =~ s@([^/])$@$1/@;
538 } elsif (!(-f $file)) {
539 die "$P: file '${file}' not found\n";
540 }
541 }
Trevor Woernere57c7c52021-06-15 03:30:29 -0400542 if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) {
543 warn "$P: file '$file' not found in version control $!\n";
544 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200545 if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
546 $file =~ s/^\Q${cur_path}\E//; #strip any absolute path
547 $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200548 push(@files, $file);
Trevor Woernere57c7c52021-06-15 03:30:29 -0400549 if ($file ne "MAINTAINERS" && -f $file && $keywords) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200550 open(my $f, '<', $file)
551 or die "$P: Can't open $file: $!\n";
552 my $text = do { local($/) ; <$f> };
553 close($f);
554 if ($keywords) {
555 foreach my $line (keys %keyword_hash) {
556 if ($text =~ m/$keyword_hash{$line}/x) {
557 push(@keyword_tvi, $line);
558 }
559 }
560 }
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200561 }
562 } else {
563 my $file_cnt = @files;
564 my $lastfile;
565
566 open(my $patch, "< $file")
567 or die "$P: Can't open $file: $!\n";
568
569 # We can check arbitrary information before the patch
570 # like the commit message, mail headers, etc...
571 # This allows us to match arbitrary keywords against any part
572 # of a git format-patch generated file (subject tags, etc...)
573
574 my $patch_prefix = ""; #Parsing the intro
575
576 while (<$patch>) {
577 my $patch_line = $_;
Trevor Woernere57c7c52021-06-15 03:30:29 -0400578 if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
579 my $filename = $1;
580 push(@files, $filename);
581 } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
582 my $filename = $1;
583 push(@files, $filename);
584 } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
585 my $filename1 = $1;
586 my $filename2 = $2;
587 push(@files, $filename1);
588 push(@files, $filename2);
589 } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) {
590 push(@fixes, $1) if ($email_fixes);
591 } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200592 my $filename = $1;
593 $filename =~ s@^[^/]*/@@;
594 $filename =~ s@\n@@;
595 $lastfile = $filename;
596 push(@files, $filename);
597 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
598 } elsif (m/^\@\@ -(\d+),(\d+)/) {
599 if ($email_git_blame) {
600 push(@range, "$lastfile:$1:$2");
601 }
602 } elsif ($keywords) {
603 foreach my $line (keys %keyword_hash) {
604 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
605 push(@keyword_tvi, $line);
606 }
607 }
608 }
609 }
610 close($patch);
611
612 if ($file_cnt == @files) {
613 warn "$P: file '${file}' doesn't appear to be a patch. "
614 . "Add -f to options?\n";
615 }
616 @files = sort_and_uniq(@files);
617 }
618}
619
620@file_emails = uniq(@file_emails);
Trevor Woernere57c7c52021-06-15 03:30:29 -0400621@fixes = uniq(@fixes);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200622
623my %email_hash_name;
624my %email_hash_address;
625my @email_to = ();
626my %hash_list_to;
627my @list_to = ();
628my @scm = ();
629my @web = ();
630my @subsystem = ();
631my @status = ();
632my %deduplicate_name_hash = ();
633my %deduplicate_address_hash = ();
634
635my @maintainers = get_maintainers();
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200636if (@maintainers) {
637 @maintainers = merge_email(@maintainers);
638 output(@maintainers);
639}
640
641if ($scm) {
642 @scm = uniq(@scm);
643 output(@scm);
644}
645
646if ($status) {
647 @status = uniq(@status);
648 output(@status);
649}
650
651if ($subsystem) {
652 @subsystem = uniq(@subsystem);
653 output(@subsystem);
654}
655
656if ($web) {
657 @web = uniq(@web);
658 output(@web);
659}
660
661exit($exit);
662
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +0200663sub self_test {
664 my @lsfiles = ();
665 my @good_links = ();
666 my @bad_links = ();
667 my @section_headers = ();
668 my $index = 0;
669
670 @lsfiles = vcs_list_files($lk_path);
671
672 for my $x (@self_test_info) {
673 $index++;
674
675 ## Section header duplication and missing section content
676 if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
677 $x->{line} =~ /^\S[^:]/ &&
678 defined $self_test_info[$index] &&
679 $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
680 my $has_S = 0;
681 my $has_F = 0;
682 my $has_ML = 0;
683 my $status = "";
684 if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
685 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
686 } else {
687 push(@section_headers, $x->{line});
688 }
689 my $nextline = $index;
690 while (defined $self_test_info[$nextline] &&
691 $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
692 my $type = $1;
693 my $value = $2;
694 if ($type eq "S") {
695 $has_S = 1;
696 $status = $value;
697 } elsif ($type eq "F" || $type eq "N") {
698 $has_F = 1;
699 } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
700 $has_ML = 1;
701 }
702 $nextline++;
703 }
704 if (!$has_ML && $status !~ /orphan|obsolete/i) {
705 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
706 }
707 if (!$has_S) {
708 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
709 }
710 if (!$has_F) {
711 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
712 }
713 }
714
715 next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
716
717 my $type = $1;
718 my $value = $2;
719
720 ## Filename pattern matching
721 if (($type eq "F" || $type eq "X") &&
722 ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
723 $value =~ s@\.@\\\.@g; ##Convert . to \.
724 $value =~ s/\*/\.\*/g; ##Convert * to .*
725 $value =~ s/\?/\./g; ##Convert ? to .
726 ##if pattern is a directory and it lacks a trailing slash, add one
727 if ((-d $value)) {
728 $value =~ s@([^/])$@$1/@;
729 }
730 if (!grep(m@^$value@, @lsfiles)) {
731 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
732 }
733
734 ## Link reachability
735 } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
736 $value =~ /^https?:/ &&
737 ($self_test eq "" || $self_test =~ /\blinks\b/)) {
738 next if (grep(m@^\Q$value\E$@, @good_links));
739 my $isbad = 0;
740 if (grep(m@^\Q$value\E$@, @bad_links)) {
741 $isbad = 1;
742 } else {
743 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
744 if ($? == 0) {
745 push(@good_links, $value);
746 } else {
747 push(@bad_links, $value);
748 $isbad = 1;
749 }
750 }
751 if ($isbad) {
752 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
753 }
754
755 ## SCM reachability
756 } elsif ($type eq "T" &&
757 ($self_test eq "" || $self_test =~ /\bscm\b/)) {
758 next if (grep(m@^\Q$value\E$@, @good_links));
759 my $isbad = 0;
760 if (grep(m@^\Q$value\E$@, @bad_links)) {
761 $isbad = 1;
762 } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
763 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
764 } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
765 my $url = $1;
766 my $branch = "";
767 $branch = $3 if $3;
768 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
769 if ($? == 0) {
770 push(@good_links, $value);
771 } else {
772 push(@bad_links, $value);
773 $isbad = 1;
774 }
775 } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
776 my $url = $1;
777 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
778 if ($? == 0) {
779 push(@good_links, $value);
780 } else {
781 push(@bad_links, $value);
782 $isbad = 1;
783 }
784 }
785 if ($isbad) {
786 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
787 }
788 }
789 }
790}
791
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200792sub ignore_email_address {
793 my ($address) = @_;
794
795 foreach my $ignore (@ignore_emails) {
796 return 1 if ($ignore eq $address);
797 }
798
799 return 0;
800}
801
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200802sub range_is_maintained {
803 my ($start, $end) = @_;
804
805 for (my $i = $start; $i < $end; $i++) {
806 my $line = $typevalue[$i];
Heiko Schocher35729212016-01-07 13:45:38 +0100807 if ($line =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200808 my $type = $1;
809 my $value = $2;
810 if ($type eq 'S') {
811 if ($value =~ /(maintain|support)/i) {
812 return 1;
813 }
814 }
815 }
816 }
817 return 0;
818}
819
820sub range_has_maintainer {
821 my ($start, $end) = @_;
822
823 for (my $i = $start; $i < $end; $i++) {
824 my $line = $typevalue[$i];
Heiko Schocher35729212016-01-07 13:45:38 +0100825 if ($line =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200826 my $type = $1;
827 my $value = $2;
828 if ($type eq 'M') {
829 return 1;
830 }
831 }
832 }
833 return 0;
834}
835
836sub get_maintainers {
837 %email_hash_name = ();
838 %email_hash_address = ();
839 %commit_author_hash = ();
840 %commit_signer_hash = ();
841 @email_to = ();
842 %hash_list_to = ();
843 @list_to = ();
844 @scm = ();
845 @web = ();
846 @subsystem = ();
847 @status = ();
848 %deduplicate_name_hash = ();
849 %deduplicate_address_hash = ();
850 if ($email_git_all_signature_types) {
851 $signature_pattern = "(.+?)[Bb][Yy]:";
852 } else {
853 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
854 }
855
856 # Find responsible parties
857
858 my %exact_pattern_match_hash = ();
859
860 foreach my $file (@files) {
861
862 my %hash;
863 my $tvi = find_first_section();
864 while ($tvi < @typevalue) {
865 my $start = find_starting_index($tvi);
866 my $end = find_ending_index($tvi);
867 my $exclude = 0;
868 my $i;
869
870 #Do not match excluded file patterns
871
872 for ($i = $start; $i < $end; $i++) {
873 my $line = $typevalue[$i];
Heiko Schocher35729212016-01-07 13:45:38 +0100874 if ($line =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200875 my $type = $1;
876 my $value = $2;
877 if ($type eq 'X') {
878 if (file_match_pattern($file, $value)) {
879 $exclude = 1;
880 last;
881 }
882 }
883 }
884 }
885
886 if (!$exclude) {
887 for ($i = $start; $i < $end; $i++) {
888 my $line = $typevalue[$i];
Heiko Schocher35729212016-01-07 13:45:38 +0100889 if ($line =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200890 my $type = $1;
891 my $value = $2;
892 if ($type eq 'F') {
893 if (file_match_pattern($file, $value)) {
894 my $value_pd = ($value =~ tr@/@@);
895 my $file_pd = ($file =~ tr@/@@);
896 $value_pd++ if (substr($value,-1,1) ne "/");
897 $value_pd = -1 if ($value =~ /^\.\*/);
898 if ($value_pd >= $file_pd &&
899 range_is_maintained($start, $end) &&
900 range_has_maintainer($start, $end)) {
901 $exact_pattern_match_hash{$file} = 1;
902 }
903 if ($pattern_depth == 0 ||
904 (($file_pd - $value_pd) < $pattern_depth)) {
905 $hash{$tvi} = $value_pd;
906 }
907 }
908 } elsif ($type eq 'N') {
909 if ($file =~ m/$value/x) {
910 $hash{$tvi} = 0;
911 }
912 }
913 }
914 }
915 }
916 $tvi = $end + 1;
917 }
918
919 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
920 add_categories($line);
921 if ($sections) {
922 my $i;
923 my $start = find_starting_index($line);
924 my $end = find_ending_index($line);
925 for ($i = $start; $i < $end; $i++) {
926 my $line = $typevalue[$i];
927 if ($line =~ /^[FX]:/) { ##Restore file patterns
928 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
929 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
930 $line =~ s/\\\./\./g; ##Convert \. to .
931 $line =~ s/\.\*/\*/g; ##Convert .* to *
932 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +0200933 my $count = $line =~ s/^([A-Z]):/$1:\t/g;
934 if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
935 print("$line\n");
936 }
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200937 }
938 print("\n");
939 }
940 }
Trevor Woernere57c7c52021-06-15 03:30:29 -0400941
942 maintainers_in_file($file);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200943 }
944
945 if ($keywords) {
946 @keyword_tvi = sort_and_uniq(@keyword_tvi);
947 foreach my $line (@keyword_tvi) {
948 add_categories($line);
949 }
950 }
951
952 foreach my $email (@email_to, @list_to) {
953 $email->[0] = deduplicate_email($email->[0]);
954 }
955
956 foreach my $file (@files) {
957 if ($email &&
Trevor Woernere57c7c52021-06-15 03:30:29 -0400958 ($email_git ||
959 ($email_git_fallback &&
960 $file !~ /MAINTAINERS$/ &&
961 !$exact_pattern_match_hash{$file}))) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200962 vcs_file_signoffs($file);
963 }
964 if ($email && $email_git_blame) {
965 vcs_file_blame($file);
966 }
967 }
968
969 if ($email) {
970 foreach my $chief (@penguin_chief) {
971 if ($chief =~ m/^(.*):(.*)/) {
972 my $email_address;
973
974 $email_address = format_email($1, $2, $email_usename);
975 if ($email_git_penguin_chiefs) {
976 push(@email_to, [$email_address, 'chief penguin']);
977 } else {
978 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
979 }
980 }
981 }
982
983 foreach my $email (@file_emails) {
984 my ($name, $address) = parse_email($email);
985
986 my $tmp_email = format_email($name, $address, $email_usename);
987 push_email_address($tmp_email, '');
988 add_role($tmp_email, 'in file');
989 }
990 }
991
Trevor Woernere57c7c52021-06-15 03:30:29 -0400992 foreach my $fix (@fixes) {
993 vcs_add_commit_signers($fix, "blamed_fixes");
994 }
995
Daniel Schwierzeck92bca392014-08-01 02:24:09 +0200996 my @to = ();
997 if ($email || $email_list) {
998 if ($email) {
999 @to = (@to, @email_to);
1000 }
1001 if ($email_list) {
1002 @to = (@to, @list_to);
1003 }
1004 }
1005
1006 if ($interactive) {
1007 @to = interactive_get_maintainers(\@to);
1008 }
1009
1010 return @to;
1011}
1012
1013sub file_match_pattern {
1014 my ($file, $pattern) = @_;
1015 if (substr($pattern, -1) eq "/") {
1016 if ($file =~ m@^$pattern@) {
1017 return 1;
1018 }
1019 } else {
1020 if ($file =~ m@^$pattern@) {
1021 my $s1 = ($file =~ tr@/@@);
1022 my $s2 = ($pattern =~ tr@/@@);
1023 if ($s1 == $s2) {
1024 return 1;
1025 }
1026 }
1027 }
1028 return 0;
1029}
1030
1031sub usage {
1032 print <<EOT;
1033usage: $P [options] patchfile
1034 $P [options] -f file|directory
1035version: $V
1036
1037MAINTAINER field selection options:
1038 --email => print email address(es) if any
1039 --git => include recent git \*-by: signers
1040 --git-all-signature-types => include signers regardless of signature type
1041 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1042 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1043 --git-chief-penguins => include ${penguin_chiefs}
1044 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1045 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1046 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1047 --git-blame => use git blame to find modified commits for patch or file
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001048 --git-blame-signatures => when used with --git-blame, also include all commit signers
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001049 --git-since => git history to use (default: $email_git_since)
1050 --hg-since => hg history to use (default: $email_hg_since)
1051 --interactive => display a menu (mostly useful if used with the --git option)
1052 --m => include maintainer(s) if any
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001053 --r => include reviewer(s) if any
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001054 --n => include name 'Full Name <addr\@domain.tld>'
1055 --l => include list(s) if any
Trevor Woernere57c7c52021-06-15 03:30:29 -04001056 --moderated => include moderated lists(s) if any (default: true)
1057 --s => include subscriber only list(s) if any (default: false)
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001058 --remove-duplicates => minimize duplicate email names/addresses
1059 --roles => show roles (status:subsystem, git-signer, list, etc...)
1060 --rolestats => show roles and statistics (commits/total_commits, %)
1061 --file-emails => add email addresses found in -f file (default: 0 (off))
Trevor Woernere57c7c52021-06-15 03:30:29 -04001062 --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on))
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001063 --scm => print SCM tree(s) if any
1064 --status => print status if any
1065 --subsystem => print subsystem name if any
1066 --web => print website(s) if any
1067
1068Output type options:
1069 --separator [, ] => separator for multiple entries on 1 line
1070 using --separator also sets --nomultiline if --separator is not [, ]
1071 --multiline => print 1 entry per line
1072
1073Other options:
1074 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1075 --keywords => scan patch for keywords (default: $keywords)
1076 --sections => print all of the subsystem sections with pattern matches
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001077 --letters => print all matching 'letter' types from all matching sections
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001078 --mailmap => use .mailmap file (default: $email_use_mailmap)
Trevor Woernere57c7c52021-06-15 03:30:29 -04001079 --no-tree => run without a kernel tree
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +02001080 --self-test => show potential issues with MAINTAINERS file content
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001081 --version => show version
1082 --help => show this help information
1083
1084Default options:
Trevor Woernere57c7c52021-06-15 03:30:29 -04001085 [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1086 --pattern-depth=0 --remove-duplicates --rolestats]
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001087
1088Notes:
1089 Using "-f directory" may give unexpected results:
1090 Used with "--git", git signators for _all_ files in and below
1091 directory are examined as git recurses directories.
1092 Any specified X: (exclude) pattern matches are _not_ ignored.
1093 Used with "--nogit", directory is used as a pattern match,
1094 no individual file within the directory or subdirectory
1095 is matched.
1096 Used with "--git-blame", does not iterate all files in directory
1097 Using "--git-blame" is slow and may add old committers and authors
1098 that are no longer active maintainers to the output.
1099 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1100 other automated tools that expect only ["name"] <email address>
1101 may not work because of additional output after <email address>.
1102 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1103 not the percentage of the entire file authored. # of commits is
1104 not a good measure of amount of code authored. 1 major commit may
1105 contain a thousand lines, 5 trivial commits may modify a single line.
1106 If git is not installed, but mercurial (hg) is installed and an .hg
1107 repository exists, the following options apply to mercurial:
1108 --git,
1109 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1110 --git-blame
1111 Use --hg-since not --git-since to control date selection
1112 File ".get_maintainer.conf", if it exists in the linux kernel source root
1113 directory, can change whatever get_maintainer defaults are desired.
1114 Entries in this file can be any command line argument.
1115 This file is prepended to any additional command line arguments.
1116 Multiple lines and # comments are allowed.
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001117 Most options have both positive and negative forms.
1118 The negative forms for --<foo> are --no<foo> and --no-<foo>.
1119
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001120EOT
1121}
1122
1123sub top_of_kernel_tree {
1124 my ($lk_path) = @_;
1125
1126 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1127 $lk_path .= "/";
1128 }
Daniel Schwierzeck27e77182014-11-16 20:30:11 +01001129 if ( (-f "${lk_path}Kbuild")
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001130 && (-e "${lk_path}MAINTAINERS")
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001131 && (-f "${lk_path}Makefile")
1132 && (-f "${lk_path}README")
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001133 && (-d "${lk_path}arch")
Daniel Schwierzeckee360cd2014-08-01 02:24:10 +02001134 && (-d "${lk_path}board")
1135 && (-d "${lk_path}common")
1136 && (-d "${lk_path}doc")
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001137 && (-d "${lk_path}drivers")
Daniel Schwierzeckee360cd2014-08-01 02:24:10 +02001138 && (-d "${lk_path}dts")
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001139 && (-d "${lk_path}fs")
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001140 && (-d "${lk_path}lib")
Daniel Schwierzeckee360cd2014-08-01 02:24:10 +02001141 && (-d "${lk_path}include")
1142 && (-d "${lk_path}net")
1143 && (-d "${lk_path}post")
1144 && (-d "${lk_path}scripts")
1145 && (-d "${lk_path}test")
1146 && (-d "${lk_path}tools")) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001147 return 1;
1148 }
1149 return 0;
1150}
1151
1152sub parse_email {
1153 my ($formatted_email) = @_;
1154
1155 my $name = "";
1156 my $address = "";
1157
1158 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
1159 $name = $1;
1160 $address = $2;
1161 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
1162 $address = $1;
1163 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
1164 $address = $1;
1165 }
1166
1167 $name =~ s/^\s+|\s+$//g;
1168 $name =~ s/^\"|\"$//g;
1169 $address =~ s/^\s+|\s+$//g;
1170
1171 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
1172 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
1173 $name = "\"$name\"";
1174 }
1175
1176 return ($name, $address);
1177}
1178
1179sub format_email {
1180 my ($name, $address, $usename) = @_;
1181
1182 my $formatted_email;
1183
1184 $name =~ s/^\s+|\s+$//g;
1185 $name =~ s/^\"|\"$//g;
1186 $address =~ s/^\s+|\s+$//g;
1187
1188 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
1189 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
1190 $name = "\"$name\"";
1191 }
1192
1193 if ($usename) {
1194 if ("$name" eq "") {
1195 $formatted_email = "$address";
1196 } else {
1197 $formatted_email = "$name <$address>";
1198 }
1199 } else {
1200 $formatted_email = $address;
1201 }
1202
1203 return $formatted_email;
1204}
1205
1206sub find_first_section {
1207 my $index = 0;
1208
1209 while ($index < @typevalue) {
1210 my $tv = $typevalue[$index];
Heiko Schocher35729212016-01-07 13:45:38 +01001211 if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001212 last;
1213 }
1214 $index++;
1215 }
1216
1217 return $index;
1218}
1219
1220sub find_starting_index {
1221 my ($index) = @_;
1222
1223 while ($index > 0) {
1224 my $tv = $typevalue[$index];
Heiko Schocher35729212016-01-07 13:45:38 +01001225 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001226 last;
1227 }
1228 $index--;
1229 }
1230
1231 return $index;
1232}
1233
1234sub find_ending_index {
1235 my ($index) = @_;
1236
1237 while ($index < @typevalue) {
1238 my $tv = $typevalue[$index];
Heiko Schocher35729212016-01-07 13:45:38 +01001239 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001240 last;
1241 }
1242 $index++;
1243 }
1244
1245 return $index;
1246}
1247
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001248sub get_subsystem_name {
1249 my ($index) = @_;
1250
1251 my $start = find_starting_index($index);
1252
1253 my $subsystem = $typevalue[$start];
1254 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1255 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1256 $subsystem =~ s/\s*$//;
1257 $subsystem = $subsystem . "...";
1258 }
1259 return $subsystem;
1260}
1261
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001262sub 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";
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001270 my $subsystem = get_subsystem_name($index);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001271
1272 for ($i = $start + 1; $i < $end; $i++) {
1273 my $tv = $typevalue[$i];
Heiko Schocher35729212016-01-07 13:45:38 +01001274 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001275 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
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001304 my $subsystem = get_subsystem_name($index);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001305
1306 if ($subsystem eq "THE REST") {
1307 $subsystem = "";
1308 }
1309
1310 return $subsystem;
1311}
1312
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];
Heiko Schocher35729212016-01-07 13:45:38 +01001324 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001325 my $ptype = $1;
1326 my $pvalue = $2;
1327 if ($ptype eq "L") {
1328 my $list_address = $pvalue;
1329 my $list_additional = "";
1330 my $list_role = get_list_role($i);
1331
1332 if ($list_role ne "") {
1333 $list_role = ":" . $list_role;
1334 }
1335 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1336 $list_address = $1;
1337 $list_additional = $2;
1338 }
1339 if ($list_additional =~ m/subscribers-only/) {
1340 if ($email_subscriber_list) {
1341 if (!$hash_list_to{lc($list_address)}) {
1342 $hash_list_to{lc($list_address)} = 1;
1343 push(@list_to, [$list_address,
1344 "subscriber list${list_role}"]);
1345 }
1346 }
1347 } else {
1348 if ($email_list) {
1349 if (!$hash_list_to{lc($list_address)}) {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001350 if ($list_additional =~ m/moderated/) {
Trevor Woernere57c7c52021-06-15 03:30:29 -04001351 if ($email_moderated_list) {
1352 $hash_list_to{lc($list_address)} = 1;
1353 push(@list_to, [$list_address,
1354 "moderated list${list_role}"]);
1355 }
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001356 } else {
Trevor Woernere57c7c52021-06-15 03:30:29 -04001357 $hash_list_to{lc($list_address)} = 1;
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001358 push(@list_to, [$list_address,
1359 "open list${list_role}"]);
1360 }
1361 }
1362 }
1363 }
1364 } elsif ($ptype eq "M") {
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001365 if ($email_maintainer) {
1366 my $role = get_maintainer_role($i);
1367 push_email_addresses($pvalue, $role);
1368 }
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001369 } elsif ($ptype eq "R") {
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02001370 if ($email_reviewer) {
1371 my $subsystem = get_subsystem_name($i);
1372 push_email_addresses($pvalue, "reviewer:$subsystem");
1373 }
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001374 } 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 }
1381 }
1382 }
1383}
1384
1385sub email_inuse {
1386 my ($name, $address) = @_;
1387
1388 return 1 if (($name eq "") && ($address eq ""));
1389 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1390 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1391
1392 return 0;
1393}
1394
1395sub push_email_address {
1396 my ($line, $role) = @_;
1397
1398 my ($name, $address) = parse_email($line);
1399
1400 if ($address eq "") {
1401 return 0;
1402 }
1403
1404 if (!$email_remove_duplicates) {
1405 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1406 } elsif (!email_inuse($name, $address)) {
1407 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1408 $email_hash_name{lc($name)}++ if ($name ne "");
1409 $email_hash_address{lc($address)}++;
1410 }
1411
1412 return 1;
1413}
1414
1415sub push_email_addresses {
1416 my ($address, $role) = @_;
1417
1418 my @address_list = ();
1419
1420 if (rfc822_valid($address)) {
1421 push_email_address($address, $role);
1422 } elsif (@address_list = rfc822_validlist($address)) {
1423 my $array_count = shift(@address_list);
1424 while (my $entry = shift(@address_list)) {
1425 push_email_address($entry, $role);
1426 }
1427 } else {
1428 if (!push_email_address($address, $role)) {
1429 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1430 }
1431 }
1432}
1433
1434sub add_role {
1435 my ($line, $role) = @_;
1436
1437 my ($name, $address) = parse_email($line);
1438 my $email = format_email($name, $address, $email_usename);
1439
1440 foreach my $entry (@email_to) {
1441 if ($email_remove_duplicates) {
1442 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1443 if (($name eq $entry_name || $address eq $entry_address)
1444 && ($role eq "" || !($entry->[1] =~ m/$role/))
1445 ) {
1446 if ($entry->[1] eq "") {
1447 $entry->[1] = "$role";
1448 } else {
1449 $entry->[1] = "$entry->[1],$role";
1450 }
1451 }
1452 } else {
1453 if ($email eq $entry->[0]
1454 && ($role eq "" || !($entry->[1] =~ m/$role/))
1455 ) {
1456 if ($entry->[1] eq "") {
1457 $entry->[1] = "$role";
1458 } else {
1459 $entry->[1] = "$entry->[1],$role";
1460 }
1461 }
1462 }
1463 }
1464}
1465
1466sub which {
1467 my ($bin) = @_;
1468
1469 foreach my $path (split(/:/, $ENV{PATH})) {
1470 if (-e "$path/$bin") {
1471 return "$path/$bin";
1472 }
1473 }
1474
1475 return "";
1476}
1477
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
1490sub mailmap_email {
1491 my ($line) = @_;
1492
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};
1512 }
1513 }
1514 return format_email($real_name, $real_address, 1);
1515}
1516
1517sub mailmap {
1518 my (@addresses) = @_;
1519
1520 my @mapped_emails = ();
1521 foreach my $line (@addresses) {
1522 push(@mapped_emails, mailmap_email($line));
1523 }
1524 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1525 return @mapped_emails;
1526}
1527
1528sub merge_by_realname {
1529 my %address_map;
1530 my (@emails) = @_;
1531
1532 foreach my $email (@emails) {
1533 my ($name, $address) = parse_email($email);
1534 if (exists $address_map{$name}) {
1535 $address = $address_map{$name};
1536 $email = format_email($name, $address, 1);
1537 } else {
1538 $address_map{$name} = $address;
1539 }
1540 }
1541}
1542
1543sub git_execute_cmd {
1544 my ($cmd) = @_;
1545 my @lines = ();
1546
1547 my $output = `$cmd`;
1548 $output =~ s/^\s*//gm;
1549 @lines = split("\n", $output);
1550
1551 return @lines;
1552}
1553
1554sub hg_execute_cmd {
1555 my ($cmd) = @_;
1556 my @lines = ();
1557
1558 my $output = `$cmd`;
1559 @lines = split("\n", $output);
1560
1561 return @lines;
1562}
1563
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) {
1577 $signer = deduplicate_email($signer);
1578 }
1579
1580 return (\@type, \@signature_lines);
1581}
1582
1583sub vcs_find_signers {
1584 my ($cmd, $file) = @_;
1585 my $commits;
1586 my @lines = ();
1587 my @signatures = ();
1588 my @authors = ();
1589 my @stats = ();
1590
1591 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1592
1593 my $pattern = $VCS_cmds{"commit_pattern"};
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
1598
1599 $commits = grep(/$pattern/, @lines); # of commits
1600
1601 @authors = grep(/$author_pattern/, @lines);
1602 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1603 @stats = grep(/$stat_pattern/, @lines);
1604
1605# print("stats: <@stats>\n");
1606
1607 return (0, \@signatures, \@authors, \@stats) if !@signatures;
1608
1609 save_commits_by_author(@lines) if ($interactive);
1610 save_commits_by_signer(@lines) if ($interactive);
1611
1612 if (!$email_git_penguin_chiefs) {
1613 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1614 }
1615
1616 my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1617 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1618
1619 return ($commits, $signers_ref, $authors_ref, \@stats);
1620}
1621
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
1634 my @authors = ();
1635 foreach my $line (@lines) {
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 }
1642 }
1643
1644 save_commits_by_author(@lines) if ($interactive);
1645 save_commits_by_signer(@lines) if ($interactive);
1646
1647 return @authors;
1648}
1649
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
1707 foreach my $commit (@commits) {
1708 $commit =~ s/^\^//g;
1709 }
1710
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;
1719 return 2 if eval $VCS_cmds{"available"};
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");
1725 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1726 $printed_novcs = 1;
1727 }
1728 return 0;
1729}
1730
1731sub vcs_is_git {
1732 vcs_exists();
1733 return $vcs_used == 1;
1734}
1735
1736sub vcs_is_hg {
1737 return $vcs_used == 2;
1738}
1739
Trevor Woernere57c7c52021-06-15 03:30:29 -04001740sub 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
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001766sub interactive_get_maintainers {
1767 my ($list_ref) = @_;
1768 my @list = @$list_ref;
1769
1770 vcs_exists();
1771
1772 my %selected;
1773 my %authored;
1774 my %signed;
1775 my $count = 0;
1776 my $maintained = 0;
1777 foreach my $entry (@list) {
1778 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1779 $selected{$count} = 1;
1780 $authored{$count} = 0;
1781 $signed{$count} = 0;
1782 $count++;
1783 }
1784
1785 #menu loop
1786 my $done = 0;
1787 my $print_options = 0;
1788 my $redraw = 1;
1789 while (!$done) {
1790 $count = 0;
1791 if ($redraw) {
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";
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";
1819 }
1820 }
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()) {
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
1850 }
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
Trevor Woernere57c7c52021-06-15 03:30:29 -04001859f emails in file [$email_file_emails]
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001860k keywords in file [$keywords]
1861r remove duplicates [$email_remove_duplicates]
1862p# pattern match depth [$pattern_depth]
1863EOT
1864 }
1865 print STDERR
1866"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1867
1868 my $input = <STDIN>;
1869 chomp($input);
1870
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;
1894 }
1895 } elsif ($sel eq "0") {
1896 for (my $i = 0; $i < $count; $i++) {
1897 $selected{$i} = !$selected{$i};
1898 }
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 }
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);
1947 } else {
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;
1972 }
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") {
Trevor Woernere57c7c52021-06-15 03:30:29 -04001984 bool_invert(\$email_file_emails);
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02001985 $rerun = 1;
1986 } elsif ($sel eq "r") {
1987 bool_invert(\$email_remove_duplicates);
1988 $rerun = 1;
1989 } elsif ($sel eq "m") {
1990 bool_invert(\$email_use_mailmap);
1991 read_mailmap();
1992 $rerun = 1;
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 }
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
2009If you have git or hg installed, you can choose to summarize the commit
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
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);
2030 goto &get_maintainers;
2031 }
2032 }
2033
2034 #drop not selected entries
2035 $count = 0;
2036 my @new_emailto = ();
2037 foreach my $entry (@list) {
2038 if ($selected{$count}) {
2039 push(@new_emailto, $list[$count]);
2040 }
2041 $count++;
2042 }
2043 return @new_emailto;
2044}
2045
2046sub bool_invert {
2047 my ($bool_ref) = @_;
2048
2049 if ($$bool_ref) {
2050 $$bool_ref = 0;
2051 } else {
2052 $$bool_ref = 1;
2053 }
2054}
2055
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
2068 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
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
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;
2096 $author = deduplicate_email($author);
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 }
2116 }
2117}
2118
2119sub save_commits_by_signer {
2120 my (@lines) = @_;
2121
2122 my $commit = "";
2123 my $subject = "";
2124
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
2137 $signer = deduplicate_email($signer);
2138
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 }
2154}
2155
2156sub vcs_assign {
2157 my ($role, $divisor, @lines) = @_;
2158
2159 my %hash;
2160 my $count = 0;
2161
2162 return if (@lines <= 0);
2163
2164 if ($divisor <= 0) {
2165 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
2166 $divisor = 1;
2167 }
2168
2169 @lines = mailmap(@lines);
2170
2171 return if (@lines <= 0);
2172
2173 @lines = sort(@lines);
2174
2175 # uniq -c
2176 $hash{$_}++ for @lines;
2177
2178 # sort -rn
2179 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
2180 my $sign_offs = $hash{$line};
2181 my $percent = $sign_offs * 100 / $divisor;
2182
2183 $percent = 100 if ($percent > 100);
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02002184 next if (ignore_email_address($line));
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02002185 $count++;
2186 last if ($sign_offs < $email_git_min_signatures ||
2187 $count > $email_git_max_maintainers ||
2188 $percent < $email_git_min_percent);
2189 push_email_address($line, '');
2190 if ($output_rolestats) {
2191 my $fmt_percent = sprintf("%.0f", $percent);
2192 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
2193 } else {
2194 add_role($line, $role);
2195 }
2196 }
2197}
2198
2199sub vcs_file_signoffs {
2200 my ($file) = @_;
2201
2202 my $authors_ref;
2203 my $signers_ref;
2204 my $stats_ref;
2205 my @authors = ();
2206 my @signers = ();
2207 my @stats = ();
2208 my $commits;
2209
2210 $vcs_used = vcs_exists();
2211 return if (!$vcs_used);
2212
2213 my $cmd = $VCS_cmds{"find_signers_cmd"};
2214 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
2215
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");
2223
2224 foreach my $signer (@signers) {
2225 $signer = deduplicate_email($signer);
2226 }
2227
2228 vcs_assign("commit_signer", $commits, @signers);
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 }
2269}
2270
2271sub vcs_file_blame {
2272 my ($file) = @_;
2273
2274 my @signers = ();
2275 my @all_commits = ();
2276 my @commits = ();
2277 my $total_commits;
2278 my $total_lines;
2279
2280 $vcs_used = vcs_exists();
2281 return if (!$vcs_used);
2282
2283 @all_commits = vcs_blame($file);
2284 @commits = uniq(@all_commits);
2285 $total_commits = @commits;
2286 $total_lines = @all_commits;
2287
2288 if ($email_git_blame_signatures) {
2289 if (vcs_is_hg()) {
2290 my $commit_count;
2291 my $commit_authors_ref;
2292 my $commit_signers_ref;
2293 my $stats_ref;
2294 my @commit_authors = ();
2295 my @commit_signers = ();
2296 my $commit = join(" -r ", @commits);
2297 my $cmd;
2298
2299 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2300 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2301
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;
2305
2306 push(@signers, @commit_signers);
2307 } else {
2308 foreach my $commit (@commits) {
2309 my $commit_count;
2310 my $commit_authors_ref;
2311 my $commit_signers_ref;
2312 my $stats_ref;
2313 my @commit_authors = ();
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
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;
2323
2324 push(@signers, @commit_signers);
2325 }
2326 }
2327 }
2328
2329 if ($from_filename) {
2330 if ($output_rolestats) {
2331 my @blame_signers;
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;
2357 $author = deduplicate_email($author);
2358 push(@authors, $author);
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;
2374
2375 my $formatted_author = deduplicate_email($author[0]);
2376
2377 my $count = grep(/$commit/, @all_commits);
2378 for ($i = 0; $i < $count ; $i++) {
2379 push(@blame_signers, $formatted_author);
2380 }
2381 }
2382 }
2383 if (@blame_signers) {
2384 vcs_assign("authored lines", $total_lines, @blame_signers);
2385 }
2386 }
2387 foreach my $signer (@signers) {
2388 $signer = deduplicate_email($signer);
2389 }
2390 vcs_assign("commits", $total_commits, @signers);
2391 } else {
2392 foreach my $signer (@signers) {
2393 $signer = deduplicate_email($signer);
2394 }
2395 vcs_assign("modified commits", $total_commits, @signers);
2396 }
2397}
2398
Heinrich Schuchardt59ab72d2017-10-13 19:31:20 +02002399sub 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
2409 $cmd .= " 2>&1";
2410 $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2411
2412 return 0 if ($? != 0);
2413
2414 return $exists;
2415}
2416
Heinrich Schuchardt2f8ffb02018-04-04 01:54:26 +02002417sub 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
Daniel Schwierzeck92bca392014-08-01 02:24:09 +02002434sub uniq {
2435 my (@parms) = @_;
2436
2437 my %saw;
2438 @parms = grep(!$saw{$_}++, @parms);
2439 return @parms;
2440}
2441
2442sub sort_and_uniq {
2443 my (@parms) = @_;
2444
2445 my %saw;
2446 @parms = sort @parms;
2447 @parms = grep(!$saw{$_}++, @parms);
2448 return @parms;
2449}
2450
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
2496sub merge_email {
2497 my @lines;
2498 my %saw;
2499
2500 for (@_) {
2501 my ($address, $role) = @$_;
2502 if (!$saw{$address}) {
2503 if ($output_roles) {
2504 push(@lines, "$address ($role)");
2505 } else {
2506 push(@lines, $address);
2507 }
2508 $saw{$address} = 1;
2509 }
2510 }
2511
2512 return @lines;
2513}
2514
2515sub output {
2516 my (@parms) = @_;
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}
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#
2580sub rfc822_valid {
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
2600sub rfc822_validlist {
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*$/) {
2612 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2613 push(@r, $1);
2614 }
2615 return wantarray ? (scalar(@r), @r) : 1;
2616 }
2617 return wantarray ? () : 0;
2618}