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;
26 my $email_git_penguin_chiefs = 0;
28 my $email_git_all_signature_types = 0;
29 my $email_git_blame = 0;
30 my $email_git_blame_signatures = 1;
31 my $email_git_fallback = 1;
32 my $email_git_min_signatures = 1;
33 my $email_git_max_maintainers = 5;
34 my $email_git_min_percent = 5;
35 my $email_git_since = "1-year-ago";
36 my $email_hg_since = "-365";
38 my $email_remove_duplicates = 1;
39 my $email_use_mailmap = 1;
40 my $output_multiline = 1;
41 my $output_separator = ", ";
43 my $output_rolestats = 1;
51 my $from_filename = 0;
52 my $pattern_depth = 0;
60 my %commit_author_hash;
61 my %commit_signer_hash;
63 my @penguin_chief = ();
64 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
65 #Andrew wants in on most everything - 2009/01/14
66 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
68 my @penguin_chief_names = ();
69 foreach my $chief (@penguin_chief) {
70 if ($chief =~ m/^(.*):(.*)/) {
73 push(@penguin_chief_names, $chief_name);
76 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
78 # Signature types of people who are either
79 # a) responsible for the code in question, or
80 # b) familiar enough with it to give relevant feedback
81 my @signature_tags = ();
82 push(@signature_tags, "Signed-off-by:");
83 push(@signature_tags, "Reviewed-by:");
84 push(@signature_tags, "Acked-by:");
86 # rfc822 email address - preloaded methods go here.
87 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
88 my $rfc822_char = '[\\000-\\377]';
90 # VCS command support: class-like functions and strings
95 "execute_cmd" => \
&git_execute_cmd
,
96 "available" => '(which("git") ne "") && (-d ".git")',
98 "git log --no-color --since=\$email_git_since " .
99 '--format="GitCommit: %H%n' .
100 'GitAuthor: %an <%ae>%n' .
105 "find_commit_signers_cmd" =>
106 "git log --no-color " .
107 '--format="GitCommit: %H%n' .
108 'GitAuthor: %an <%ae>%n' .
113 "find_commit_author_cmd" =>
114 "git log --no-color " .
115 '--format="GitCommit: %H%n' .
116 'GitAuthor: %an <%ae>%n' .
118 'GitSubject: %s%n"' .
120 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
121 "blame_file_cmd" => "git blame -l \$file",
122 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
123 "blame_commit_pattern" => "^([0-9a-f]+) ",
124 "author_pattern" => "^GitAuthor: (.*)",
125 "subject_pattern" => "^GitSubject: (.*)",
129 "execute_cmd" => \
&hg_execute_cmd
,
130 "available" => '(which("hg") ne "") && (-d ".hg")',
131 "find_signers_cmd" =>
132 "hg log --date=\$email_hg_since " .
133 "--template='HgCommit: {node}\\n" .
134 "HgAuthor: {author}\\n" .
135 "HgSubject: {desc}\\n'" .
137 "find_commit_signers_cmd" =>
139 "--template='HgSubject: {desc}\\n'" .
141 "find_commit_author_cmd" =>
143 "--template='HgCommit: {node}\\n" .
144 "HgAuthor: {author}\\n" .
145 "HgSubject: {desc|firstline}\\n'" .
147 "blame_range_cmd" => "", # not supported
148 "blame_file_cmd" => "hg blame -n \$file",
149 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
150 "blame_commit_pattern" => "^([ 0-9a-f]+):",
151 "author_pattern" => "^HgAuthor: (.*)",
152 "subject_pattern" => "^HgSubject: (.*)",
155 my $conf = which_conf
(".get_maintainer.conf");
158 open(my $conffile, '<', "$conf")
159 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
161 while (<$conffile>) {
164 $line =~ s/\s*\n?$//g;
168 next if ($line =~ m/^\s*#/);
169 next if ($line =~ m/^\s*$/);
171 my @words = split(" ", $line);
172 foreach my $word (@words) {
173 last if ($word =~ m/^#/);
174 push (@conf_args, $word);
178 unshift(@ARGV, @conf_args) if @conf_args;
183 'git!' => \
$email_git,
184 'git-all-signature-types!' => \
$email_git_all_signature_types,
185 'git-blame!' => \
$email_git_blame,
186 'git-blame-signatures!' => \
$email_git_blame_signatures,
187 'git-fallback!' => \
$email_git_fallback,
188 'git-chief-penguins!' => \
$email_git_penguin_chiefs,
189 'git-min-signatures=i' => \
$email_git_min_signatures,
190 'git-max-maintainers=i' => \
$email_git_max_maintainers,
191 'git-min-percent=i' => \
$email_git_min_percent,
192 'git-since=s' => \
$email_git_since,
193 'hg-since=s' => \
$email_hg_since,
194 'i|interactive!' => \
$interactive,
195 'remove-duplicates!' => \
$email_remove_duplicates,
196 'mailmap!' => \
$email_use_mailmap,
197 'm!' => \
$email_maintainer,
198 'n!' => \
$email_usename,
199 'l!' => \
$email_list,
200 's!' => \
$email_subscriber_list,
201 'multiline!' => \
$output_multiline,
202 'roles!' => \
$output_roles,
203 'rolestats!' => \
$output_rolestats,
204 'separator=s' => \
$output_separator,
205 'subsystem!' => \
$subsystem,
206 'status!' => \
$status,
209 'pattern-depth=i' => \
$pattern_depth,
210 'k|keywords!' => \
$keywords,
211 'sections!' => \
$sections,
212 'fe|file-emails!' => \
$file_emails,
213 'f|file' => \
$from_filename,
214 'v|version' => \
$version,
215 'h|help|usage' => \
$help,
217 die "$P: invalid argument - use --help if necessary\n";
226 print("${P} ${V}\n");
230 if (-t STDIN
&& !@ARGV) {
231 # We're talking to a terminal, but have no command line arguments.
232 die "$P: missing patchfile or -f file - use --help if necessary\n";
235 $output_multiline = 0 if ($output_separator ne ", ");
236 $output_rolestats = 1 if ($interactive);
237 $output_roles = 1 if ($output_rolestats);
249 my $selections = $email + $scm + $status + $subsystem + $web;
250 if ($selections == 0) {
251 die "$P: Missing required option: email, scm, status, subsystem or web\n";
256 ($email_maintainer + $email_list + $email_subscriber_list +
257 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
258 die "$P: Please select at least 1 email option\n";
261 if (!top_of_kernel_tree
($lk_path)) {
262 die "$P: The current directory does not appear to be "
263 . "a linux kernel source tree.\n";
266 ## Read MAINTAINERS for type/value pairs
271 open (my $maint, '<', "${lk_path}MAINTAINERS")
272 or die "$P: Can't open MAINTAINERS: $!\n";
276 if ($line =~ m/^(\C):\s*(.*)/) {
280 ##Filename pattern matching
281 if ($type eq "F" || $type eq "X") {
282 $value =~ s@\
.@
\\\
.@g; ##Convert . to \.
283 $value =~ s/\*/\.\*/g; ##Convert * to .*
284 $value =~ s/\?/\./g; ##Convert ? to .
285 ##if pattern is a directory and it lacks a trailing slash, add one
287 $value =~ s@
([^/])$@$1/@
;
289 } elsif ($type eq "K") {
290 $keyword_hash{@typevalue} = $value;
292 push(@typevalue, "$type:$value");
293 } elsif (!/^(\s)*$/) {
295 push(@typevalue, $line);
302 # Read mail address map
315 return if (!$email_use_mailmap || !(-f
"${lk_path}.mailmap"));
317 open(my $mailmap_file, '<', "${lk_path}.mailmap")
318 or warn "$P: Can't open .mailmap: $!\n";
320 while (<$mailmap_file>) {
321 s/#.*$//; #strip comments
322 s/^\s+|\s+$//g; #trim
324 next if (/^\s*$/); #skip empty lines
325 #entries have one of the following formats:
328 # name1 <mail1> <mail2>
329 # name1 <mail1> name2 <mail2>
330 # (see man git-shortlog)
331 if (/^(.+)<(.+)>$/) {
335 $real_name =~ s/\s+$//;
336 ($real_name, $address) = parse_email
("$real_name <$address>");
337 $mailmap->{names
}->{$address} = $real_name;
339 } elsif (/^<([^\s]+)>\s*<([^\s]+)>$/) {
340 my $real_address = $1;
341 my $wrong_address = $2;
343 $mailmap->{addresses
}->{$wrong_address} = $real_address;
345 } elsif (/^(.+)<([^\s]+)>\s*<([^\s]+)>$/) {
347 my $real_address = $2;
348 my $wrong_address = $3;
350 $real_name =~ s/\s+$//;
351 ($real_name, $real_address) =
352 parse_email
("$real_name <$real_address>");
353 $mailmap->{names
}->{$wrong_address} = $real_name;
354 $mailmap->{addresses
}->{$wrong_address} = $real_address;
356 } elsif (/^(.+)<([^\s]+)>\s*([^\s].*)<([^\s]+)>$/) {
358 my $real_address = $2;
360 my $wrong_address = $4;
362 $real_name =~ s/\s+$//;
363 ($real_name, $real_address) =
364 parse_email
("$real_name <$real_address>");
366 $wrong_name =~ s/\s+$//;
367 ($wrong_name, $wrong_address) =
368 parse_email
("$wrong_name <$wrong_address>");
370 my $wrong_email = format_email
($wrong_name, $wrong_address, 1);
371 $mailmap->{names
}->{$wrong_email} = $real_name;
372 $mailmap->{addresses
}->{$wrong_email} = $real_address;
375 close($mailmap_file);
378 ## use the filenames on the command line or find the filenames in the patchfiles
382 my @keyword_tvi = ();
383 my @file_emails = ();
386 push(@ARGV, "&STDIN");
389 foreach my $file (@ARGV) {
390 if ($file ne "&STDIN") {
391 ##if $file is a directory and it lacks a trailing slash, add one
393 $file =~ s@
([^/])$@$1/@
;
394 } elsif (!(-f
$file)) {
395 die "$P: file '${file}' not found\n";
398 if ($from_filename) {
400 if ($file ne "MAINTAINERS" && -f
$file && ($keywords || $file_emails)) {
401 open(my $f, '<', $file)
402 or die "$P: Can't open $file: $!\n";
403 my $text = do { local($/) ; <$f> };
406 foreach my $line (keys %keyword_hash) {
407 if ($text =~ m/$keyword_hash{$line}/x) {
408 push(@keyword_tvi, $line);
413 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;
414 push(@file_emails, clean_file_emails
(@poss_addr));
418 my $file_cnt = @files;
421 open(my $patch, "< $file")
422 or die "$P: Can't open $file: $!\n";
425 if (m/^\+\+\+\s+(\S+)/) {
427 $filename =~ s@
^[^/]*/@@
;
429 $lastfile = $filename;
430 push(@files, $filename);
431 } elsif (m/^\@\@ -(\d+),(\d+)/) {
432 if ($email_git_blame) {
433 push(@range, "$lastfile:$1:$2");
435 } elsif ($keywords) {
436 foreach my $line (keys %keyword_hash) {
437 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
438 push(@keyword_tvi, $line);
445 if ($file_cnt == @files) {
446 warn "$P: file '${file}' doesn't appear to be a patch. "
447 . "Add -f to options?\n";
449 @files = sort_and_uniq
(@files);
453 @file_emails = uniq
(@file_emails);
456 my %email_hash_address;
464 my %deduplicate_name_hash = ();
465 my %deduplicate_address_hash = ();
466 my $signature_pattern;
468 my @maintainers = get_maintainers
();
471 @maintainers = merge_email
(@maintainers);
472 output
(@maintainers);
481 @status = uniq
(@status);
486 @subsystem = uniq
(@subsystem);
497 sub get_maintainers
{
498 %email_hash_name = ();
499 %email_hash_address = ();
500 %commit_author_hash = ();
501 %commit_signer_hash = ();
509 %deduplicate_name_hash = ();
510 %deduplicate_address_hash = ();
511 if ($email_git_all_signature_types) {
512 $signature_pattern = "(.+?)[Bb][Yy]:";
514 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
517 # Find responsible parties
519 my %exact_pattern_match_hash = ();
521 foreach my $file (@files) {
524 my $tvi = find_first_section
();
525 while ($tvi < @typevalue) {
526 my $start = find_starting_index
($tvi);
527 my $end = find_ending_index
($tvi);
531 #Do not match excluded file patterns
533 for ($i = $start; $i < $end; $i++) {
534 my $line = $typevalue[$i];
535 if ($line =~ m/^(\C):\s*(.*)/) {
539 if (file_match_pattern
($file, $value)) {
548 for ($i = $start; $i < $end; $i++) {
549 my $line = $typevalue[$i];
550 if ($line =~ m/^(\C):\s*(.*)/) {
554 if (file_match_pattern
($file, $value)) {
555 my $value_pd = ($value =~ tr@
/@@
);
556 my $file_pd = ($file =~ tr@
/@@
);
557 $value_pd++ if (substr($value,-1,1) ne "/");
558 $value_pd = -1 if ($value =~ /^\.\*/);
559 if ($value_pd >= $file_pd) {
560 $exact_pattern_match_hash{$file} = 1;
562 if ($pattern_depth == 0 ||
563 (($file_pd - $value_pd) < $pattern_depth)) {
564 $hash{$tvi} = $value_pd;
574 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
575 add_categories
($line);
578 my $start = find_starting_index
($line);
579 my $end = find_ending_index
($line);
580 for ($i = $start; $i < $end; $i++) {
581 my $line = $typevalue[$i];
582 if ($line =~ /^[FX]:/) { ##Restore file patterns
583 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
584 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
585 $line =~ s/\\\./\./g; ##Convert \. to .
586 $line =~ s/\.\*/\*/g; ##Convert .* to *
588 $line =~ s/^([A-Z]):/$1:\t/g;
597 @keyword_tvi = sort_and_uniq
(@keyword_tvi);
598 foreach my $line (@keyword_tvi) {
599 add_categories
($line);
603 foreach my $email (@email_to, @list_to) {
604 $email->[0] = deduplicate_email
($email->[0]);
607 foreach my $file (@files) {
609 ($email_git || ($email_git_fallback &&
610 !$exact_pattern_match_hash{$file}))) {
611 vcs_file_signoffs
($file);
613 if ($email && $email_git_blame) {
614 vcs_file_blame
($file);
619 foreach my $chief (@penguin_chief) {
620 if ($chief =~ m/^(.*):(.*)/) {
623 $email_address = format_email
($1, $2, $email_usename);
624 if ($email_git_penguin_chiefs) {
625 push(@email_to, [$email_address, 'chief penguin']);
627 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
632 foreach my $email (@file_emails) {
633 my ($name, $address) = parse_email
($email);
635 my $tmp_email = format_email
($name, $address, $email_usename);
636 push_email_address
($tmp_email, '');
637 add_role
($tmp_email, 'in file');
642 if ($email || $email_list) {
644 @to = (@to, @email_to);
647 @to = (@to, @list_to);
652 @to = interactive_get_maintainers
(\
@to);
658 sub file_match_pattern
{
659 my ($file, $pattern) = @_;
660 if (substr($pattern, -1) eq "/") {
661 if ($file =~ m@
^$pattern@
) {
665 if ($file =~ m@
^$pattern@
) {
666 my $s1 = ($file =~ tr@
/@@
);
667 my $s2 = ($pattern =~ tr@
/@@
);
678 usage: $P [options] patchfile
679 $P [options] -f file|directory
682 MAINTAINER field selection options:
683 --email => print email address(es) if any
684 --git => include recent git \*-by: signers
685 --git-all-signature-types => include signers regardless of signature type
686 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
687 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
688 --git-chief-penguins => include ${penguin_chiefs}
689 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
690 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
691 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
692 --git-blame => use git blame to find modified commits for patch or file
693 --git-since => git history to use (default: $email_git_since)
694 --hg-since => hg history to use (default: $email_hg_since)
695 --interactive => display a menu (mostly useful if used with the --git option)
696 --m => include maintainer(s) if any
697 --n => include name 'Full Name <addr\@domain.tld>'
698 --l => include list(s) if any
699 --s => include subscriber only list(s) if any
700 --remove-duplicates => minimize duplicate email names/addresses
701 --roles => show roles (status:subsystem, git-signer, list, etc...)
702 --rolestats => show roles and statistics (commits/total_commits, %)
703 --file-emails => add email addresses found in -f file (default: 0 (off))
704 --scm => print SCM tree(s) if any
705 --status => print status if any
706 --subsystem => print subsystem name if any
707 --web => print website(s) if any
710 --separator [, ] => separator for multiple entries on 1 line
711 using --separator also sets --nomultiline if --separator is not [, ]
712 --multiline => print 1 entry per line
715 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
716 --keywords => scan patch for keywords (default: $keywords)
717 --sections => print all of the subsystem sections with pattern matches
718 --mailmap => use .mailmap file (default: $email_use_mailmap)
719 --version => show version
720 --help => show this help information
723 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
724 --remove-duplicates --rolestats]
727 Using "-f directory" may give unexpected results:
728 Used with "--git", git signators for _all_ files in and below
729 directory are examined as git recurses directories.
730 Any specified X: (exclude) pattern matches are _not_ ignored.
731 Used with "--nogit", directory is used as a pattern match,
732 no individual file within the directory or subdirectory
734 Used with "--git-blame", does not iterate all files in directory
735 Using "--git-blame" is slow and may add old committers and authors
736 that are no longer active maintainers to the output.
737 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
738 other automated tools that expect only ["name"] <email address>
739 may not work because of additional output after <email address>.
740 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
741 not the percentage of the entire file authored. # of commits is
742 not a good measure of amount of code authored. 1 major commit may
743 contain a thousand lines, 5 trivial commits may modify a single line.
744 If git is not installed, but mercurial (hg) is installed and an .hg
745 repository exists, the following options apply to mercurial:
747 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
749 Use --hg-since not --git-since to control date selection
750 File ".get_maintainer.conf", if it exists in the linux kernel source root
751 directory, can change whatever get_maintainer defaults are desired.
752 Entries in this file can be any command line argument.
753 This file is prepended to any additional command line arguments.
754 Multiple lines and # comments are allowed.
758 sub top_of_kernel_tree
{
761 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
764 if ( (-f
"${lk_path}COPYING")
765 && (-f
"${lk_path}CREDITS")
766 && (-f
"${lk_path}Kbuild")
767 && (-f
"${lk_path}MAINTAINERS")
768 && (-f
"${lk_path}Makefile")
769 && (-f
"${lk_path}README")
770 && (-d
"${lk_path}Documentation")
771 && (-d
"${lk_path}arch")
772 && (-d
"${lk_path}include")
773 && (-d
"${lk_path}drivers")
774 && (-d
"${lk_path}fs")
775 && (-d
"${lk_path}init")
776 && (-d
"${lk_path}ipc")
777 && (-d
"${lk_path}kernel")
778 && (-d
"${lk_path}lib")
779 && (-d
"${lk_path}scripts")) {
786 my ($formatted_email) = @_;
791 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
794 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
796 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
800 $name =~ s/^\s+|\s+$//g;
801 $name =~ s/^\"|\"$//g;
802 $address =~ s/^\s+|\s+$//g;
804 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
805 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
809 return ($name, $address);
813 my ($name, $address, $usename) = @_;
817 $name =~ s/^\s+|\s+$//g;
818 $name =~ s/^\"|\"$//g;
819 $address =~ s/^\s+|\s+$//g;
821 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
822 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
828 $formatted_email = "$address";
830 $formatted_email = "$name <$address>";
833 $formatted_email = $address;
836 return $formatted_email;
839 sub find_first_section
{
842 while ($index < @typevalue) {
843 my $tv = $typevalue[$index];
844 if (($tv =~ m/^(\C):\s*(.*)/)) {
853 sub find_starting_index
{
857 my $tv = $typevalue[$index];
858 if (!($tv =~ m/^(\C):\s*(.*)/)) {
867 sub find_ending_index
{
870 while ($index < @typevalue) {
871 my $tv = $typevalue[$index];
872 if (!($tv =~ m/^(\C):\s*(.*)/)) {
881 sub get_maintainer_role
{
885 my $start = find_starting_index
($index);
886 my $end = find_ending_index
($index);
889 my $subsystem = $typevalue[$start];
890 if (length($subsystem) > 20) {
891 $subsystem = substr($subsystem, 0, 17);
892 $subsystem =~ s/\s*$//;
893 $subsystem = $subsystem . "...";
896 for ($i = $start + 1; $i < $end; $i++) {
897 my $tv = $typevalue[$i];
898 if ($tv =~ m/^(\C):\s*(.*)/) {
908 if ($role eq "supported") {
910 } elsif ($role eq "maintained") {
911 $role = "maintainer";
912 } elsif ($role eq "odd fixes") {
914 } elsif ($role eq "orphan") {
915 $role = "orphan minder";
916 } elsif ($role eq "obsolete") {
917 $role = "obsolete minder";
918 } elsif ($role eq "buried alive in reporters") {
919 $role = "chief penguin";
922 return $role . ":" . $subsystem;
929 my $start = find_starting_index
($index);
930 my $end = find_ending_index
($index);
932 my $subsystem = $typevalue[$start];
933 if (length($subsystem) > 20) {
934 $subsystem = substr($subsystem, 0, 17);
935 $subsystem =~ s/\s*$//;
936 $subsystem = $subsystem . "...";
939 if ($subsystem eq "THE REST") {
950 my $start = find_starting_index
($index);
951 my $end = find_ending_index
($index);
953 push(@subsystem, $typevalue[$start]);
955 for ($i = $start + 1; $i < $end; $i++) {
956 my $tv = $typevalue[$i];
957 if ($tv =~ m/^(\C):\s*(.*)/) {
961 my $list_address = $pvalue;
962 my $list_additional = "";
963 my $list_role = get_list_role
($i);
965 if ($list_role ne "") {
966 $list_role = ":" . $list_role;
968 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
970 $list_additional = $2;
972 if ($list_additional =~ m/subscribers-only/) {
973 if ($email_subscriber_list) {
974 if (!$hash_list_to{lc($list_address)}) {
975 $hash_list_to{lc($list_address)} = 1;
976 push(@list_to, [$list_address,
977 "subscriber list${list_role}"]);
982 if (!$hash_list_to{lc($list_address)}) {
983 $hash_list_to{lc($list_address)} = 1;
984 push(@list_to, [$list_address,
985 "open list${list_role}"]);
989 } elsif ($ptype eq "M") {
990 my ($name, $address) = parse_email
($pvalue);
993 my $tv = $typevalue[$i - 1];
994 if ($tv =~ m/^(\C):\s*(.*)/) {
997 $pvalue = format_email
($name, $address, $email_usename);
1002 if ($email_maintainer) {
1003 my $role = get_maintainer_role
($i);
1004 push_email_addresses
($pvalue, $role);
1006 } elsif ($ptype eq "T") {
1007 push(@scm, $pvalue);
1008 } elsif ($ptype eq "W") {
1009 push(@web, $pvalue);
1010 } elsif ($ptype eq "S") {
1011 push(@status, $pvalue);
1018 my ($name, $address) = @_;
1020 return 1 if (($name eq "") && ($address eq ""));
1021 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1022 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1027 sub push_email_address
{
1028 my ($line, $role) = @_;
1030 my ($name, $address) = parse_email
($line);
1032 if ($address eq "") {
1036 if (!$email_remove_duplicates) {
1037 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1038 } elsif (!email_inuse
($name, $address)) {
1039 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1040 $email_hash_name{lc($name)}++ if ($name ne "");
1041 $email_hash_address{lc($address)}++;
1047 sub push_email_addresses
{
1048 my ($address, $role) = @_;
1050 my @address_list = ();
1052 if (rfc822_valid
($address)) {
1053 push_email_address
($address, $role);
1054 } elsif (@address_list = rfc822_validlist
($address)) {
1055 my $array_count = shift(@address_list);
1056 while (my $entry = shift(@address_list)) {
1057 push_email_address
($entry, $role);
1060 if (!push_email_address
($address, $role)) {
1061 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1067 my ($line, $role) = @_;
1069 my ($name, $address) = parse_email
($line);
1070 my $email = format_email
($name, $address, $email_usename);
1072 foreach my $entry (@email_to) {
1073 if ($email_remove_duplicates) {
1074 my ($entry_name, $entry_address) = parse_email
($entry->[0]);
1075 if (($name eq $entry_name || $address eq $entry_address)
1076 && ($role eq "" || !($entry->[1] =~ m/$role/))
1078 if ($entry->[1] eq "") {
1079 $entry->[1] = "$role";
1081 $entry->[1] = "$entry->[1],$role";
1085 if ($email eq $entry->[0]
1086 && ($role eq "" || !($entry->[1] =~ m/$role/))
1088 if ($entry->[1] eq "") {
1089 $entry->[1] = "$role";
1091 $entry->[1] = "$entry->[1],$role";
1101 foreach my $path (split(/:/, $ENV{PATH
})) {
1102 if (-e
"$path/$bin") {
1103 return "$path/$bin";
1113 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1114 if (-e
"$path/$conf") {
1115 return "$path/$conf";
1125 my ($name, $address) = parse_email
($line);
1126 my $email = format_email
($name, $address, 1);
1127 my $real_name = $name;
1128 my $real_address = $address;
1130 if (exists $mailmap->{names
}->{$email} ||
1131 exists $mailmap->{addresses
}->{$email}) {
1132 if (exists $mailmap->{names
}->{$email}) {
1133 $real_name = $mailmap->{names
}->{$email};
1135 if (exists $mailmap->{addresses
}->{$email}) {
1136 $real_address = $mailmap->{addresses
}->{$email};
1139 if (exists $mailmap->{names
}->{$address}) {
1140 $real_name = $mailmap->{names
}->{$address};
1142 if (exists $mailmap->{addresses
}->{$address}) {
1143 $real_address = $mailmap->{addresses
}->{$address};
1146 return format_email
($real_name, $real_address, 1);
1150 my (@addresses) = @_;
1152 my @mapped_emails = ();
1153 foreach my $line (@addresses) {
1154 push(@mapped_emails, mailmap_email
($line));
1156 merge_by_realname
(@mapped_emails) if ($email_use_mailmap);
1157 return @mapped_emails;
1160 sub merge_by_realname
{
1164 foreach my $email (@emails) {
1165 my ($name, $address) = parse_email
($email);
1166 if (exists $address_map{$name}) {
1167 $address = $address_map{$name};
1168 $email = format_email
($name, $address, 1);
1170 $address_map{$name} = $address;
1175 sub git_execute_cmd
{
1179 my $output = `$cmd`;
1180 $output =~ s/^\s*//gm;
1181 @lines = split("\n", $output);
1186 sub hg_execute_cmd
{
1190 my $output = `$cmd`;
1191 @lines = split("\n", $output);
1196 sub extract_formatted_signatures
{
1197 my (@signature_lines) = @_;
1199 my @type = @signature_lines;
1201 s/\s*(.*):.*/$1/ for (@type);
1204 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1206 ## Reformat email addresses (with names) to avoid badly written signatures
1208 foreach my $signer (@signature_lines) {
1209 $signer = deduplicate_email
($signer);
1212 return (\
@type, \
@signature_lines);
1215 sub vcs_find_signers
{
1219 my @signatures = ();
1221 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1223 my $pattern = $VCS_cmds{"commit_pattern"};
1225 $commits = grep(/$pattern/, @lines); # of commits
1227 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1229 return (0, @signatures) if !@signatures;
1231 save_commits_by_author
(@lines) if ($interactive);
1232 save_commits_by_signer
(@lines) if ($interactive);
1234 if (!$email_git_penguin_chiefs) {
1235 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1238 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1240 return ($commits, @
$signers_ref);
1243 sub vcs_find_author
{
1247 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1249 if (!$email_git_penguin_chiefs) {
1250 @lines = grep(!/${penguin_chiefs}/i, @lines);
1253 return @lines if !@lines;
1256 foreach my $line (@lines) {
1257 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1259 my ($name, $address) = parse_email
($author);
1260 $author = format_email
($name, $address, 1);
1261 push(@authors, $author);
1265 save_commits_by_author
(@lines) if ($interactive);
1266 save_commits_by_signer
(@lines) if ($interactive);
1271 sub vcs_save_commits
{
1276 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1278 foreach my $line (@lines) {
1279 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1292 return @commits if (!(-f
$file));
1294 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1295 my @all_commits = ();
1297 $cmd = $VCS_cmds{"blame_file_cmd"};
1298 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1299 @all_commits = vcs_save_commits
($cmd);
1301 foreach my $file_range_diff (@range) {
1302 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1304 my $diff_start = $2;
1305 my $diff_length = $3;
1306 next if ("$file" ne "$diff_file");
1307 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1308 push(@commits, $all_commits[$i]);
1312 foreach my $file_range_diff (@range) {
1313 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1315 my $diff_start = $2;
1316 my $diff_length = $3;
1317 next if ("$file" ne "$diff_file");
1318 $cmd = $VCS_cmds{"blame_range_cmd"};
1319 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1320 push(@commits, vcs_save_commits
($cmd));
1323 $cmd = $VCS_cmds{"blame_file_cmd"};
1324 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1325 @commits = vcs_save_commits
($cmd);
1328 foreach my $commit (@commits) {
1329 $commit =~ s/^\^//g;
1335 my $printed_novcs = 0;
1337 %VCS_cmds = %VCS_cmds_git;
1338 return 1 if eval $VCS_cmds{"available"};
1339 %VCS_cmds = %VCS_cmds_hg;
1340 return 2 if eval $VCS_cmds{"available"};
1342 if (!$printed_novcs) {
1343 warn("$P: No supported VCS found. Add --nogit to options?\n");
1344 warn("Using a git repository produces better results.\n");
1345 warn("Try Linus Torvalds' latest git repository using:\n");
1346 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n");
1354 return $vcs_used == 1;
1358 return $vcs_used == 2;
1361 sub interactive_get_maintainers
{
1362 my ($list_ref) = @_;
1363 my @list = @
$list_ref;
1372 foreach my $entry (@list) {
1373 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1374 $selected{$count} = 1;
1375 $authored{$count} = 0;
1376 $signed{$count} = 0;
1382 my $print_options = 0;
1387 printf STDERR
"\n%1s %2s %-65s",
1388 "*", "#", "email/list and role:stats";
1390 ($email_git_fallback && !$maintained) ||
1392 print STDERR
"auth sign";
1395 foreach my $entry (@list) {
1396 my $email = $entry->[0];
1397 my $role = $entry->[1];
1399 $sel = "*" if ($selected{$count});
1400 my $commit_author = $commit_author_hash{$email};
1401 my $commit_signer = $commit_signer_hash{$email};
1404 $authored++ for (@
{$commit_author});
1405 $signed++ for (@
{$commit_signer});
1406 printf STDERR
"%1s %2d %-65s", $sel, $count + 1, $email;
1407 printf STDERR
"%4d %4d", $authored, $signed
1408 if ($authored > 0 || $signed > 0);
1409 printf STDERR
"\n %s\n", $role;
1410 if ($authored{$count}) {
1411 my $commit_author = $commit_author_hash{$email};
1412 foreach my $ref (@
{$commit_author}) {
1413 print STDERR
" Author: @{$ref}[1]\n";
1416 if ($signed{$count}) {
1417 my $commit_signer = $commit_signer_hash{$email};
1418 foreach my $ref (@
{$commit_signer}) {
1419 print STDERR
" @{$ref}[2]: @{$ref}[1]\n";
1426 my $date_ref = \
$email_git_since;
1427 $date_ref = \
$email_hg_since if (vcs_is_hg
());
1428 if ($print_options) {
1433 Version Control options:
1434 g use git history [$email_git]
1435 gf use git-fallback [$email_git_fallback]
1436 b use git blame [$email_git_blame]
1437 bs use blame signatures [$email_git_blame_signatures]
1438 c# minimum commits [$email_git_min_signatures]
1439 %# min percent [$email_git_min_percent]
1440 d# history to use [$$date_ref]
1441 x# max maintainers [$email_git_max_maintainers]
1442 t all signature types [$email_git_all_signature_types]
1443 m use .mailmap [$email_use_mailmap]
1450 tm toggle maintainers
1451 tg toggle git entries
1452 tl toggle open list entries
1453 ts toggle subscriber list entries
1454 f emails in file [$file_emails]
1455 k keywords in file [$keywords]
1456 r remove duplicates [$email_remove_duplicates]
1457 p# pattern match depth [$pattern_depth]
1461 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1463 my $input = <STDIN
>;
1468 my @wish = split(/[, ]+/, $input);
1469 foreach my $nr (@wish) {
1471 my $sel = substr($nr, 0, 1);
1472 my $str = substr($nr, 1);
1474 $val = $1 if $str =~ /^(\d+)$/;
1479 $output_rolestats = 0;
1482 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1483 $selected{$nr - 1} = !$selected{$nr - 1};
1484 } elsif ($sel eq "*" || $sel eq '^') {
1486 $toggle = 1 if ($sel eq '*');
1487 for (my $i = 0; $i < $count; $i++) {
1488 $selected{$i} = $toggle;
1490 } elsif ($sel eq "0") {
1491 for (my $i = 0; $i < $count; $i++) {
1492 $selected{$i} = !$selected{$i};
1494 } elsif ($sel eq "t") {
1495 if (lc($str) eq "m") {
1496 for (my $i = 0; $i < $count; $i++) {
1497 $selected{$i} = !$selected{$i}
1498 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1500 } elsif (lc($str) eq "g") {
1501 for (my $i = 0; $i < $count; $i++) {
1502 $selected{$i} = !$selected{$i}
1503 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1505 } elsif (lc($str) eq "l") {
1506 for (my $i = 0; $i < $count; $i++) {
1507 $selected{$i} = !$selected{$i}
1508 if ($list[$i]->[1] =~ /^(open list)/i);
1510 } elsif (lc($str) eq "s") {
1511 for (my $i = 0; $i < $count; $i++) {
1512 $selected{$i} = !$selected{$i}
1513 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1516 } elsif ($sel eq "a") {
1517 if ($val > 0 && $val <= $count) {
1518 $authored{$val - 1} = !$authored{$val - 1};
1519 } elsif ($str eq '*' || $str eq '^') {
1521 $toggle = 1 if ($str eq '*');
1522 for (my $i = 0; $i < $count; $i++) {
1523 $authored{$i} = $toggle;
1526 } elsif ($sel eq "s") {
1527 if ($val > 0 && $val <= $count) {
1528 $signed{$val - 1} = !$signed{$val - 1};
1529 } elsif ($str eq '*' || $str eq '^') {
1531 $toggle = 1 if ($str eq '*');
1532 for (my $i = 0; $i < $count; $i++) {
1533 $signed{$i} = $toggle;
1536 } elsif ($sel eq "o") {
1539 } elsif ($sel eq "g") {
1541 bool_invert
(\
$email_git_fallback);
1543 bool_invert
(\
$email_git);
1546 } elsif ($sel eq "b") {
1548 bool_invert
(\
$email_git_blame_signatures);
1550 bool_invert
(\
$email_git_blame);
1553 } elsif ($sel eq "c") {
1555 $email_git_min_signatures = $val;
1558 } elsif ($sel eq "x") {
1560 $email_git_max_maintainers = $val;
1563 } elsif ($sel eq "%") {
1564 if ($str ne "" && $val >= 0) {
1565 $email_git_min_percent = $val;
1568 } elsif ($sel eq "d") {
1570 $email_git_since = $str;
1571 } elsif (vcs_is_hg
()) {
1572 $email_hg_since = $str;
1575 } elsif ($sel eq "t") {
1576 bool_invert
(\
$email_git_all_signature_types);
1578 } elsif ($sel eq "f") {
1579 bool_invert
(\
$file_emails);
1581 } elsif ($sel eq "r") {
1582 bool_invert
(\
$email_remove_duplicates);
1584 } elsif ($sel eq "m") {
1585 bool_invert
(\
$email_use_mailmap);
1588 } elsif ($sel eq "k") {
1589 bool_invert
(\
$keywords);
1591 } elsif ($sel eq "p") {
1592 if ($str ne "" && $val >= 0) {
1593 $pattern_depth = $val;
1596 } elsif ($sel eq "h" || $sel eq "?") {
1599 Interactive mode allows you to select the various maintainers, submitters,
1600 commit signers and mailing lists that could be CC'd on a patch.
1602 Any *'d entry is selected.
1604 If you have git or hg installed, you can choose to summarize the commit
1605 history of files in the patch. Also, each line of the current file can
1606 be matched to its commit author and that commits signers with blame.
1608 Various knobs exist to control the length of time for active commit
1609 tracking, the maximum number of commit authors and signers to add,
1612 Enter selections at the prompt until you are satisfied that the selected
1613 maintainers are appropriate. You may enter multiple selections separated
1614 by either commas or spaces.
1618 print STDERR
"invalid option: '$nr'\n";
1623 print STDERR
"git-blame can be very slow, please have patience..."
1624 if ($email_git_blame);
1625 goto &get_maintainers
;
1629 #drop not selected entries
1631 my @new_emailto = ();
1632 foreach my $entry (@list) {
1633 if ($selected{$count}) {
1634 push(@new_emailto, $list[$count]);
1638 return @new_emailto;
1642 my ($bool_ref) = @_;
1651 sub deduplicate_email
{
1655 my ($name, $address) = parse_email
($email);
1656 $email = format_email
($name, $address, 1);
1657 $email = mailmap_email
($email);
1659 return $email if (!$email_remove_duplicates);
1661 ($name, $address) = parse_email
($email);
1663 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1664 $name = $deduplicate_name_hash{lc($name)}->[0];
1665 $address = $deduplicate_name_hash{lc($name)}->[1];
1667 } elsif ($deduplicate_address_hash{lc($address)}) {
1668 $name = $deduplicate_address_hash{lc($address)}->[0];
1669 $address = $deduplicate_address_hash{lc($address)}->[1];
1673 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1674 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1676 $email = format_email
($name, $address, 1);
1677 $email = mailmap_email
($email);
1681 sub save_commits_by_author
{
1688 foreach my $line (@lines) {
1689 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1691 $author = deduplicate_email
($author);
1692 push(@authors, $author);
1694 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1695 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1698 for (my $i = 0; $i < @authors; $i++) {
1700 foreach my $ref(@
{$commit_author_hash{$authors[$i]}}) {
1701 if (@
{$ref}[0] eq $commits[$i] &&
1702 @
{$ref}[1] eq $subjects[$i]) {
1708 push(@
{$commit_author_hash{$authors[$i]}},
1709 [ ($commits[$i], $subjects[$i]) ]);
1714 sub save_commits_by_signer
{
1720 foreach my $line (@lines) {
1721 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1722 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1723 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1724 my @signatures = ($line);
1725 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1726 my @types = @
$types_ref;
1727 my @signers = @
$signers_ref;
1729 my $type = $types[0];
1730 my $signer = $signers[0];
1732 $signer = deduplicate_email
($signer);
1735 foreach my $ref(@
{$commit_signer_hash{$signer}}) {
1736 if (@
{$ref}[0] eq $commit &&
1737 @
{$ref}[1] eq $subject &&
1738 @
{$ref}[2] eq $type) {
1744 push(@
{$commit_signer_hash{$signer}},
1745 [ ($commit, $subject, $type) ]);
1752 my ($role, $divisor, @lines) = @_;
1757 return if (@lines <= 0);
1759 if ($divisor <= 0) {
1760 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1764 @lines = mailmap
(@lines);
1766 return if (@lines <= 0);
1768 @lines = sort(@lines);
1771 $hash{$_}++ for @lines;
1774 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1775 my $sign_offs = $hash{$line};
1776 my $percent = $sign_offs * 100 / $divisor;
1778 $percent = 100 if ($percent > 100);
1780 last if ($sign_offs < $email_git_min_signatures ||
1781 $count > $email_git_max_maintainers ||
1782 $percent < $email_git_min_percent);
1783 push_email_address
($line, '');
1784 if ($output_rolestats) {
1785 my $fmt_percent = sprintf("%.0f", $percent);
1786 add_role
($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1788 add_role
($line, $role);
1793 sub vcs_file_signoffs
{
1799 $vcs_used = vcs_exists
();
1800 return if (!$vcs_used);
1802 my $cmd = $VCS_cmds{"find_signers_cmd"};
1803 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1805 ($commits, @signers) = vcs_find_signers
($cmd);
1807 foreach my $signer (@signers) {
1808 $signer = deduplicate_email
($signer);
1811 vcs_assign
("commit_signer", $commits, @signers);
1814 sub vcs_file_blame
{
1818 my @all_commits = ();
1823 $vcs_used = vcs_exists
();
1824 return if (!$vcs_used);
1826 @all_commits = vcs_blame
($file);
1827 @commits = uniq
(@all_commits);
1828 $total_commits = @commits;
1829 $total_lines = @all_commits;
1831 if ($email_git_blame_signatures) {
1834 my @commit_signers = ();
1835 my $commit = join(" -r ", @commits);
1838 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1839 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1841 ($commit_count, @commit_signers) = vcs_find_signers
($cmd);
1843 push(@signers, @commit_signers);
1845 foreach my $commit (@commits) {
1847 my @commit_signers = ();
1850 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1851 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1853 ($commit_count, @commit_signers) = vcs_find_signers
($cmd);
1855 push(@signers, @commit_signers);
1860 if ($from_filename) {
1861 if ($output_rolestats) {
1863 if (vcs_is_hg
()) {{ # Double brace for last exit
1865 my @commit_signers = ();
1866 @commits = uniq
(@commits);
1867 @commits = sort(@commits);
1868 my $commit = join(" -r ", @commits);
1871 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1872 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1876 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1878 if (!$email_git_penguin_chiefs) {
1879 @lines = grep(!/${penguin_chiefs}/i, @lines);
1885 foreach my $line (@lines) {
1886 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1888 $author = deduplicate_email
($author);
1889 push(@authors, $author);
1893 save_commits_by_author
(@lines) if ($interactive);
1894 save_commits_by_signer
(@lines) if ($interactive);
1896 push(@signers, @authors);
1899 foreach my $commit (@commits) {
1901 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1902 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1903 my @author = vcs_find_author
($cmd);
1906 my $formatted_author = deduplicate_email
($author[0]);
1908 my $count = grep(/$commit/, @all_commits);
1909 for ($i = 0; $i < $count ; $i++) {
1910 push(@blame_signers, $formatted_author);
1914 if (@blame_signers) {
1915 vcs_assign
("authored lines", $total_lines, @blame_signers);
1918 foreach my $signer (@signers) {
1919 $signer = deduplicate_email
($signer);
1921 vcs_assign
("commits", $total_commits, @signers);
1923 foreach my $signer (@signers) {
1924 $signer = deduplicate_email
($signer);
1926 vcs_assign
("modified commits", $total_commits, @signers);
1934 @parms = grep(!$saw{$_}++, @parms);
1942 @parms = sort @parms;
1943 @parms = grep(!$saw{$_}++, @parms);
1947 sub clean_file_emails
{
1948 my (@file_emails) = @_;
1949 my @fmt_emails = ();
1951 foreach my $email (@file_emails) {
1952 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1953 my ($name, $address) = parse_email
($email);
1954 if ($name eq '"[,\.]"') {
1958 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1960 my $first = $nw[@nw - 3];
1961 my $middle = $nw[@nw - 2];
1962 my $last = $nw[@nw - 1];
1964 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1965 (length($first) == 2 && substr($first, -1) eq ".")) ||
1966 (length($middle) == 1 ||
1967 (length($middle) == 2 && substr($middle, -1) eq "."))) {
1968 $name = "$first $middle $last";
1970 $name = "$middle $last";
1974 if (substr($name, -1) =~ /[,\.]/) {
1975 $name = substr($name, 0, length($name) - 1);
1976 } elsif (substr($name, -2) =~ /[,\.]"/) {
1977 $name = substr($name, 0, length($name) - 2) . '"';
1980 if (substr($name, 0, 1) =~ /[,\.]/) {
1981 $name = substr($name, 1, length($name) - 1);
1982 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
1983 $name = '"' . substr($name, 2, length($name) - 2);
1986 my $fmt_email = format_email
($name, $address, $email_usename);
1987 push(@fmt_emails, $fmt_email);
1997 my ($address, $role) = @
$_;
1998 if (!$saw{$address}) {
1999 if ($output_roles) {
2000 push(@lines, "$address ($role)");
2002 push(@lines, $address);
2014 if ($output_multiline) {
2015 foreach my $line (@parms) {
2019 print(join($output_separator, @parms));
2027 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2028 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2029 # This regexp will only work on addresses which have had comments stripped
2030 # and replaced with rfc822_lwsp.
2032 my $specials = '()<>@,;:\\\\".\\[\\]';
2033 my $controls = '\\000-\\037\\177';
2035 my $dtext = "[^\\[\\]\\r\\\\]";
2036 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2038 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2040 # Use zero-width assertion to spot the limit of an atom. A simple
2041 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2042 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2043 my $word = "(?:$atom|$quoted_string)";
2044 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2046 my $sub_domain = "(?:$atom|$domain_literal)";
2047 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2049 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2051 my $phrase = "$word*";
2052 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2053 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2054 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2056 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2057 my $address = "(?:$mailbox|$group)";
2059 return "$rfc822_lwsp*$address";
2062 sub rfc822_strip_comments
{
2064 # Recursively remove comments, and replace with a single space. The simpler
2065 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2066 # chars in atoms, for example.
2068 while ($s =~ s
/^((?
:[^"\\]|\\.)*
2069 (?:"(?
:[^"\\]|\\.)*"(?
:[^"\\]|\\.)*)*)
2070 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2074 # valid: returns true if the parameter is an RFC822 valid address
2077 my $s = rfc822_strip_comments(shift);
2080 $rfc822re = make_rfc822re();
2083 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2086 # validlist: In scalar context, returns true if the parameter is an RFC822
2087 # valid list of addresses.
2089 # In list context, returns an empty list on failure (an invalid
2090 # address was found); otherwise a list whose first element is the
2091 # number of addresses found and whose remaining elements are the
2092 # addresses. This is needed to disambiguate failure (invalid)
2093 # from success with no addresses found, because an empty string is
2096 sub rfc822_validlist {
2097 my $s = rfc822_strip_comments(shift);
2100 $rfc822re = make_rfc822re();
2102 # * null list items are valid according to the RFC
2103 # * the '1' business is to aid in distinguishing failure from no results
2106 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2107 $s =~ m/^$rfc822_char*$/) {
2108 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2111 return wantarray ? (scalar(@r), @r) : 1;
2113 return wantarray ? () : 0;