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