ipv6: set rt6i_protocol properly in the route when it is installed
[linux/fpc-iii.git] / scripts / get_maintainer.pl
blob3bd5f4f302354cf8cecd78ae0ab13b9b3bf130ef
1 #!/usr/bin/env perl
2 # (c) 2007, Joe Perches <joe@perches.com>
3 # created from checkpatch.pl
5 # Print selected MAINTAINERS information for
6 # the files modified in a patch or for a file
8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
9 # perl scripts/get_maintainer.pl [OPTIONS] -f <file>
11 # Licensed under the terms of the GNU GPL License version 2
13 use warnings;
14 use strict;
16 my $P = $0;
17 my $V = '0.26';
19 use Getopt::Long qw(:config no_auto_abbrev);
20 use Cwd;
22 my $cur_path = fastgetcwd() . '/';
23 my $lk_path = "./";
24 my $email = 1;
25 my $email_usename = 1;
26 my $email_maintainer = 1;
27 my $email_reviewer = 1;
28 my $email_list = 1;
29 my $email_subscriber_list = 0;
30 my $email_git_penguin_chiefs = 0;
31 my $email_git = 0;
32 my $email_git_all_signature_types = 0;
33 my $email_git_blame = 0;
34 my $email_git_blame_signatures = 1;
35 my $email_git_fallback = 1;
36 my $email_git_min_signatures = 1;
37 my $email_git_max_maintainers = 5;
38 my $email_git_min_percent = 5;
39 my $email_git_since = "1-year-ago";
40 my $email_hg_since = "-365";
41 my $interactive = 0;
42 my $email_remove_duplicates = 1;
43 my $email_use_mailmap = 1;
44 my $output_multiline = 1;
45 my $output_separator = ", ";
46 my $output_roles = 0;
47 my $output_rolestats = 1;
48 my $output_section_maxlen = 50;
49 my $scm = 0;
50 my $web = 0;
51 my $subsystem = 0;
52 my $status = 0;
53 my $letters = "";
54 my $keywords = 1;
55 my $sections = 0;
56 my $file_emails = 0;
57 my $from_filename = 0;
58 my $pattern_depth = 0;
59 my $version = 0;
60 my $help = 0;
62 my $vcs_used = 0;
64 my $exit = 0;
66 my %commit_author_hash;
67 my %commit_signer_hash;
69 my @penguin_chief = ();
70 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
71 #Andrew wants in on most everything - 2009/01/14
72 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
74 my @penguin_chief_names = ();
75 foreach my $chief (@penguin_chief) {
76 if ($chief =~ m/^(.*):(.*)/) {
77 my $chief_name = $1;
78 my $chief_addr = $2;
79 push(@penguin_chief_names, $chief_name);
82 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
84 # Signature types of people who are either
85 # a) responsible for the code in question, or
86 # b) familiar enough with it to give relevant feedback
87 my @signature_tags = ();
88 push(@signature_tags, "Signed-off-by:");
89 push(@signature_tags, "Reviewed-by:");
90 push(@signature_tags, "Acked-by:");
92 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
94 # rfc822 email address - preloaded methods go here.
95 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
96 my $rfc822_char = '[\\000-\\377]';
98 # VCS command support: class-like functions and strings
100 my %VCS_cmds;
102 my %VCS_cmds_git = (
103 "execute_cmd" => \&git_execute_cmd,
104 "available" => '(which("git") ne "") && (-e ".git")',
105 "find_signers_cmd" =>
106 "git log --no-color --follow --since=\$email_git_since " .
107 '--numstat --no-merges ' .
108 '--format="GitCommit: %H%n' .
109 'GitAuthor: %an <%ae>%n' .
110 'GitDate: %aD%n' .
111 'GitSubject: %s%n' .
112 '%b%n"' .
113 " -- \$file",
114 "find_commit_signers_cmd" =>
115 "git log --no-color " .
116 '--numstat ' .
117 '--format="GitCommit: %H%n' .
118 'GitAuthor: %an <%ae>%n' .
119 'GitDate: %aD%n' .
120 'GitSubject: %s%n' .
121 '%b%n"' .
122 " -1 \$commit",
123 "find_commit_author_cmd" =>
124 "git log --no-color " .
125 '--numstat ' .
126 '--format="GitCommit: %H%n' .
127 'GitAuthor: %an <%ae>%n' .
128 'GitDate: %aD%n' .
129 'GitSubject: %s%n"' .
130 " -1 \$commit",
131 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
132 "blame_file_cmd" => "git blame -l \$file",
133 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
134 "blame_commit_pattern" => "^([0-9a-f]+) ",
135 "author_pattern" => "^GitAuthor: (.*)",
136 "subject_pattern" => "^GitSubject: (.*)",
137 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
138 "file_exists_cmd" => "git ls-files \$file",
141 my %VCS_cmds_hg = (
142 "execute_cmd" => \&hg_execute_cmd,
143 "available" => '(which("hg") ne "") && (-d ".hg")',
144 "find_signers_cmd" =>
145 "hg log --date=\$email_hg_since " .
146 "--template='HgCommit: {node}\\n" .
147 "HgAuthor: {author}\\n" .
148 "HgSubject: {desc}\\n'" .
149 " -- \$file",
150 "find_commit_signers_cmd" =>
151 "hg log " .
152 "--template='HgSubject: {desc}\\n'" .
153 " -r \$commit",
154 "find_commit_author_cmd" =>
155 "hg log " .
156 "--template='HgCommit: {node}\\n" .
157 "HgAuthor: {author}\\n" .
158 "HgSubject: {desc|firstline}\\n'" .
159 " -r \$commit",
160 "blame_range_cmd" => "", # not supported
161 "blame_file_cmd" => "hg blame -n \$file",
162 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
163 "blame_commit_pattern" => "^([ 0-9a-f]+):",
164 "author_pattern" => "^HgAuthor: (.*)",
165 "subject_pattern" => "^HgSubject: (.*)",
166 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
167 "file_exists_cmd" => "hg files \$file",
170 my $conf = which_conf(".get_maintainer.conf");
171 if (-f $conf) {
172 my @conf_args;
173 open(my $conffile, '<', "$conf")
174 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
176 while (<$conffile>) {
177 my $line = $_;
179 $line =~ s/\s*\n?$//g;
180 $line =~ s/^\s*//g;
181 $line =~ s/\s+/ /g;
183 next if ($line =~ m/^\s*#/);
184 next if ($line =~ m/^\s*$/);
186 my @words = split(" ", $line);
187 foreach my $word (@words) {
188 last if ($word =~ m/^#/);
189 push (@conf_args, $word);
192 close($conffile);
193 unshift(@ARGV, @conf_args) if @conf_args;
196 my @ignore_emails = ();
197 my $ignore_file = which_conf(".get_maintainer.ignore");
198 if (-f $ignore_file) {
199 open(my $ignore, '<', "$ignore_file")
200 or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
201 while (<$ignore>) {
202 my $line = $_;
204 $line =~ s/\s*\n?$//;
205 $line =~ s/^\s*//;
206 $line =~ s/\s+$//;
207 $line =~ s/#.*$//;
209 next if ($line =~ m/^\s*$/);
210 if (rfc822_valid($line)) {
211 push(@ignore_emails, $line);
214 close($ignore);
217 if (!GetOptions(
218 'email!' => \$email,
219 'git!' => \$email_git,
220 'git-all-signature-types!' => \$email_git_all_signature_types,
221 'git-blame!' => \$email_git_blame,
222 'git-blame-signatures!' => \$email_git_blame_signatures,
223 'git-fallback!' => \$email_git_fallback,
224 'git-chief-penguins!' => \$email_git_penguin_chiefs,
225 'git-min-signatures=i' => \$email_git_min_signatures,
226 'git-max-maintainers=i' => \$email_git_max_maintainers,
227 'git-min-percent=i' => \$email_git_min_percent,
228 'git-since=s' => \$email_git_since,
229 'hg-since=s' => \$email_hg_since,
230 'i|interactive!' => \$interactive,
231 'remove-duplicates!' => \$email_remove_duplicates,
232 'mailmap!' => \$email_use_mailmap,
233 'm!' => \$email_maintainer,
234 'r!' => \$email_reviewer,
235 'n!' => \$email_usename,
236 'l!' => \$email_list,
237 's!' => \$email_subscriber_list,
238 'multiline!' => \$output_multiline,
239 'roles!' => \$output_roles,
240 'rolestats!' => \$output_rolestats,
241 'separator=s' => \$output_separator,
242 'subsystem!' => \$subsystem,
243 'status!' => \$status,
244 'scm!' => \$scm,
245 'web!' => \$web,
246 'letters=s' => \$letters,
247 'pattern-depth=i' => \$pattern_depth,
248 'k|keywords!' => \$keywords,
249 'sections!' => \$sections,
250 'fe|file-emails!' => \$file_emails,
251 'f|file' => \$from_filename,
252 'v|version' => \$version,
253 'h|help|usage' => \$help,
254 )) {
255 die "$P: invalid argument - use --help if necessary\n";
258 if ($help != 0) {
259 usage();
260 exit 0;
263 if ($version != 0) {
264 print("${P} ${V}\n");
265 exit 0;
268 if (-t STDIN && !@ARGV) {
269 # We're talking to a terminal, but have no command line arguments.
270 die "$P: missing patchfile or -f file - use --help if necessary\n";
273 $output_multiline = 0 if ($output_separator ne ", ");
274 $output_rolestats = 1 if ($interactive);
275 $output_roles = 1 if ($output_rolestats);
277 if ($sections || $letters ne "") {
278 $sections = 1;
279 $email = 0;
280 $email_list = 0;
281 $scm = 0;
282 $status = 0;
283 $subsystem = 0;
284 $web = 0;
285 $keywords = 0;
286 $interactive = 0;
287 } else {
288 my $selections = $email + $scm + $status + $subsystem + $web;
289 if ($selections == 0) {
290 die "$P: Missing required option: email, scm, status, subsystem or web\n";
294 if ($email &&
295 ($email_maintainer + $email_reviewer +
296 $email_list + $email_subscriber_list +
297 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
298 die "$P: Please select at least 1 email option\n";
301 if (!top_of_kernel_tree($lk_path)) {
302 die "$P: The current directory does not appear to be "
303 . "a linux kernel source tree.\n";
306 ## Read MAINTAINERS for type/value pairs
308 my @typevalue = ();
309 my %keyword_hash;
311 open (my $maint, '<', "${lk_path}MAINTAINERS")
312 or die "$P: Can't open MAINTAINERS: $!\n";
313 while (<$maint>) {
314 my $line = $_;
316 if ($line =~ m/^([A-Z]):\s*(.*)/) {
317 my $type = $1;
318 my $value = $2;
320 ##Filename pattern matching
321 if ($type eq "F" || $type eq "X") {
322 $value =~ s@\.@\\\.@g; ##Convert . to \.
323 $value =~ s/\*/\.\*/g; ##Convert * to .*
324 $value =~ s/\?/\./g; ##Convert ? to .
325 ##if pattern is a directory and it lacks a trailing slash, add one
326 if ((-d $value)) {
327 $value =~ s@([^/])$@$1/@;
329 } elsif ($type eq "K") {
330 $keyword_hash{@typevalue} = $value;
332 push(@typevalue, "$type:$value");
333 } elsif (!/^(\s)*$/) {
334 $line =~ s/\n$//g;
335 push(@typevalue, $line);
338 close($maint);
342 # Read mail address map
345 my $mailmap;
347 read_mailmap();
349 sub read_mailmap {
350 $mailmap = {
351 names => {},
352 addresses => {}
355 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
357 open(my $mailmap_file, '<', "${lk_path}.mailmap")
358 or warn "$P: Can't open .mailmap: $!\n";
360 while (<$mailmap_file>) {
361 s/#.*$//; #strip comments
362 s/^\s+|\s+$//g; #trim
364 next if (/^\s*$/); #skip empty lines
365 #entries have one of the following formats:
366 # name1 <mail1>
367 # <mail1> <mail2>
368 # name1 <mail1> <mail2>
369 # name1 <mail1> name2 <mail2>
370 # (see man git-shortlog)
372 if (/^([^<]+)<([^>]+)>$/) {
373 my $real_name = $1;
374 my $address = $2;
376 $real_name =~ s/\s+$//;
377 ($real_name, $address) = parse_email("$real_name <$address>");
378 $mailmap->{names}->{$address} = $real_name;
380 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
381 my $real_address = $1;
382 my $wrong_address = $2;
384 $mailmap->{addresses}->{$wrong_address} = $real_address;
386 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
387 my $real_name = $1;
388 my $real_address = $2;
389 my $wrong_address = $3;
391 $real_name =~ s/\s+$//;
392 ($real_name, $real_address) =
393 parse_email("$real_name <$real_address>");
394 $mailmap->{names}->{$wrong_address} = $real_name;
395 $mailmap->{addresses}->{$wrong_address} = $real_address;
397 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
398 my $real_name = $1;
399 my $real_address = $2;
400 my $wrong_name = $3;
401 my $wrong_address = $4;
403 $real_name =~ s/\s+$//;
404 ($real_name, $real_address) =
405 parse_email("$real_name <$real_address>");
407 $wrong_name =~ s/\s+$//;
408 ($wrong_name, $wrong_address) =
409 parse_email("$wrong_name <$wrong_address>");
411 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
412 $mailmap->{names}->{$wrong_email} = $real_name;
413 $mailmap->{addresses}->{$wrong_email} = $real_address;
416 close($mailmap_file);
419 ## use the filenames on the command line or find the filenames in the patchfiles
421 my @files = ();
422 my @range = ();
423 my @keyword_tvi = ();
424 my @file_emails = ();
426 if (!@ARGV) {
427 push(@ARGV, "&STDIN");
430 foreach my $file (@ARGV) {
431 if ($file ne "&STDIN") {
432 ##if $file is a directory and it lacks a trailing slash, add one
433 if ((-d $file)) {
434 $file =~ s@([^/])$@$1/@;
435 } elsif (!(-f $file)) {
436 die "$P: file '${file}' not found\n";
439 if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
440 $file =~ s/^\Q${cur_path}\E//; #strip any absolute path
441 $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree
442 push(@files, $file);
443 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
444 open(my $f, '<', $file)
445 or die "$P: Can't open $file: $!\n";
446 my $text = do { local($/) ; <$f> };
447 close($f);
448 if ($keywords) {
449 foreach my $line (keys %keyword_hash) {
450 if ($text =~ m/$keyword_hash{$line}/x) {
451 push(@keyword_tvi, $line);
455 if ($file_emails) {
456 my @poss_addr = $text =~ m$[A-Za--ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
457 push(@file_emails, clean_file_emails(@poss_addr));
460 } else {
461 my $file_cnt = @files;
462 my $lastfile;
464 open(my $patch, "< $file")
465 or die "$P: Can't open $file: $!\n";
467 # We can check arbitrary information before the patch
468 # like the commit message, mail headers, etc...
469 # This allows us to match arbitrary keywords against any part
470 # of a git format-patch generated file (subject tags, etc...)
472 my $patch_prefix = ""; #Parsing the intro
474 while (<$patch>) {
475 my $patch_line = $_;
476 if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
477 my $filename = $1;
478 $filename =~ s@^[^/]*/@@;
479 $filename =~ s@\n@@;
480 $lastfile = $filename;
481 push(@files, $filename);
482 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
483 } elsif (m/^\@\@ -(\d+),(\d+)/) {
484 if ($email_git_blame) {
485 push(@range, "$lastfile:$1:$2");
487 } elsif ($keywords) {
488 foreach my $line (keys %keyword_hash) {
489 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
490 push(@keyword_tvi, $line);
495 close($patch);
497 if ($file_cnt == @files) {
498 warn "$P: file '${file}' doesn't appear to be a patch. "
499 . "Add -f to options?\n";
501 @files = sort_and_uniq(@files);
505 @file_emails = uniq(@file_emails);
507 my %email_hash_name;
508 my %email_hash_address;
509 my @email_to = ();
510 my %hash_list_to;
511 my @list_to = ();
512 my @scm = ();
513 my @web = ();
514 my @subsystem = ();
515 my @status = ();
516 my %deduplicate_name_hash = ();
517 my %deduplicate_address_hash = ();
519 my @maintainers = get_maintainers();
521 if (@maintainers) {
522 @maintainers = merge_email(@maintainers);
523 output(@maintainers);
526 if ($scm) {
527 @scm = uniq(@scm);
528 output(@scm);
531 if ($status) {
532 @status = uniq(@status);
533 output(@status);
536 if ($subsystem) {
537 @subsystem = uniq(@subsystem);
538 output(@subsystem);
541 if ($web) {
542 @web = uniq(@web);
543 output(@web);
546 exit($exit);
548 sub ignore_email_address {
549 my ($address) = @_;
551 foreach my $ignore (@ignore_emails) {
552 return 1 if ($ignore eq $address);
555 return 0;
558 sub range_is_maintained {
559 my ($start, $end) = @_;
561 for (my $i = $start; $i < $end; $i++) {
562 my $line = $typevalue[$i];
563 if ($line =~ m/^([A-Z]):\s*(.*)/) {
564 my $type = $1;
565 my $value = $2;
566 if ($type eq 'S') {
567 if ($value =~ /(maintain|support)/i) {
568 return 1;
573 return 0;
576 sub range_has_maintainer {
577 my ($start, $end) = @_;
579 for (my $i = $start; $i < $end; $i++) {
580 my $line = $typevalue[$i];
581 if ($line =~ m/^([A-Z]):\s*(.*)/) {
582 my $type = $1;
583 my $value = $2;
584 if ($type eq 'M') {
585 return 1;
589 return 0;
592 sub get_maintainers {
593 %email_hash_name = ();
594 %email_hash_address = ();
595 %commit_author_hash = ();
596 %commit_signer_hash = ();
597 @email_to = ();
598 %hash_list_to = ();
599 @list_to = ();
600 @scm = ();
601 @web = ();
602 @subsystem = ();
603 @status = ();
604 %deduplicate_name_hash = ();
605 %deduplicate_address_hash = ();
606 if ($email_git_all_signature_types) {
607 $signature_pattern = "(.+?)[Bb][Yy]:";
608 } else {
609 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
612 # Find responsible parties
614 my %exact_pattern_match_hash = ();
616 foreach my $file (@files) {
618 my %hash;
619 my $tvi = find_first_section();
620 while ($tvi < @typevalue) {
621 my $start = find_starting_index($tvi);
622 my $end = find_ending_index($tvi);
623 my $exclude = 0;
624 my $i;
626 #Do not match excluded file patterns
628 for ($i = $start; $i < $end; $i++) {
629 my $line = $typevalue[$i];
630 if ($line =~ m/^([A-Z]):\s*(.*)/) {
631 my $type = $1;
632 my $value = $2;
633 if ($type eq 'X') {
634 if (file_match_pattern($file, $value)) {
635 $exclude = 1;
636 last;
642 if (!$exclude) {
643 for ($i = $start; $i < $end; $i++) {
644 my $line = $typevalue[$i];
645 if ($line =~ m/^([A-Z]):\s*(.*)/) {
646 my $type = $1;
647 my $value = $2;
648 if ($type eq 'F') {
649 if (file_match_pattern($file, $value)) {
650 my $value_pd = ($value =~ tr@/@@);
651 my $file_pd = ($file =~ tr@/@@);
652 $value_pd++ if (substr($value,-1,1) ne "/");
653 $value_pd = -1 if ($value =~ /^\.\*/);
654 if ($value_pd >= $file_pd &&
655 range_is_maintained($start, $end) &&
656 range_has_maintainer($start, $end)) {
657 $exact_pattern_match_hash{$file} = 1;
659 if ($pattern_depth == 0 ||
660 (($file_pd - $value_pd) < $pattern_depth)) {
661 $hash{$tvi} = $value_pd;
664 } elsif ($type eq 'N') {
665 if ($file =~ m/$value/x) {
666 $hash{$tvi} = 0;
672 $tvi = $end + 1;
675 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
676 add_categories($line);
677 if ($sections) {
678 my $i;
679 my $start = find_starting_index($line);
680 my $end = find_ending_index($line);
681 for ($i = $start; $i < $end; $i++) {
682 my $line = $typevalue[$i];
683 if ($line =~ /^[FX]:/) { ##Restore file patterns
684 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
685 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
686 $line =~ s/\\\./\./g; ##Convert \. to .
687 $line =~ s/\.\*/\*/g; ##Convert .* to *
689 my $count = $line =~ s/^([A-Z]):/$1:\t/g;
690 if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
691 print("$line\n");
694 print("\n");
699 if ($keywords) {
700 @keyword_tvi = sort_and_uniq(@keyword_tvi);
701 foreach my $line (@keyword_tvi) {
702 add_categories($line);
706 foreach my $email (@email_to, @list_to) {
707 $email->[0] = deduplicate_email($email->[0]);
710 foreach my $file (@files) {
711 if ($email &&
712 ($email_git || ($email_git_fallback &&
713 !$exact_pattern_match_hash{$file}))) {
714 vcs_file_signoffs($file);
716 if ($email && $email_git_blame) {
717 vcs_file_blame($file);
721 if ($email) {
722 foreach my $chief (@penguin_chief) {
723 if ($chief =~ m/^(.*):(.*)/) {
724 my $email_address;
726 $email_address = format_email($1, $2, $email_usename);
727 if ($email_git_penguin_chiefs) {
728 push(@email_to, [$email_address, 'chief penguin']);
729 } else {
730 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
735 foreach my $email (@file_emails) {
736 my ($name, $address) = parse_email($email);
738 my $tmp_email = format_email($name, $address, $email_usename);
739 push_email_address($tmp_email, '');
740 add_role($tmp_email, 'in file');
744 my @to = ();
745 if ($email || $email_list) {
746 if ($email) {
747 @to = (@to, @email_to);
749 if ($email_list) {
750 @to = (@to, @list_to);
754 if ($interactive) {
755 @to = interactive_get_maintainers(\@to);
758 return @to;
761 sub file_match_pattern {
762 my ($file, $pattern) = @_;
763 if (substr($pattern, -1) eq "/") {
764 if ($file =~ m@^$pattern@) {
765 return 1;
767 } else {
768 if ($file =~ m@^$pattern@) {
769 my $s1 = ($file =~ tr@/@@);
770 my $s2 = ($pattern =~ tr@/@@);
771 if ($s1 == $s2) {
772 return 1;
776 return 0;
779 sub usage {
780 print <<EOT;
781 usage: $P [options] patchfile
782 $P [options] -f file|directory
783 version: $V
785 MAINTAINER field selection options:
786 --email => print email address(es) if any
787 --git => include recent git \*-by: signers
788 --git-all-signature-types => include signers regardless of signature type
789 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
790 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
791 --git-chief-penguins => include ${penguin_chiefs}
792 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
793 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
794 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
795 --git-blame => use git blame to find modified commits for patch or file
796 --git-blame-signatures => when used with --git-blame, also include all commit signers
797 --git-since => git history to use (default: $email_git_since)
798 --hg-since => hg history to use (default: $email_hg_since)
799 --interactive => display a menu (mostly useful if used with the --git option)
800 --m => include maintainer(s) if any
801 --r => include reviewer(s) if any
802 --n => include name 'Full Name <addr\@domain.tld>'
803 --l => include list(s) if any
804 --s => include subscriber only list(s) if any
805 --remove-duplicates => minimize duplicate email names/addresses
806 --roles => show roles (status:subsystem, git-signer, list, etc...)
807 --rolestats => show roles and statistics (commits/total_commits, %)
808 --file-emails => add email addresses found in -f file (default: 0 (off))
809 --scm => print SCM tree(s) if any
810 --status => print status if any
811 --subsystem => print subsystem name if any
812 --web => print website(s) if any
814 Output type options:
815 --separator [, ] => separator for multiple entries on 1 line
816 using --separator also sets --nomultiline if --separator is not [, ]
817 --multiline => print 1 entry per line
819 Other options:
820 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
821 --keywords => scan patch for keywords (default: $keywords)
822 --sections => print all of the subsystem sections with pattern matches
823 --letters => print all matching 'letter' types from all matching sections
824 --mailmap => use .mailmap file (default: $email_use_mailmap)
825 --version => show version
826 --help => show this help information
828 Default options:
829 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
830 --remove-duplicates --rolestats]
832 Notes:
833 Using "-f directory" may give unexpected results:
834 Used with "--git", git signators for _all_ files in and below
835 directory are examined as git recurses directories.
836 Any specified X: (exclude) pattern matches are _not_ ignored.
837 Used with "--nogit", directory is used as a pattern match,
838 no individual file within the directory or subdirectory
839 is matched.
840 Used with "--git-blame", does not iterate all files in directory
841 Using "--git-blame" is slow and may add old committers and authors
842 that are no longer active maintainers to the output.
843 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
844 other automated tools that expect only ["name"] <email address>
845 may not work because of additional output after <email address>.
846 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
847 not the percentage of the entire file authored. # of commits is
848 not a good measure of amount of code authored. 1 major commit may
849 contain a thousand lines, 5 trivial commits may modify a single line.
850 If git is not installed, but mercurial (hg) is installed and an .hg
851 repository exists, the following options apply to mercurial:
852 --git,
853 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
854 --git-blame
855 Use --hg-since not --git-since to control date selection
856 File ".get_maintainer.conf", if it exists in the linux kernel source root
857 directory, can change whatever get_maintainer defaults are desired.
858 Entries in this file can be any command line argument.
859 This file is prepended to any additional command line arguments.
860 Multiple lines and # comments are allowed.
861 Most options have both positive and negative forms.
862 The negative forms for --<foo> are --no<foo> and --no-<foo>.
867 sub top_of_kernel_tree {
868 my ($lk_path) = @_;
870 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
871 $lk_path .= "/";
873 if ( (-f "${lk_path}COPYING")
874 && (-f "${lk_path}CREDITS")
875 && (-f "${lk_path}Kbuild")
876 && (-f "${lk_path}MAINTAINERS")
877 && (-f "${lk_path}Makefile")
878 && (-f "${lk_path}README")
879 && (-d "${lk_path}Documentation")
880 && (-d "${lk_path}arch")
881 && (-d "${lk_path}include")
882 && (-d "${lk_path}drivers")
883 && (-d "${lk_path}fs")
884 && (-d "${lk_path}init")
885 && (-d "${lk_path}ipc")
886 && (-d "${lk_path}kernel")
887 && (-d "${lk_path}lib")
888 && (-d "${lk_path}scripts")) {
889 return 1;
891 return 0;
894 sub parse_email {
895 my ($formatted_email) = @_;
897 my $name = "";
898 my $address = "";
900 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
901 $name = $1;
902 $address = $2;
903 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
904 $address = $1;
905 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
906 $address = $1;
909 $name =~ s/^\s+|\s+$//g;
910 $name =~ s/^\"|\"$//g;
911 $address =~ s/^\s+|\s+$//g;
913 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
914 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
915 $name = "\"$name\"";
918 return ($name, $address);
921 sub format_email {
922 my ($name, $address, $usename) = @_;
924 my $formatted_email;
926 $name =~ s/^\s+|\s+$//g;
927 $name =~ s/^\"|\"$//g;
928 $address =~ s/^\s+|\s+$//g;
930 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
931 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
932 $name = "\"$name\"";
935 if ($usename) {
936 if ("$name" eq "") {
937 $formatted_email = "$address";
938 } else {
939 $formatted_email = "$name <$address>";
941 } else {
942 $formatted_email = $address;
945 return $formatted_email;
948 sub find_first_section {
949 my $index = 0;
951 while ($index < @typevalue) {
952 my $tv = $typevalue[$index];
953 if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
954 last;
956 $index++;
959 return $index;
962 sub find_starting_index {
963 my ($index) = @_;
965 while ($index > 0) {
966 my $tv = $typevalue[$index];
967 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
968 last;
970 $index--;
973 return $index;
976 sub find_ending_index {
977 my ($index) = @_;
979 while ($index < @typevalue) {
980 my $tv = $typevalue[$index];
981 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
982 last;
984 $index++;
987 return $index;
990 sub get_subsystem_name {
991 my ($index) = @_;
993 my $start = find_starting_index($index);
995 my $subsystem = $typevalue[$start];
996 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
997 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
998 $subsystem =~ s/\s*$//;
999 $subsystem = $subsystem . "...";
1001 return $subsystem;
1004 sub get_maintainer_role {
1005 my ($index) = @_;
1007 my $i;
1008 my $start = find_starting_index($index);
1009 my $end = find_ending_index($index);
1011 my $role = "unknown";
1012 my $subsystem = get_subsystem_name($index);
1014 for ($i = $start + 1; $i < $end; $i++) {
1015 my $tv = $typevalue[$i];
1016 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1017 my $ptype = $1;
1018 my $pvalue = $2;
1019 if ($ptype eq "S") {
1020 $role = $pvalue;
1025 $role = lc($role);
1026 if ($role eq "supported") {
1027 $role = "supporter";
1028 } elsif ($role eq "maintained") {
1029 $role = "maintainer";
1030 } elsif ($role eq "odd fixes") {
1031 $role = "odd fixer";
1032 } elsif ($role eq "orphan") {
1033 $role = "orphan minder";
1034 } elsif ($role eq "obsolete") {
1035 $role = "obsolete minder";
1036 } elsif ($role eq "buried alive in reporters") {
1037 $role = "chief penguin";
1040 return $role . ":" . $subsystem;
1043 sub get_list_role {
1044 my ($index) = @_;
1046 my $subsystem = get_subsystem_name($index);
1048 if ($subsystem eq "THE REST") {
1049 $subsystem = "";
1052 return $subsystem;
1055 sub add_categories {
1056 my ($index) = @_;
1058 my $i;
1059 my $start = find_starting_index($index);
1060 my $end = find_ending_index($index);
1062 push(@subsystem, $typevalue[$start]);
1064 for ($i = $start + 1; $i < $end; $i++) {
1065 my $tv = $typevalue[$i];
1066 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1067 my $ptype = $1;
1068 my $pvalue = $2;
1069 if ($ptype eq "L") {
1070 my $list_address = $pvalue;
1071 my $list_additional = "";
1072 my $list_role = get_list_role($i);
1074 if ($list_role ne "") {
1075 $list_role = ":" . $list_role;
1077 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1078 $list_address = $1;
1079 $list_additional = $2;
1081 if ($list_additional =~ m/subscribers-only/) {
1082 if ($email_subscriber_list) {
1083 if (!$hash_list_to{lc($list_address)}) {
1084 $hash_list_to{lc($list_address)} = 1;
1085 push(@list_to, [$list_address,
1086 "subscriber list${list_role}"]);
1089 } else {
1090 if ($email_list) {
1091 if (!$hash_list_to{lc($list_address)}) {
1092 $hash_list_to{lc($list_address)} = 1;
1093 if ($list_additional =~ m/moderated/) {
1094 push(@list_to, [$list_address,
1095 "moderated list${list_role}"]);
1096 } else {
1097 push(@list_to, [$list_address,
1098 "open list${list_role}"]);
1103 } elsif ($ptype eq "M") {
1104 my ($name, $address) = parse_email($pvalue);
1105 if ($name eq "") {
1106 if ($i > 0) {
1107 my $tv = $typevalue[$i - 1];
1108 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1109 if ($1 eq "P") {
1110 $name = $2;
1111 $pvalue = format_email($name, $address, $email_usename);
1116 if ($email_maintainer) {
1117 my $role = get_maintainer_role($i);
1118 push_email_addresses($pvalue, $role);
1120 } elsif ($ptype eq "R") {
1121 my ($name, $address) = parse_email($pvalue);
1122 if ($name eq "") {
1123 if ($i > 0) {
1124 my $tv = $typevalue[$i - 1];
1125 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1126 if ($1 eq "P") {
1127 $name = $2;
1128 $pvalue = format_email($name, $address, $email_usename);
1133 if ($email_reviewer) {
1134 my $subsystem = get_subsystem_name($i);
1135 push_email_addresses($pvalue, "reviewer:$subsystem");
1137 } elsif ($ptype eq "T") {
1138 push(@scm, $pvalue);
1139 } elsif ($ptype eq "W") {
1140 push(@web, $pvalue);
1141 } elsif ($ptype eq "S") {
1142 push(@status, $pvalue);
1148 sub email_inuse {
1149 my ($name, $address) = @_;
1151 return 1 if (($name eq "") && ($address eq ""));
1152 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1153 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1155 return 0;
1158 sub push_email_address {
1159 my ($line, $role) = @_;
1161 my ($name, $address) = parse_email($line);
1163 if ($address eq "") {
1164 return 0;
1167 if (!$email_remove_duplicates) {
1168 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1169 } elsif (!email_inuse($name, $address)) {
1170 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1171 $email_hash_name{lc($name)}++ if ($name ne "");
1172 $email_hash_address{lc($address)}++;
1175 return 1;
1178 sub push_email_addresses {
1179 my ($address, $role) = @_;
1181 my @address_list = ();
1183 if (rfc822_valid($address)) {
1184 push_email_address($address, $role);
1185 } elsif (@address_list = rfc822_validlist($address)) {
1186 my $array_count = shift(@address_list);
1187 while (my $entry = shift(@address_list)) {
1188 push_email_address($entry, $role);
1190 } else {
1191 if (!push_email_address($address, $role)) {
1192 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1197 sub add_role {
1198 my ($line, $role) = @_;
1200 my ($name, $address) = parse_email($line);
1201 my $email = format_email($name, $address, $email_usename);
1203 foreach my $entry (@email_to) {
1204 if ($email_remove_duplicates) {
1205 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1206 if (($name eq $entry_name || $address eq $entry_address)
1207 && ($role eq "" || !($entry->[1] =~ m/$role/))
1209 if ($entry->[1] eq "") {
1210 $entry->[1] = "$role";
1211 } else {
1212 $entry->[1] = "$entry->[1],$role";
1215 } else {
1216 if ($email eq $entry->[0]
1217 && ($role eq "" || !($entry->[1] =~ m/$role/))
1219 if ($entry->[1] eq "") {
1220 $entry->[1] = "$role";
1221 } else {
1222 $entry->[1] = "$entry->[1],$role";
1229 sub which {
1230 my ($bin) = @_;
1232 foreach my $path (split(/:/, $ENV{PATH})) {
1233 if (-e "$path/$bin") {
1234 return "$path/$bin";
1238 return "";
1241 sub which_conf {
1242 my ($conf) = @_;
1244 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1245 if (-e "$path/$conf") {
1246 return "$path/$conf";
1250 return "";
1253 sub mailmap_email {
1254 my ($line) = @_;
1256 my ($name, $address) = parse_email($line);
1257 my $email = format_email($name, $address, 1);
1258 my $real_name = $name;
1259 my $real_address = $address;
1261 if (exists $mailmap->{names}->{$email} ||
1262 exists $mailmap->{addresses}->{$email}) {
1263 if (exists $mailmap->{names}->{$email}) {
1264 $real_name = $mailmap->{names}->{$email};
1266 if (exists $mailmap->{addresses}->{$email}) {
1267 $real_address = $mailmap->{addresses}->{$email};
1269 } else {
1270 if (exists $mailmap->{names}->{$address}) {
1271 $real_name = $mailmap->{names}->{$address};
1273 if (exists $mailmap->{addresses}->{$address}) {
1274 $real_address = $mailmap->{addresses}->{$address};
1277 return format_email($real_name, $real_address, 1);
1280 sub mailmap {
1281 my (@addresses) = @_;
1283 my @mapped_emails = ();
1284 foreach my $line (@addresses) {
1285 push(@mapped_emails, mailmap_email($line));
1287 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1288 return @mapped_emails;
1291 sub merge_by_realname {
1292 my %address_map;
1293 my (@emails) = @_;
1295 foreach my $email (@emails) {
1296 my ($name, $address) = parse_email($email);
1297 if (exists $address_map{$name}) {
1298 $address = $address_map{$name};
1299 $email = format_email($name, $address, 1);
1300 } else {
1301 $address_map{$name} = $address;
1306 sub git_execute_cmd {
1307 my ($cmd) = @_;
1308 my @lines = ();
1310 my $output = `$cmd`;
1311 $output =~ s/^\s*//gm;
1312 @lines = split("\n", $output);
1314 return @lines;
1317 sub hg_execute_cmd {
1318 my ($cmd) = @_;
1319 my @lines = ();
1321 my $output = `$cmd`;
1322 @lines = split("\n", $output);
1324 return @lines;
1327 sub extract_formatted_signatures {
1328 my (@signature_lines) = @_;
1330 my @type = @signature_lines;
1332 s/\s*(.*):.*/$1/ for (@type);
1334 # cut -f2- -d":"
1335 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1337 ## Reformat email addresses (with names) to avoid badly written signatures
1339 foreach my $signer (@signature_lines) {
1340 $signer = deduplicate_email($signer);
1343 return (\@type, \@signature_lines);
1346 sub vcs_find_signers {
1347 my ($cmd, $file) = @_;
1348 my $commits;
1349 my @lines = ();
1350 my @signatures = ();
1351 my @authors = ();
1352 my @stats = ();
1354 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1356 my $pattern = $VCS_cmds{"commit_pattern"};
1357 my $author_pattern = $VCS_cmds{"author_pattern"};
1358 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1360 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1362 $commits = grep(/$pattern/, @lines); # of commits
1364 @authors = grep(/$author_pattern/, @lines);
1365 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1366 @stats = grep(/$stat_pattern/, @lines);
1368 # print("stats: <@stats>\n");
1370 return (0, \@signatures, \@authors, \@stats) if !@signatures;
1372 save_commits_by_author(@lines) if ($interactive);
1373 save_commits_by_signer(@lines) if ($interactive);
1375 if (!$email_git_penguin_chiefs) {
1376 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1379 my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1380 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1382 return ($commits, $signers_ref, $authors_ref, \@stats);
1385 sub vcs_find_author {
1386 my ($cmd) = @_;
1387 my @lines = ();
1389 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1391 if (!$email_git_penguin_chiefs) {
1392 @lines = grep(!/${penguin_chiefs}/i, @lines);
1395 return @lines if !@lines;
1397 my @authors = ();
1398 foreach my $line (@lines) {
1399 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1400 my $author = $1;
1401 my ($name, $address) = parse_email($author);
1402 $author = format_email($name, $address, 1);
1403 push(@authors, $author);
1407 save_commits_by_author(@lines) if ($interactive);
1408 save_commits_by_signer(@lines) if ($interactive);
1410 return @authors;
1413 sub vcs_save_commits {
1414 my ($cmd) = @_;
1415 my @lines = ();
1416 my @commits = ();
1418 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1420 foreach my $line (@lines) {
1421 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1422 push(@commits, $1);
1426 return @commits;
1429 sub vcs_blame {
1430 my ($file) = @_;
1431 my $cmd;
1432 my @commits = ();
1434 return @commits if (!(-f $file));
1436 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1437 my @all_commits = ();
1439 $cmd = $VCS_cmds{"blame_file_cmd"};
1440 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1441 @all_commits = vcs_save_commits($cmd);
1443 foreach my $file_range_diff (@range) {
1444 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1445 my $diff_file = $1;
1446 my $diff_start = $2;
1447 my $diff_length = $3;
1448 next if ("$file" ne "$diff_file");
1449 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1450 push(@commits, $all_commits[$i]);
1453 } elsif (@range) {
1454 foreach my $file_range_diff (@range) {
1455 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1456 my $diff_file = $1;
1457 my $diff_start = $2;
1458 my $diff_length = $3;
1459 next if ("$file" ne "$diff_file");
1460 $cmd = $VCS_cmds{"blame_range_cmd"};
1461 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1462 push(@commits, vcs_save_commits($cmd));
1464 } else {
1465 $cmd = $VCS_cmds{"blame_file_cmd"};
1466 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1467 @commits = vcs_save_commits($cmd);
1470 foreach my $commit (@commits) {
1471 $commit =~ s/^\^//g;
1474 return @commits;
1477 my $printed_novcs = 0;
1478 sub vcs_exists {
1479 %VCS_cmds = %VCS_cmds_git;
1480 return 1 if eval $VCS_cmds{"available"};
1481 %VCS_cmds = %VCS_cmds_hg;
1482 return 2 if eval $VCS_cmds{"available"};
1483 %VCS_cmds = ();
1484 if (!$printed_novcs) {
1485 warn("$P: No supported VCS found. Add --nogit to options?\n");
1486 warn("Using a git repository produces better results.\n");
1487 warn("Try Linus Torvalds' latest git repository using:\n");
1488 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1489 $printed_novcs = 1;
1491 return 0;
1494 sub vcs_is_git {
1495 vcs_exists();
1496 return $vcs_used == 1;
1499 sub vcs_is_hg {
1500 return $vcs_used == 2;
1503 sub interactive_get_maintainers {
1504 my ($list_ref) = @_;
1505 my @list = @$list_ref;
1507 vcs_exists();
1509 my %selected;
1510 my %authored;
1511 my %signed;
1512 my $count = 0;
1513 my $maintained = 0;
1514 foreach my $entry (@list) {
1515 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1516 $selected{$count} = 1;
1517 $authored{$count} = 0;
1518 $signed{$count} = 0;
1519 $count++;
1522 #menu loop
1523 my $done = 0;
1524 my $print_options = 0;
1525 my $redraw = 1;
1526 while (!$done) {
1527 $count = 0;
1528 if ($redraw) {
1529 printf STDERR "\n%1s %2s %-65s",
1530 "*", "#", "email/list and role:stats";
1531 if ($email_git ||
1532 ($email_git_fallback && !$maintained) ||
1533 $email_git_blame) {
1534 print STDERR "auth sign";
1536 print STDERR "\n";
1537 foreach my $entry (@list) {
1538 my $email = $entry->[0];
1539 my $role = $entry->[1];
1540 my $sel = "";
1541 $sel = "*" if ($selected{$count});
1542 my $commit_author = $commit_author_hash{$email};
1543 my $commit_signer = $commit_signer_hash{$email};
1544 my $authored = 0;
1545 my $signed = 0;
1546 $authored++ for (@{$commit_author});
1547 $signed++ for (@{$commit_signer});
1548 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1549 printf STDERR "%4d %4d", $authored, $signed
1550 if ($authored > 0 || $signed > 0);
1551 printf STDERR "\n %s\n", $role;
1552 if ($authored{$count}) {
1553 my $commit_author = $commit_author_hash{$email};
1554 foreach my $ref (@{$commit_author}) {
1555 print STDERR " Author: @{$ref}[1]\n";
1558 if ($signed{$count}) {
1559 my $commit_signer = $commit_signer_hash{$email};
1560 foreach my $ref (@{$commit_signer}) {
1561 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1565 $count++;
1568 my $date_ref = \$email_git_since;
1569 $date_ref = \$email_hg_since if (vcs_is_hg());
1570 if ($print_options) {
1571 $print_options = 0;
1572 if (vcs_exists()) {
1573 print STDERR <<EOT
1575 Version Control options:
1576 g use git history [$email_git]
1577 gf use git-fallback [$email_git_fallback]
1578 b use git blame [$email_git_blame]
1579 bs use blame signatures [$email_git_blame_signatures]
1580 c# minimum commits [$email_git_min_signatures]
1581 %# min percent [$email_git_min_percent]
1582 d# history to use [$$date_ref]
1583 x# max maintainers [$email_git_max_maintainers]
1584 t all signature types [$email_git_all_signature_types]
1585 m use .mailmap [$email_use_mailmap]
1588 print STDERR <<EOT
1590 Additional options:
1591 0 toggle all
1592 tm toggle maintainers
1593 tg toggle git entries
1594 tl toggle open list entries
1595 ts toggle subscriber list entries
1596 f emails in file [$file_emails]
1597 k keywords in file [$keywords]
1598 r remove duplicates [$email_remove_duplicates]
1599 p# pattern match depth [$pattern_depth]
1602 print STDERR
1603 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1605 my $input = <STDIN>;
1606 chomp($input);
1608 $redraw = 1;
1609 my $rerun = 0;
1610 my @wish = split(/[, ]+/, $input);
1611 foreach my $nr (@wish) {
1612 $nr = lc($nr);
1613 my $sel = substr($nr, 0, 1);
1614 my $str = substr($nr, 1);
1615 my $val = 0;
1616 $val = $1 if $str =~ /^(\d+)$/;
1618 if ($sel eq "y") {
1619 $interactive = 0;
1620 $done = 1;
1621 $output_rolestats = 0;
1622 $output_roles = 0;
1623 last;
1624 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1625 $selected{$nr - 1} = !$selected{$nr - 1};
1626 } elsif ($sel eq "*" || $sel eq '^') {
1627 my $toggle = 0;
1628 $toggle = 1 if ($sel eq '*');
1629 for (my $i = 0; $i < $count; $i++) {
1630 $selected{$i} = $toggle;
1632 } elsif ($sel eq "0") {
1633 for (my $i = 0; $i < $count; $i++) {
1634 $selected{$i} = !$selected{$i};
1636 } elsif ($sel eq "t") {
1637 if (lc($str) eq "m") {
1638 for (my $i = 0; $i < $count; $i++) {
1639 $selected{$i} = !$selected{$i}
1640 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1642 } elsif (lc($str) eq "g") {
1643 for (my $i = 0; $i < $count; $i++) {
1644 $selected{$i} = !$selected{$i}
1645 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1647 } elsif (lc($str) eq "l") {
1648 for (my $i = 0; $i < $count; $i++) {
1649 $selected{$i} = !$selected{$i}
1650 if ($list[$i]->[1] =~ /^(open list)/i);
1652 } elsif (lc($str) eq "s") {
1653 for (my $i = 0; $i < $count; $i++) {
1654 $selected{$i} = !$selected{$i}
1655 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1658 } elsif ($sel eq "a") {
1659 if ($val > 0 && $val <= $count) {
1660 $authored{$val - 1} = !$authored{$val - 1};
1661 } elsif ($str eq '*' || $str eq '^') {
1662 my $toggle = 0;
1663 $toggle = 1 if ($str eq '*');
1664 for (my $i = 0; $i < $count; $i++) {
1665 $authored{$i} = $toggle;
1668 } elsif ($sel eq "s") {
1669 if ($val > 0 && $val <= $count) {
1670 $signed{$val - 1} = !$signed{$val - 1};
1671 } elsif ($str eq '*' || $str eq '^') {
1672 my $toggle = 0;
1673 $toggle = 1 if ($str eq '*');
1674 for (my $i = 0; $i < $count; $i++) {
1675 $signed{$i} = $toggle;
1678 } elsif ($sel eq "o") {
1679 $print_options = 1;
1680 $redraw = 1;
1681 } elsif ($sel eq "g") {
1682 if ($str eq "f") {
1683 bool_invert(\$email_git_fallback);
1684 } else {
1685 bool_invert(\$email_git);
1687 $rerun = 1;
1688 } elsif ($sel eq "b") {
1689 if ($str eq "s") {
1690 bool_invert(\$email_git_blame_signatures);
1691 } else {
1692 bool_invert(\$email_git_blame);
1694 $rerun = 1;
1695 } elsif ($sel eq "c") {
1696 if ($val > 0) {
1697 $email_git_min_signatures = $val;
1698 $rerun = 1;
1700 } elsif ($sel eq "x") {
1701 if ($val > 0) {
1702 $email_git_max_maintainers = $val;
1703 $rerun = 1;
1705 } elsif ($sel eq "%") {
1706 if ($str ne "" && $val >= 0) {
1707 $email_git_min_percent = $val;
1708 $rerun = 1;
1710 } elsif ($sel eq "d") {
1711 if (vcs_is_git()) {
1712 $email_git_since = $str;
1713 } elsif (vcs_is_hg()) {
1714 $email_hg_since = $str;
1716 $rerun = 1;
1717 } elsif ($sel eq "t") {
1718 bool_invert(\$email_git_all_signature_types);
1719 $rerun = 1;
1720 } elsif ($sel eq "f") {
1721 bool_invert(\$file_emails);
1722 $rerun = 1;
1723 } elsif ($sel eq "r") {
1724 bool_invert(\$email_remove_duplicates);
1725 $rerun = 1;
1726 } elsif ($sel eq "m") {
1727 bool_invert(\$email_use_mailmap);
1728 read_mailmap();
1729 $rerun = 1;
1730 } elsif ($sel eq "k") {
1731 bool_invert(\$keywords);
1732 $rerun = 1;
1733 } elsif ($sel eq "p") {
1734 if ($str ne "" && $val >= 0) {
1735 $pattern_depth = $val;
1736 $rerun = 1;
1738 } elsif ($sel eq "h" || $sel eq "?") {
1739 print STDERR <<EOT
1741 Interactive mode allows you to select the various maintainers, submitters,
1742 commit signers and mailing lists that could be CC'd on a patch.
1744 Any *'d entry is selected.
1746 If you have git or hg installed, you can choose to summarize the commit
1747 history of files in the patch. Also, each line of the current file can
1748 be matched to its commit author and that commits signers with blame.
1750 Various knobs exist to control the length of time for active commit
1751 tracking, the maximum number of commit authors and signers to add,
1752 and such.
1754 Enter selections at the prompt until you are satisfied that the selected
1755 maintainers are appropriate. You may enter multiple selections separated
1756 by either commas or spaces.
1759 } else {
1760 print STDERR "invalid option: '$nr'\n";
1761 $redraw = 0;
1764 if ($rerun) {
1765 print STDERR "git-blame can be very slow, please have patience..."
1766 if ($email_git_blame);
1767 goto &get_maintainers;
1771 #drop not selected entries
1772 $count = 0;
1773 my @new_emailto = ();
1774 foreach my $entry (@list) {
1775 if ($selected{$count}) {
1776 push(@new_emailto, $list[$count]);
1778 $count++;
1780 return @new_emailto;
1783 sub bool_invert {
1784 my ($bool_ref) = @_;
1786 if ($$bool_ref) {
1787 $$bool_ref = 0;
1788 } else {
1789 $$bool_ref = 1;
1793 sub deduplicate_email {
1794 my ($email) = @_;
1796 my $matched = 0;
1797 my ($name, $address) = parse_email($email);
1798 $email = format_email($name, $address, 1);
1799 $email = mailmap_email($email);
1801 return $email if (!$email_remove_duplicates);
1803 ($name, $address) = parse_email($email);
1805 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1806 $name = $deduplicate_name_hash{lc($name)}->[0];
1807 $address = $deduplicate_name_hash{lc($name)}->[1];
1808 $matched = 1;
1809 } elsif ($deduplicate_address_hash{lc($address)}) {
1810 $name = $deduplicate_address_hash{lc($address)}->[0];
1811 $address = $deduplicate_address_hash{lc($address)}->[1];
1812 $matched = 1;
1814 if (!$matched) {
1815 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1816 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1818 $email = format_email($name, $address, 1);
1819 $email = mailmap_email($email);
1820 return $email;
1823 sub save_commits_by_author {
1824 my (@lines) = @_;
1826 my @authors = ();
1827 my @commits = ();
1828 my @subjects = ();
1830 foreach my $line (@lines) {
1831 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1832 my $author = $1;
1833 $author = deduplicate_email($author);
1834 push(@authors, $author);
1836 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1837 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1840 for (my $i = 0; $i < @authors; $i++) {
1841 my $exists = 0;
1842 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1843 if (@{$ref}[0] eq $commits[$i] &&
1844 @{$ref}[1] eq $subjects[$i]) {
1845 $exists = 1;
1846 last;
1849 if (!$exists) {
1850 push(@{$commit_author_hash{$authors[$i]}},
1851 [ ($commits[$i], $subjects[$i]) ]);
1856 sub save_commits_by_signer {
1857 my (@lines) = @_;
1859 my $commit = "";
1860 my $subject = "";
1862 foreach my $line (@lines) {
1863 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1864 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1865 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1866 my @signatures = ($line);
1867 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1868 my @types = @$types_ref;
1869 my @signers = @$signers_ref;
1871 my $type = $types[0];
1872 my $signer = $signers[0];
1874 $signer = deduplicate_email($signer);
1876 my $exists = 0;
1877 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1878 if (@{$ref}[0] eq $commit &&
1879 @{$ref}[1] eq $subject &&
1880 @{$ref}[2] eq $type) {
1881 $exists = 1;
1882 last;
1885 if (!$exists) {
1886 push(@{$commit_signer_hash{$signer}},
1887 [ ($commit, $subject, $type) ]);
1893 sub vcs_assign {
1894 my ($role, $divisor, @lines) = @_;
1896 my %hash;
1897 my $count = 0;
1899 return if (@lines <= 0);
1901 if ($divisor <= 0) {
1902 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1903 $divisor = 1;
1906 @lines = mailmap(@lines);
1908 return if (@lines <= 0);
1910 @lines = sort(@lines);
1912 # uniq -c
1913 $hash{$_}++ for @lines;
1915 # sort -rn
1916 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1917 my $sign_offs = $hash{$line};
1918 my $percent = $sign_offs * 100 / $divisor;
1920 $percent = 100 if ($percent > 100);
1921 next if (ignore_email_address($line));
1922 $count++;
1923 last if ($sign_offs < $email_git_min_signatures ||
1924 $count > $email_git_max_maintainers ||
1925 $percent < $email_git_min_percent);
1926 push_email_address($line, '');
1927 if ($output_rolestats) {
1928 my $fmt_percent = sprintf("%.0f", $percent);
1929 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1930 } else {
1931 add_role($line, $role);
1936 sub vcs_file_signoffs {
1937 my ($file) = @_;
1939 my $authors_ref;
1940 my $signers_ref;
1941 my $stats_ref;
1942 my @authors = ();
1943 my @signers = ();
1944 my @stats = ();
1945 my $commits;
1947 $vcs_used = vcs_exists();
1948 return if (!$vcs_used);
1950 my $cmd = $VCS_cmds{"find_signers_cmd"};
1951 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1953 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1955 @signers = @{$signers_ref} if defined $signers_ref;
1956 @authors = @{$authors_ref} if defined $authors_ref;
1957 @stats = @{$stats_ref} if defined $stats_ref;
1959 # print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1961 foreach my $signer (@signers) {
1962 $signer = deduplicate_email($signer);
1965 vcs_assign("commit_signer", $commits, @signers);
1966 vcs_assign("authored", $commits, @authors);
1967 if ($#authors == $#stats) {
1968 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1969 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1971 my $added = 0;
1972 my $deleted = 0;
1973 for (my $i = 0; $i <= $#stats; $i++) {
1974 if ($stats[$i] =~ /$stat_pattern/) {
1975 $added += $1;
1976 $deleted += $2;
1979 my @tmp_authors = uniq(@authors);
1980 foreach my $author (@tmp_authors) {
1981 $author = deduplicate_email($author);
1983 @tmp_authors = uniq(@tmp_authors);
1984 my @list_added = ();
1985 my @list_deleted = ();
1986 foreach my $author (@tmp_authors) {
1987 my $auth_added = 0;
1988 my $auth_deleted = 0;
1989 for (my $i = 0; $i <= $#stats; $i++) {
1990 if ($author eq deduplicate_email($authors[$i]) &&
1991 $stats[$i] =~ /$stat_pattern/) {
1992 $auth_added += $1;
1993 $auth_deleted += $2;
1996 for (my $i = 0; $i < $auth_added; $i++) {
1997 push(@list_added, $author);
1999 for (my $i = 0; $i < $auth_deleted; $i++) {
2000 push(@list_deleted, $author);
2003 vcs_assign("added_lines", $added, @list_added);
2004 vcs_assign("removed_lines", $deleted, @list_deleted);
2008 sub vcs_file_blame {
2009 my ($file) = @_;
2011 my @signers = ();
2012 my @all_commits = ();
2013 my @commits = ();
2014 my $total_commits;
2015 my $total_lines;
2017 $vcs_used = vcs_exists();
2018 return if (!$vcs_used);
2020 @all_commits = vcs_blame($file);
2021 @commits = uniq(@all_commits);
2022 $total_commits = @commits;
2023 $total_lines = @all_commits;
2025 if ($email_git_blame_signatures) {
2026 if (vcs_is_hg()) {
2027 my $commit_count;
2028 my $commit_authors_ref;
2029 my $commit_signers_ref;
2030 my $stats_ref;
2031 my @commit_authors = ();
2032 my @commit_signers = ();
2033 my $commit = join(" -r ", @commits);
2034 my $cmd;
2036 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2037 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2039 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2040 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2041 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2043 push(@signers, @commit_signers);
2044 } else {
2045 foreach my $commit (@commits) {
2046 my $commit_count;
2047 my $commit_authors_ref;
2048 my $commit_signers_ref;
2049 my $stats_ref;
2050 my @commit_authors = ();
2051 my @commit_signers = ();
2052 my $cmd;
2054 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2055 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2057 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2058 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2059 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2061 push(@signers, @commit_signers);
2066 if ($from_filename) {
2067 if ($output_rolestats) {
2068 my @blame_signers;
2069 if (vcs_is_hg()) {{ # Double brace for last exit
2070 my $commit_count;
2071 my @commit_signers = ();
2072 @commits = uniq(@commits);
2073 @commits = sort(@commits);
2074 my $commit = join(" -r ", @commits);
2075 my $cmd;
2077 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2078 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2080 my @lines = ();
2082 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2084 if (!$email_git_penguin_chiefs) {
2085 @lines = grep(!/${penguin_chiefs}/i, @lines);
2088 last if !@lines;
2090 my @authors = ();
2091 foreach my $line (@lines) {
2092 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2093 my $author = $1;
2094 $author = deduplicate_email($author);
2095 push(@authors, $author);
2099 save_commits_by_author(@lines) if ($interactive);
2100 save_commits_by_signer(@lines) if ($interactive);
2102 push(@signers, @authors);
2104 else {
2105 foreach my $commit (@commits) {
2106 my $i;
2107 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2108 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2109 my @author = vcs_find_author($cmd);
2110 next if !@author;
2112 my $formatted_author = deduplicate_email($author[0]);
2114 my $count = grep(/$commit/, @all_commits);
2115 for ($i = 0; $i < $count ; $i++) {
2116 push(@blame_signers, $formatted_author);
2120 if (@blame_signers) {
2121 vcs_assign("authored lines", $total_lines, @blame_signers);
2124 foreach my $signer (@signers) {
2125 $signer = deduplicate_email($signer);
2127 vcs_assign("commits", $total_commits, @signers);
2128 } else {
2129 foreach my $signer (@signers) {
2130 $signer = deduplicate_email($signer);
2132 vcs_assign("modified commits", $total_commits, @signers);
2136 sub vcs_file_exists {
2137 my ($file) = @_;
2139 my $exists;
2141 my $vcs_used = vcs_exists();
2142 return 0 if (!$vcs_used);
2144 my $cmd = $VCS_cmds{"file_exists_cmd"};
2145 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
2146 $cmd .= " 2>&1";
2147 $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2149 return 0 if ($? != 0);
2151 return $exists;
2154 sub uniq {
2155 my (@parms) = @_;
2157 my %saw;
2158 @parms = grep(!$saw{$_}++, @parms);
2159 return @parms;
2162 sub sort_and_uniq {
2163 my (@parms) = @_;
2165 my %saw;
2166 @parms = sort @parms;
2167 @parms = grep(!$saw{$_}++, @parms);
2168 return @parms;
2171 sub clean_file_emails {
2172 my (@file_emails) = @_;
2173 my @fmt_emails = ();
2175 foreach my $email (@file_emails) {
2176 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2177 my ($name, $address) = parse_email($email);
2178 if ($name eq '"[,\.]"') {
2179 $name = "";
2182 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2183 if (@nw > 2) {
2184 my $first = $nw[@nw - 3];
2185 my $middle = $nw[@nw - 2];
2186 my $last = $nw[@nw - 1];
2188 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2189 (length($first) == 2 && substr($first, -1) eq ".")) ||
2190 (length($middle) == 1 ||
2191 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2192 $name = "$first $middle $last";
2193 } else {
2194 $name = "$middle $last";
2198 if (substr($name, -1) =~ /[,\.]/) {
2199 $name = substr($name, 0, length($name) - 1);
2200 } elsif (substr($name, -2) =~ /[,\.]"/) {
2201 $name = substr($name, 0, length($name) - 2) . '"';
2204 if (substr($name, 0, 1) =~ /[,\.]/) {
2205 $name = substr($name, 1, length($name) - 1);
2206 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2207 $name = '"' . substr($name, 2, length($name) - 2);
2210 my $fmt_email = format_email($name, $address, $email_usename);
2211 push(@fmt_emails, $fmt_email);
2213 return @fmt_emails;
2216 sub merge_email {
2217 my @lines;
2218 my %saw;
2220 for (@_) {
2221 my ($address, $role) = @$_;
2222 if (!$saw{$address}) {
2223 if ($output_roles) {
2224 push(@lines, "$address ($role)");
2225 } else {
2226 push(@lines, $address);
2228 $saw{$address} = 1;
2232 return @lines;
2235 sub output {
2236 my (@parms) = @_;
2238 if ($output_multiline) {
2239 foreach my $line (@parms) {
2240 print("${line}\n");
2242 } else {
2243 print(join($output_separator, @parms));
2244 print("\n");
2248 my $rfc822re;
2250 sub make_rfc822re {
2251 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2252 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2253 # This regexp will only work on addresses which have had comments stripped
2254 # and replaced with rfc822_lwsp.
2256 my $specials = '()<>@,;:\\\\".\\[\\]';
2257 my $controls = '\\000-\\037\\177';
2259 my $dtext = "[^\\[\\]\\r\\\\]";
2260 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2262 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2264 # Use zero-width assertion to spot the limit of an atom. A simple
2265 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2266 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2267 my $word = "(?:$atom|$quoted_string)";
2268 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2270 my $sub_domain = "(?:$atom|$domain_literal)";
2271 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2273 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2275 my $phrase = "$word*";
2276 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2277 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2278 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2280 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2281 my $address = "(?:$mailbox|$group)";
2283 return "$rfc822_lwsp*$address";
2286 sub rfc822_strip_comments {
2287 my $s = shift;
2288 # Recursively remove comments, and replace with a single space. The simpler
2289 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2290 # chars in atoms, for example.
2292 while ($s =~ s/^((?:[^"\\]|\\.)*
2293 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2294 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2295 return $s;
2298 # valid: returns true if the parameter is an RFC822 valid address
2300 sub rfc822_valid {
2301 my $s = rfc822_strip_comments(shift);
2303 if (!$rfc822re) {
2304 $rfc822re = make_rfc822re();
2307 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2310 # validlist: In scalar context, returns true if the parameter is an RFC822
2311 # valid list of addresses.
2313 # In list context, returns an empty list on failure (an invalid
2314 # address was found); otherwise a list whose first element is the
2315 # number of addresses found and whose remaining elements are the
2316 # addresses. This is needed to disambiguate failure (invalid)
2317 # from success with no addresses found, because an empty string is
2318 # a valid list.
2320 sub rfc822_validlist {
2321 my $s = rfc822_strip_comments(shift);
2323 if (!$rfc822re) {
2324 $rfc822re = make_rfc822re();
2326 # * null list items are valid according to the RFC
2327 # * the '1' business is to aid in distinguishing failure from no results
2329 my @r;
2330 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2331 $s =~ m/^$rfc822_char*$/) {
2332 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2333 push(@r, $1);
2335 return wantarray ? (scalar(@r), @r) : 1;
2337 return wantarray ? () : 0;