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