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