Commit ec83b616a71d76cc062371339472ed66ba405824

Authored by Richard Genoud
Committed by Linus Torvalds
1 parent 49d3d6c37a

get_maintainer: fix detection of git repository

Since git v1.7.7, the .git directory can be a file when, for example,
the kernel is a submodule of another git super project.  So, the check
"-d .git" is not working anymore in this case.  Using a more generic
check like "-e .git" corrects this behaviour.

Signed-off-by: Richard Genoud <richard.genoud@gmail.com>
Cc: Andy Whitcroft <apw@canonical.com>
Cc: Joe Perches <joe@perches.com>
Signed-off-by: Andrew Morton <akpm@linux-foundation.org>
Signed-off-by: Linus Torvalds <torvalds@linux-foundation.org>

Showing 1 changed file with 1 additions and 1 deletions Inline Diff

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