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