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