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