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
18 use Getopt::Long qw(:config no_auto_abbrev);
22 my $email_usename = 1;
23 my $email_maintainer = 1;
25 my $email_subscriber_list = 0;
27 my $email_git_penguin_chiefs = 0;
28 my $email_git_min_signatures = 1;
29 my $email_git_max_maintainers = 5;
30 my $email_git_min_percent = 5;
31 my $email_git_since = "1-year-ago";
32 my $email_git_blame = 0;
33 my $email_remove_duplicates = 1;
34 my $output_multiline = 1;
35 my $output_separator = ", ";
37 my $output_rolestats = 0;
43 my $from_filename = 0;
44 my $pattern_depth = 0;
50 my @penguin_chief = ();
51 push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
52 #Andrew wants in on most everything - 2009/01/14
53 #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
55 my @penguin_chief_names = ();
56 foreach my $chief (@penguin_chief) {
57 if ($chief =~ m/^(.*):(.*)/) {
60 push(@penguin_chief_names, $chief_name);
63 my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
65 # rfc822 email address - preloaded methods go here.
66 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
67 my $rfc822_char = '[\\000-\\377]';
71 'git!' => \$email_git,
72 'git-chief-penguins!' => \$email_git_penguin_chiefs,
73 'git-min-signatures=i' => \$email_git_min_signatures,
74 'git-max-maintainers=i' => \$email_git_max_maintainers,
75 'git-min-percent=i' => \$email_git_min_percent,
76 'git-since=s' => \$email_git_since,
77 'git-blame!' => \$email_git_blame,
78 'remove-duplicates!' => \$email_remove_duplicates,
79 'm!' => \$email_maintainer,
80 'n!' => \$email_usename,
82 's!' => \$email_subscriber_list,
83 'multiline!' => \$output_multiline,
84 'roles!' => \$output_roles,
85 'rolestats!' => \$output_rolestats,
86 'separator=s' => \$output_separator,
87 'subsystem!' => \$subsystem,
88 'status!' => \$status,
91 'pattern-depth=i' => \$pattern_depth,
92 'k|keywords!' => \$keywords,
93 'f|file' => \$from_filename,
94 'v|version' => \$version,
97 die "$P: invalid argument - use --help if necessary\n";
106 print("${P} ${V}\n");
112 die "$P: argument missing: patchfile or -f file please\n";
115 if ($output_separator ne ", ") {
116 $output_multiline = 0;
119 if ($output_rolestats) {
123 my $selections = $email + $scm + $status + $subsystem + $web;
124 if ($selections == 0) {
126 die "$P: Missing required option: email, scm, status, subsystem or web\n";
130 ($email_maintainer + $email_list + $email_subscriber_list +
131 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
133 die "$P: Please select at least 1 email option\n";
136 if (!top_of_kernel_tree($lk_path)) {
137 die "$P: The current directory does not appear to be "
138 . "a linux kernel source tree.\n";
141 ## Read MAINTAINERS for type/value pairs
146 open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
150 if ($line =~ m/^(\C):\s*(.*)/) {
154 ##Filename pattern matching
155 if ($type eq "F" || $type eq "X") {
156 $value =~ s@\.@\\\.@g; ##Convert . to \.
157 $value =~ s/\*/\.\*/g; ##Convert * to .*
158 $value =~ s/\?/\./g; ##Convert ? to .
159 ##if pattern is a directory and it lacks a trailing slash, add one
161 $value =~ s@([^/])$@$1/@;
163 } elsif ($type eq "K") {
164 $keyword_hash{@typevalue} = $value;
166 push(@typevalue, "$type:$value");
167 } elsif (!/^(\s)*$/) {
169 push(@typevalue, $line);
176 if ($email_remove_duplicates) {
177 open(MAILMAP, "<${lk_path}.mailmap") || warn "$P: Can't open .mailmap\n";
181 next if ($line =~ m/^\s*#/);
182 next if ($line =~ m/^\s*$/);
184 my ($name, $address) = parse_email($line);
185 $line = format_email($name, $address);
187 next if ($line =~ m/^\s*$/);
189 if (exists($mailmap{$name})) {
190 my $obj = $mailmap{$name};
191 push(@$obj, $address);
193 my @arr = ($address);
194 $mailmap{$name} = \@arr;
200 ## use the filenames on the command line or find the filenames in the patchfiles
204 my @keyword_tvi = ();
206 foreach my $file (@ARGV) {
207 ##if $file is a directory and it lacks a trailing slash, add one
209 $file =~ s@([^/])$@$1/@;
210 } elsif (!(-f $file)) {
211 die "$P: file '${file}' not found\n";
213 if ($from_filename) {
215 if (-f $file && $keywords) {
216 open(FILE, "<$file") or die "$P: Can't open ${file}\n";
219 foreach my $line (keys %keyword_hash) {
220 if ($patch_line =~ m/^.*$keyword_hash{$line}/x) {
221 push(@keyword_tvi, $line);
228 my $file_cnt = @files;
230 open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
233 if (m/^\+\+\+\s+(\S+)/) {
235 $filename =~ s@^[^/]*/@@;
237 $lastfile = $filename;
238 push(@files, $filename);
239 } elsif (m/^\@\@ -(\d+),(\d+)/) {
240 if ($email_git_blame) {
241 push(@range, "$lastfile:$1:$2");
243 } elsif ($keywords) {
244 foreach my $line (keys %keyword_hash) {
245 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
246 push(@keyword_tvi, $line);
252 if ($file_cnt == @files) {
253 warn "$P: file '${file}' doesn't appear to be a patch. "
254 . "Add -f to options?\n";
256 @files = sort_and_uniq(@files);
267 # Find responsible parties
269 foreach my $file (@files) {
271 #Do not match excluded file patterns
274 foreach my $line (@typevalue) {
275 if ($line =~ m/^(\C):\s*(.*)/) {
279 if (file_match_pattern($file, $value)) {
290 foreach my $line (@typevalue) {
291 if ($line =~ m/^(\C):\s*(.*)/) {
295 if (file_match_pattern($file, $value)) {
296 my $value_pd = ($value =~ tr@/@@);
297 my $file_pd = ($file =~ tr@/@@);
298 $value_pd++ if (substr($value,-1,1) ne "/");
299 if ($pattern_depth == 0 ||
300 (($file_pd - $value_pd) < $pattern_depth)) {
301 $hash{$tvi} = $value_pd;
308 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
309 add_categories($line);
313 if ($email && $email_git) {
314 recent_git_signoffs($file);
317 if ($email && $email_git_blame) {
318 git_assign_blame($file);
323 @keyword_tvi = sort_and_uniq(@keyword_tvi);
324 foreach my $line (@keyword_tvi) {
325 add_categories($line);
330 foreach my $chief (@penguin_chief) {
331 if ($chief =~ m/^(.*):(.*)/) {
334 $email_address = format_email($1, $2);
335 if ($email_git_penguin_chiefs) {
336 push(@email_to, [$email_address, 'chief penguin']);
338 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
344 if ($email || $email_list) {
347 @to = (@to, @email_to);
350 @to = (@to, @list_to);
352 output(merge_email(@to));
361 @status = uniq(@status);
366 @subsystem = uniq(@subsystem);
377 sub file_match_pattern {
378 my ($file, $pattern) = @_;
379 if (substr($pattern, -1) eq "/") {
380 if ($file =~ m@^$pattern@) {
384 if ($file =~ m@^$pattern@) {
385 my $s1 = ($file =~ tr@/@@);
386 my $s2 = ($pattern =~ tr@/@@);
397 usage: $P [options] patchfile
398 $P [options] -f file|directory
401 MAINTAINER field selection options:
402 --email => print email address(es) if any
403 --git => include recent git \*-by: signers
404 --git-chief-penguins => include ${penguin_chiefs}
405 --git-min-signatures => number of signatures required (default: 1)
406 --git-max-maintainers => maximum maintainers to add (default: 5)
407 --git-min-percent => minimum percentage of commits required (default: 5)
408 --git-since => git history to use (default: 1-year-ago)
409 --git-blame => use git blame to find modified commits for patch or file
410 --m => include maintainer(s) if any
411 --n => include name 'Full Name <addr\@domain.tld>'
412 --l => include list(s) if any
413 --s => include subscriber only list(s) if any
414 --remove-duplicates => minimize duplicate email names/addresses
415 --roles => show roles (status:subsystem, git-signer, list, etc...)
416 --rolestats => show roles and statistics (commits/total_commits, %)
417 --scm => print SCM tree(s) if any
418 --status => print status if any
419 --subsystem => print subsystem name if any
420 --web => print website(s) if any
423 --separator [, ] => separator for multiple entries on 1 line
424 using --separator also sets --nomultiline if --separator is not [, ]
425 --multiline => print 1 entry per line
428 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
429 --keywords => scan patch for keywords (default: 1 (on))
430 --version => show version
431 --help => show this help information
434 [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
437 Using "-f directory" may give unexpected results:
438 Used with "--git", git signators for _all_ files in and below
439 directory are examined as git recurses directories.
440 Any specified X: (exclude) pattern matches are _not_ ignored.
441 Used with "--nogit", directory is used as a pattern match,
442 no individual file within the directory or subdirectory
444 Used with "--git-blame", does not iterate all files in directory
445 Using "--git-blame" is slow and may add old committers and authors
446 that are no longer active maintainers to the output.
447 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
448 other automated tools that expect only ["name"] <email address>
449 may not work because of additional output after <email address>.
450 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
451 not the percentage of the entire file authored. # of commits is
452 not a good measure of amount of code authored. 1 major commit may
453 contain a thousand lines, 5 trivial commits may modify a single line.
457 sub top_of_kernel_tree {
460 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
463 if ( (-f "${lk_path}COPYING")
464 && (-f "${lk_path}CREDITS")
465 && (-f "${lk_path}Kbuild")
466 && (-f "${lk_path}MAINTAINERS")
467 && (-f "${lk_path}Makefile")
468 && (-f "${lk_path}README")
469 && (-d "${lk_path}Documentation")
470 && (-d "${lk_path}arch")
471 && (-d "${lk_path}include")
472 && (-d "${lk_path}drivers")
473 && (-d "${lk_path}fs")
474 && (-d "${lk_path}init")
475 && (-d "${lk_path}ipc")
476 && (-d "${lk_path}kernel")
477 && (-d "${lk_path}lib")
478 && (-d "${lk_path}scripts")) {
485 my ($formatted_email) = @_;
490 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
493 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
495 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
499 $name =~ s/^\s+|\s+$//g;
500 $name =~ s/^\"|\"$//g;
501 $address =~ s/^\s+|\s+$//g;
503 if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars
504 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
508 return ($name, $address);
512 my ($name, $address) = @_;
516 $name =~ s/^\s+|\s+$//g;
517 $name =~ s/^\"|\"$//g;
518 $address =~ s/^\s+|\s+$//g;
520 if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars
521 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
525 if ($email_usename) {
527 $formatted_email = "$address";
529 $formatted_email = "$name <${address}>";
532 $formatted_email = $address;
535 return $formatted_email;
538 sub find_starting_index {
542 my $tv = $typevalue[$index];
543 if (!($tv =~ m/^(\C):\s*(.*)/)) {
552 sub find_ending_index {
555 while ($index < @typevalue) {
556 my $tv = $typevalue[$index];
557 if (!($tv =~ m/^(\C):\s*(.*)/)) {
566 sub get_maintainer_role {
570 my $start = find_starting_index($index);
571 my $end = find_ending_index($index);
574 my $subsystem = $typevalue[$start];
575 if (length($subsystem) > 20) {
576 $subsystem = substr($subsystem, 0, 17);
577 $subsystem =~ s/\s*$//;
578 $subsystem = $subsystem . "...";
581 for ($i = $start + 1; $i < $end; $i++) {
582 my $tv = $typevalue[$i];
583 if ($tv =~ m/^(\C):\s*(.*)/) {
593 if ($role eq "supported") {
595 } elsif ($role eq "maintained") {
596 $role = "maintainer";
597 } elsif ($role eq "odd fixes") {
599 } elsif ($role eq "orphan") {
600 $role = "orphan minder";
601 } elsif ($role eq "obsolete") {
602 $role = "obsolete minder";
603 } elsif ($role eq "buried alive in reporters") {
604 $role = "chief penguin";
607 return $role . ":" . $subsystem;
614 my $start = find_starting_index($index);
615 my $end = find_ending_index($index);
617 my $subsystem = $typevalue[$start];
618 if (length($subsystem) > 20) {
619 $subsystem = substr($subsystem, 0, 17);
620 $subsystem =~ s/\s*$//;
621 $subsystem = $subsystem . "...";
624 if ($subsystem eq "THE REST") {
635 my $start = find_starting_index($index);
636 my $end = find_ending_index($index);
638 push(@subsystem, $typevalue[$start]);
640 for ($i = $start + 1; $i < $end; $i++) {
641 my $tv = $typevalue[$i];
642 if ($tv =~ m/^(\C):\s*(.*)/) {
646 my $list_address = $pvalue;
647 my $list_additional = "";
648 my $list_role = get_list_role($i);
650 if ($list_role ne "") {
651 $list_role = ":" . $list_role;
653 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
655 $list_additional = $2;
657 if ($list_additional =~ m/subscribers-only/) {
658 if ($email_subscriber_list) {
659 push(@list_to, [$list_address, "subscriber list${list_role}"]);
663 push(@list_to, [$list_address, "open list${list_role}"]);
666 } elsif ($ptype eq "M") {
667 my ($name, $address) = parse_email($pvalue);
670 my $tv = $typevalue[$i - 1];
671 if ($tv =~ m/^(\C):\s*(.*)/) {
674 $pvalue = format_email($name, $address);
679 if ($email_maintainer) {
680 my $role = get_maintainer_role($i);
681 push_email_addresses($pvalue, $role);
683 } elsif ($ptype eq "T") {
685 } elsif ($ptype eq "W") {
687 } elsif ($ptype eq "S") {
688 push(@status, $pvalue);
695 my %email_hash_address;
698 my ($name, $address) = @_;
700 return 1 if (($name eq "") && ($address eq ""));
701 return 1 if (($name ne "") && exists($email_hash_name{$name}));
702 return 1 if (($address ne "") && exists($email_hash_address{$address}));
707 sub push_email_address {
708 my ($line, $role) = @_;
710 my ($name, $address) = parse_email($line);
712 if ($address eq "") {
716 if (!$email_remove_duplicates) {
717 push(@email_to, [format_email($name, $address), $role]);
718 } elsif (!email_inuse($name, $address)) {
719 push(@email_to, [format_email($name, $address), $role]);
720 $email_hash_name{$name}++;
721 $email_hash_address{$address}++;
727 sub push_email_addresses {
728 my ($address, $role) = @_;
730 my @address_list = ();
732 if (rfc822_valid($address)) {
733 push_email_address($address, $role);
734 } elsif (@address_list = rfc822_validlist($address)) {
735 my $array_count = shift(@address_list);
736 while (my $entry = shift(@address_list)) {
737 push_email_address($entry, $role);
740 if (!push_email_address($address, $role)) {
741 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
747 my ($line, $role) = @_;
749 my ($name, $address) = parse_email($line);
750 my $email = format_email($name, $address);
752 foreach my $entry (@email_to) {
753 if ($email_remove_duplicates) {
754 my ($entry_name, $entry_address) = parse_email($entry->[0]);
755 if ($name eq $entry_name || $address eq $entry_address) {
756 if ($entry->[1] eq "") {
757 $entry->[1] = "$role";
759 $entry->[1] = "$entry->[1],$role";
763 if ($email eq $entry->[0]) {
764 if ($entry->[1] eq "") {
765 $entry->[1] = "$role";
767 $entry->[1] = "$entry->[1],$role";
777 foreach my $path (split(/:/, $ENV{PATH})) {
778 if (-e "$path/$bin") {
790 foreach my $line (@lines) {
791 my ($name, $address) = parse_email($line);
792 if (!exists($hash{$name})) {
793 $hash{$name} = $address;
794 } elsif ($address ne $hash{$name}) {
795 $address = $hash{$name};
796 $line = format_email($name, $address);
798 if (exists($mailmap{$name})) {
799 my $obj = $mailmap{$name};
800 foreach my $map_address (@$obj) {
801 if (($map_address eq $address) &&
802 ($map_address ne $hash{$name})) {
803 $line = format_email($name, $hash{$name});
812 sub recent_git_signoffs {
823 if (which("git") eq "") {
824 warn("$P: git not found. Add --nogit to options?\n");
828 warn("$P: .git directory not found. Use a git repository for better results.\n");
829 warn("$P: perhaps 'git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git'\n");
833 $cmd = "git log --since=${email_git_since} -- ${file}";
836 $output =~ s/^\s*//gm;
838 @lines = split("\n", $output);
840 @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines);
841 if (!$email_git_penguin_chiefs) {
842 @lines = grep(!/${penguin_chiefs}/i, @lines);
845 s/.*:\s*(.+)\s*/$1/ for (@lines);
847 $total_sign_offs = @lines;
848 foreach my $line (@lines) {
849 my ($name, $address) = parse_email($line);
850 $line = format_email($name, $address);
853 if ($email_remove_duplicates) {
854 @lines = mailmap(@lines);
857 @lines = sort(@lines);
860 $hash{$_}++ for @lines;
863 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
864 my $sign_offs = $hash{$line};
868 last if ($sign_offs < $email_git_min_signatures ||
869 $count > $email_git_max_maintainers ||
870 $sign_offs * 100 / $total_sign_offs < $email_git_min_percent);
871 push_email_address($line, '');
872 $role = "git-signer";
873 if ($output_rolestats) {
874 my $percent = sprintf("%.0f", $sign_offs * 100 / $total_sign_offs);
875 $role = "$role:$sign_offs/$total_sign_offs=$percent%";
877 add_role($line, $role);
882 my ($cmd, @commits) = @_;
888 @lines = split("\n", $output);
889 foreach my $line (@lines) {
890 if ($line =~ m/^(\w+) /) {
897 sub git_assign_blame {
909 foreach my $file_range_diff (@range) {
910 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
913 my $diff_length = $3;
914 next if (!("$file" eq "$diff_file"));
915 $cmd = "git blame -l -L $diff_start,+$diff_length $file";
916 @commits = save_commits($cmd, @commits);
920 $cmd = "git blame -l $file";
921 @commits = save_commits($cmd, @commits);
925 $total_sign_offs = 0;
926 @commits = uniq(@commits);
927 foreach my $commit (@commits) {
928 $cmd = "git log -1 ${commit}";
931 $output =~ s/^\s*//gm;
932 @lines = split("\n", $output);
934 @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines);
935 if (!$email_git_penguin_chiefs) {
936 @lines = grep(!/${penguin_chiefs}/i, @lines);
940 s/.*:\s*(.+)\s*/$1/ for (@lines);
942 $total_sign_offs += @lines;
944 if ($email_remove_duplicates) {
945 @lines = mailmap(@lines);
948 $hash{$_}++ for @lines;
952 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
953 my $sign_offs = $hash{$line};
957 last if ($sign_offs < $email_git_min_signatures ||
958 $count > $email_git_max_maintainers ||
959 $sign_offs * 100 / $total_sign_offs < $email_git_min_percent);
960 push_email_address($line, '');
961 if ($from_filename) {
964 $role = "modified commits";
966 if ($output_rolestats) {
967 my $percent = sprintf("%.0f", $sign_offs * 100 / $total_sign_offs);
968 $role = "$role:$sign_offs/$total_sign_offs=$percent%";
970 add_role($line, $role);
978 @parms = grep(!$saw{$_}++, @parms);
986 @parms = sort @parms;
987 @parms = grep(!$saw{$_}++, @parms);
996 my ($address, $role) = @$_;
997 if (!$saw{$address}) {
999 push @lines, "$address ($role)";
1001 push @lines, $address;
1013 if ($output_multiline) {
1014 foreach my $line (@parms) {
1018 print(join($output_separator, @parms));
1026 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
1027 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
1028 # This regexp will only work on addresses which have had comments stripped
1029 # and replaced with rfc822_lwsp.
1031 my $specials = '()<>@,;:\\\\".\\[\\]';
1032 my $controls = '\\000-\\037\\177';
1034 my $dtext = "[^\\[\\]\\r\\\\]";
1035 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
1037 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
1039 # Use zero-width assertion to spot the limit of an atom. A simple
1040 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
1041 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
1042 my $word = "(?:$atom|$quoted_string)";
1043 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
1045 my $sub_domain = "(?:$atom|$domain_literal)";
1046 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
1048 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
1050 my $phrase = "$word*";
1051 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
1052 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
1053 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
1055 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
1056 my $address = "(?:$mailbox|$group)";
1058 return "$rfc822_lwsp*$address";
1061 sub rfc822_strip_comments {
1063 # Recursively remove comments, and replace with a single space. The simpler
1064 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
1065 # chars in atoms, for example.
1067 while ($s =~ s/^((?:[^"\\]|\\.)*
1068 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
1069 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
1073 # valid: returns true if the parameter is an RFC822 valid address
1075 sub rfc822_valid ($) {
1076 my $s = rfc822_strip_comments(shift);
1079 $rfc822re = make_rfc822re();
1082 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
1085 # validlist: In scalar context, returns true if the parameter is an RFC822
1086 # valid list of addresses.
1088 # In list context, returns an empty list on failure (an invalid
1089 # address was found); otherwise a list whose first element is the
1090 # number of addresses found and whose remaining elements are the
1091 # addresses. This is needed to disambiguate failure (invalid)
1092 # from success with no addresses found, because an empty string is
1095 sub rfc822_validlist ($) {
1096 my $s = rfc822_strip_comments(shift);
1099 $rfc822re = make_rfc822re();
1101 # * null list items are valid according to the RFC
1102 # * the '1' business is to aid in distinguishing failure from no results
1105 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
1106 $s =~ m/^$rfc822_char*$/) {
1107 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
1110 return wantarray ? (scalar(@r), @r) : 1;
1113 return wantarray ? () : 0;