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;
24 my $email_reviewer = 1;
26 my $email_subscriber_list = 0;
27 my $email_git_penguin_chiefs = 0;
29 my $email_git_all_signature_types = 0;
30 my $email_git_blame = 0;
31 my $email_git_blame_signatures = 1;
32 my $email_git_fallback = 1;
33 my $email_git_min_signatures = 1;
34 my $email_git_max_maintainers = 5;
35 my $email_git_min_percent = 5;
36 my $email_git_since = "1-year-ago";
37 my $email_hg_since = "-365";
39 my $email_remove_duplicates = 1;
40 my $email_use_mailmap = 1;
41 my $output_multiline = 1;
42 my $output_separator = ", ";
44 my $output_rolestats = 1;
52 my $from_filename = 0;
53 my $pattern_depth = 0;
61 my %commit_author_hash;
62 my %commit_signer_hash;
64 my @penguin_chief = ();
65 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
66 #Andrew wants in on most everything - 2009/01/14
67 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
69 my @penguin_chief_names = ();
70 foreach my $chief (@penguin_chief) {
71 if ($chief =~ m/^(.*):(.*)/) {
74 push(@penguin_chief_names, $chief_name);
77 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
79 # Signature types of people who are either
80 # a) responsible for the code in question, or
81 # b) familiar enough with it to give relevant feedback
82 my @signature_tags = ();
83 push(@signature_tags, "Signed-off-by:");
84 push(@signature_tags, "Reviewed-by:");
85 push(@signature_tags, "Acked-by:");
87 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
89 # rfc822 email address - preloaded methods go here.
90 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
91 my $rfc822_char = '[\\000-\\377]';
93 # VCS command support: class-like functions and strings
98 "execute_cmd" => \
&git_execute_cmd
,
99 "available" => '(which("git") ne "") && (-e ".git")',
100 "find_signers_cmd" =>
101 "git log --no-color --follow --since=\$email_git_since " .
102 '--numstat --no-merges ' .
103 '--format="GitCommit: %H%n' .
104 'GitAuthor: %an <%ae>%n' .
109 "find_commit_signers_cmd" =>
110 "git log --no-color " .
112 '--format="GitCommit: %H%n' .
113 'GitAuthor: %an <%ae>%n' .
118 "find_commit_author_cmd" =>
119 "git log --no-color " .
121 '--format="GitCommit: %H%n' .
122 'GitAuthor: %an <%ae>%n' .
124 'GitSubject: %s%n"' .
126 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
127 "blame_file_cmd" => "git blame -l \$file",
128 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
129 "blame_commit_pattern" => "^([0-9a-f]+) ",
130 "author_pattern" => "^GitAuthor: (.*)",
131 "subject_pattern" => "^GitSubject: (.*)",
132 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
136 "execute_cmd" => \
&hg_execute_cmd
,
137 "available" => '(which("hg") ne "") && (-d ".hg")',
138 "find_signers_cmd" =>
139 "hg log --date=\$email_hg_since " .
140 "--template='HgCommit: {node}\\n" .
141 "HgAuthor: {author}\\n" .
142 "HgSubject: {desc}\\n'" .
144 "find_commit_signers_cmd" =>
146 "--template='HgSubject: {desc}\\n'" .
148 "find_commit_author_cmd" =>
150 "--template='HgCommit: {node}\\n" .
151 "HgAuthor: {author}\\n" .
152 "HgSubject: {desc|firstline}\\n'" .
154 "blame_range_cmd" => "", # not supported
155 "blame_file_cmd" => "hg blame -n \$file",
156 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
157 "blame_commit_pattern" => "^([ 0-9a-f]+):",
158 "author_pattern" => "^HgAuthor: (.*)",
159 "subject_pattern" => "^HgSubject: (.*)",
160 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
163 my $conf = which_conf
(".get_maintainer.conf");
166 open(my $conffile, '<', "$conf")
167 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
169 while (<$conffile>) {
172 $line =~ s/\s*\n?$//g;
176 next if ($line =~ m/^\s*#/);
177 next if ($line =~ m/^\s*$/);
179 my @words = split(" ", $line);
180 foreach my $word (@words) {
181 last if ($word =~ m/^#/);
182 push (@conf_args, $word);
186 unshift(@ARGV, @conf_args) if @conf_args;
189 my @ignore_emails = ();
190 my $ignore_file = which_conf
(".get_maintainer.ignore");
191 if (-f
$ignore_file) {
192 open(my $ignore, '<', "$ignore_file")
193 or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
197 $line =~ s/\s*\n?$//;
202 next if ($line =~ m/^\s*$/);
203 if (rfc822_valid
($line)) {
204 push(@ignore_emails, $line);
212 'git!' => \
$email_git,
213 'git-all-signature-types!' => \
$email_git_all_signature_types,
214 'git-blame!' => \
$email_git_blame,
215 'git-blame-signatures!' => \
$email_git_blame_signatures,
216 'git-fallback!' => \
$email_git_fallback,
217 'git-chief-penguins!' => \
$email_git_penguin_chiefs,
218 'git-min-signatures=i' => \
$email_git_min_signatures,
219 'git-max-maintainers=i' => \
$email_git_max_maintainers,
220 'git-min-percent=i' => \
$email_git_min_percent,
221 'git-since=s' => \
$email_git_since,
222 'hg-since=s' => \
$email_hg_since,
223 'i|interactive!' => \
$interactive,
224 'remove-duplicates!' => \
$email_remove_duplicates,
225 'mailmap!' => \
$email_use_mailmap,
226 'm!' => \
$email_maintainer,
227 'r!' => \
$email_reviewer,
228 'n!' => \
$email_usename,
229 'l!' => \
$email_list,
230 's!' => \
$email_subscriber_list,
231 'multiline!' => \
$output_multiline,
232 'roles!' => \
$output_roles,
233 'rolestats!' => \
$output_rolestats,
234 'separator=s' => \
$output_separator,
235 'subsystem!' => \
$subsystem,
236 'status!' => \
$status,
239 'pattern-depth=i' => \
$pattern_depth,
240 'k|keywords!' => \
$keywords,
241 'sections!' => \
$sections,
242 'fe|file-emails!' => \
$file_emails,
243 'f|file' => \
$from_filename,
244 'v|version' => \
$version,
245 'h|help|usage' => \
$help,
247 die "$P: invalid argument - use --help if necessary\n";
256 print("${P} ${V}\n");
260 if (-t STDIN
&& !@ARGV) {
261 # We're talking to a terminal, but have no command line arguments.
262 die "$P: missing patchfile or -f file - use --help if necessary\n";
265 $output_multiline = 0 if ($output_separator ne ", ");
266 $output_rolestats = 1 if ($interactive);
267 $output_roles = 1 if ($output_rolestats);
279 my $selections = $email + $scm + $status + $subsystem + $web;
280 if ($selections == 0) {
281 die "$P: Missing required option: email, scm, status, subsystem or web\n";
286 ($email_maintainer + $email_reviewer +
287 $email_list + $email_subscriber_list +
288 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
289 die "$P: Please select at least 1 email option\n";
292 if (!top_of_kernel_tree
($lk_path)) {
293 die "$P: The current directory does not appear to be "
294 . "a linux kernel source tree.\n";
297 ## Read MAINTAINERS for type/value pairs
302 open (my $maint, '<', "${lk_path}MAINTAINERS")
303 or die "$P: Can't open MAINTAINERS: $!\n";
307 if ($line =~ m/^(\C):\s*(.*)/) {
311 ##Filename pattern matching
312 if ($type eq "F" || $type eq "X") {
313 $value =~ s@\
.@
\\\
.@g; ##Convert . to \.
314 $value =~ s/\*/\.\*/g; ##Convert * to .*
315 $value =~ s/\?/\./g; ##Convert ? to .
316 ##if pattern is a directory and it lacks a trailing slash, add one
318 $value =~ s@
([^/])$@$1/@
;
320 } elsif ($type eq "K") {
321 $keyword_hash{@typevalue} = $value;
323 push(@typevalue, "$type:$value");
324 } elsif (!/^(\s)*$/) {
326 push(@typevalue, $line);
333 # Read mail address map
346 return if (!$email_use_mailmap || !(-f
"${lk_path}.mailmap"));
348 open(my $mailmap_file, '<', "${lk_path}.mailmap")
349 or warn "$P: Can't open .mailmap: $!\n";
351 while (<$mailmap_file>) {
352 s/#.*$//; #strip comments
353 s/^\s+|\s+$//g; #trim
355 next if (/^\s*$/); #skip empty lines
356 #entries have one of the following formats:
359 # name1 <mail1> <mail2>
360 # name1 <mail1> name2 <mail2>
361 # (see man git-shortlog)
363 if (/^([^<]+)<([^>]+)>$/) {
367 $real_name =~ s/\s+$//;
368 ($real_name, $address) = parse_email
("$real_name <$address>");
369 $mailmap->{names
}->{$address} = $real_name;
371 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
372 my $real_address = $1;
373 my $wrong_address = $2;
375 $mailmap->{addresses
}->{$wrong_address} = $real_address;
377 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
379 my $real_address = $2;
380 my $wrong_address = $3;
382 $real_name =~ s/\s+$//;
383 ($real_name, $real_address) =
384 parse_email
("$real_name <$real_address>");
385 $mailmap->{names
}->{$wrong_address} = $real_name;
386 $mailmap->{addresses
}->{$wrong_address} = $real_address;
388 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
390 my $real_address = $2;
392 my $wrong_address = $4;
394 $real_name =~ s/\s+$//;
395 ($real_name, $real_address) =
396 parse_email
("$real_name <$real_address>");
398 $wrong_name =~ s/\s+$//;
399 ($wrong_name, $wrong_address) =
400 parse_email
("$wrong_name <$wrong_address>");
402 my $wrong_email = format_email
($wrong_name, $wrong_address, 1);
403 $mailmap->{names
}->{$wrong_email} = $real_name;
404 $mailmap->{addresses
}->{$wrong_email} = $real_address;
407 close($mailmap_file);
410 ## use the filenames on the command line or find the filenames in the patchfiles
414 my @keyword_tvi = ();
415 my @file_emails = ();
418 push(@ARGV, "&STDIN");
421 foreach my $file (@ARGV) {
422 if ($file ne "&STDIN") {
423 ##if $file is a directory and it lacks a trailing slash, add one
425 $file =~ s@
([^/])$@$1/@
;
426 } elsif (!(-f
$file)) {
427 die "$P: file '${file}' not found\n";
430 if ($from_filename) {
432 if ($file ne "MAINTAINERS" && -f
$file && ($keywords || $file_emails)) {
433 open(my $f, '<', $file)
434 or die "$P: Can't open $file: $!\n";
435 my $text = do { local($/) ; <$f> };
438 foreach my $line (keys %keyword_hash) {
439 if ($text =~ m/$keyword_hash{$line}/x) {
440 push(@keyword_tvi, $line);
445 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;
446 push(@file_emails, clean_file_emails
(@poss_addr));
450 my $file_cnt = @files;
453 open(my $patch, "< $file")
454 or die "$P: Can't open $file: $!\n";
456 # We can check arbitrary information before the patch
457 # like the commit message, mail headers, etc...
458 # This allows us to match arbitrary keywords against any part
459 # of a git format-patch generated file (subject tags, etc...)
461 my $patch_prefix = ""; #Parsing the intro
465 if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
467 $filename =~ s@
^[^/]*/@@
;
469 $lastfile = $filename;
470 push(@files, $filename);
471 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
472 } elsif (m/^\@\@ -(\d+),(\d+)/) {
473 if ($email_git_blame) {
474 push(@range, "$lastfile:$1:$2");
476 } elsif ($keywords) {
477 foreach my $line (keys %keyword_hash) {
478 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
479 push(@keyword_tvi, $line);
486 if ($file_cnt == @files) {
487 warn "$P: file '${file}' doesn't appear to be a patch. "
488 . "Add -f to options?\n";
490 @files = sort_and_uniq
(@files);
494 @file_emails = uniq
(@file_emails);
497 my %email_hash_address;
505 my %deduplicate_name_hash = ();
506 my %deduplicate_address_hash = ();
508 my @maintainers = get_maintainers
();
511 @maintainers = merge_email
(@maintainers);
512 output
(@maintainers);
521 @status = uniq
(@status);
526 @subsystem = uniq
(@subsystem);
537 sub ignore_email_address
{
540 foreach my $ignore (@ignore_emails) {
541 return 1 if ($ignore eq $address);
547 sub range_is_maintained
{
548 my ($start, $end) = @_;
550 for (my $i = $start; $i < $end; $i++) {
551 my $line = $typevalue[$i];
552 if ($line =~ m/^(\C):\s*(.*)/) {
556 if ($value =~ /(maintain|support)/i) {
565 sub range_has_maintainer
{
566 my ($start, $end) = @_;
568 for (my $i = $start; $i < $end; $i++) {
569 my $line = $typevalue[$i];
570 if ($line =~ m/^(\C):\s*(.*)/) {
581 sub get_maintainers
{
582 %email_hash_name = ();
583 %email_hash_address = ();
584 %commit_author_hash = ();
585 %commit_signer_hash = ();
593 %deduplicate_name_hash = ();
594 %deduplicate_address_hash = ();
595 if ($email_git_all_signature_types) {
596 $signature_pattern = "(.+?)[Bb][Yy]:";
598 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
601 # Find responsible parties
603 my %exact_pattern_match_hash = ();
605 foreach my $file (@files) {
608 my $tvi = find_first_section
();
609 while ($tvi < @typevalue) {
610 my $start = find_starting_index
($tvi);
611 my $end = find_ending_index
($tvi);
615 #Do not match excluded file patterns
617 for ($i = $start; $i < $end; $i++) {
618 my $line = $typevalue[$i];
619 if ($line =~ m/^(\C):\s*(.*)/) {
623 if (file_match_pattern
($file, $value)) {
632 for ($i = $start; $i < $end; $i++) {
633 my $line = $typevalue[$i];
634 if ($line =~ m/^(\C):\s*(.*)/) {
638 if (file_match_pattern
($file, $value)) {
639 my $value_pd = ($value =~ tr@
/@@
);
640 my $file_pd = ($file =~ tr@
/@@
);
641 $value_pd++ if (substr($value,-1,1) ne "/");
642 $value_pd = -1 if ($value =~ /^\.\*/);
643 if ($value_pd >= $file_pd &&
644 range_is_maintained
($start, $end) &&
645 range_has_maintainer
($start, $end)) {
646 $exact_pattern_match_hash{$file} = 1;
648 if ($pattern_depth == 0 ||
649 (($file_pd - $value_pd) < $pattern_depth)) {
650 $hash{$tvi} = $value_pd;
653 } elsif ($type eq 'N') {
654 if ($file =~ m/$value/x) {
664 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
665 add_categories
($line);
668 my $start = find_starting_index
($line);
669 my $end = find_ending_index
($line);
670 for ($i = $start; $i < $end; $i++) {
671 my $line = $typevalue[$i];
672 if ($line =~ /^[FX]:/) { ##Restore file patterns
673 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
674 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
675 $line =~ s/\\\./\./g; ##Convert \. to .
676 $line =~ s/\.\*/\*/g; ##Convert .* to *
678 $line =~ s/^([A-Z]):/$1:\t/g;
687 @keyword_tvi = sort_and_uniq
(@keyword_tvi);
688 foreach my $line (@keyword_tvi) {
689 add_categories
($line);
693 foreach my $email (@email_to, @list_to) {
694 $email->[0] = deduplicate_email
($email->[0]);
697 foreach my $file (@files) {
699 ($email_git || ($email_git_fallback &&
700 !$exact_pattern_match_hash{$file}))) {
701 vcs_file_signoffs
($file);
703 if ($email && $email_git_blame) {
704 vcs_file_blame
($file);
709 foreach my $chief (@penguin_chief) {
710 if ($chief =~ m/^(.*):(.*)/) {
713 $email_address = format_email
($1, $2, $email_usename);
714 if ($email_git_penguin_chiefs) {
715 push(@email_to, [$email_address, 'chief penguin']);
717 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
722 foreach my $email (@file_emails) {
723 my ($name, $address) = parse_email
($email);
725 my $tmp_email = format_email
($name, $address, $email_usename);
726 push_email_address
($tmp_email, '');
727 add_role
($tmp_email, 'in file');
732 if ($email || $email_list) {
734 @to = (@to, @email_to);
737 @to = (@to, @list_to);
742 @to = interactive_get_maintainers
(\
@to);
748 sub file_match_pattern
{
749 my ($file, $pattern) = @_;
750 if (substr($pattern, -1) eq "/") {
751 if ($file =~ m@
^$pattern@
) {
755 if ($file =~ m@
^$pattern@
) {
756 my $s1 = ($file =~ tr@
/@@
);
757 my $s2 = ($pattern =~ tr@
/@@
);
768 usage: $P [options] patchfile
769 $P [options] -f file|directory
772 MAINTAINER field selection options:
773 --email => print email address(es) if any
774 --git => include recent git \*-by: signers
775 --git-all-signature-types => include signers regardless of signature type
776 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
777 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
778 --git-chief-penguins => include ${penguin_chiefs}
779 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
780 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
781 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
782 --git-blame => use git blame to find modified commits for patch or file
783 --git-since => git history to use (default: $email_git_since)
784 --hg-since => hg history to use (default: $email_hg_since)
785 --interactive => display a menu (mostly useful if used with the --git option)
786 --m => include maintainer(s) if any
787 --r => include reviewer(s) if any
788 --n => include name 'Full Name <addr\@domain.tld>'
789 --l => include list(s) if any
790 --s => include subscriber only list(s) if any
791 --remove-duplicates => minimize duplicate email names/addresses
792 --roles => show roles (status:subsystem, git-signer, list, etc...)
793 --rolestats => show roles and statistics (commits/total_commits, %)
794 --file-emails => add email addresses found in -f file (default: 0 (off))
795 --scm => print SCM tree(s) if any
796 --status => print status if any
797 --subsystem => print subsystem name if any
798 --web => print website(s) if any
801 --separator [, ] => separator for multiple entries on 1 line
802 using --separator also sets --nomultiline if --separator is not [, ]
803 --multiline => print 1 entry per line
806 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
807 --keywords => scan patch for keywords (default: $keywords)
808 --sections => print all of the subsystem sections with pattern matches
809 --mailmap => use .mailmap file (default: $email_use_mailmap)
810 --version => show version
811 --help => show this help information
814 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
815 --remove-duplicates --rolestats]
818 Using "-f directory" may give unexpected results:
819 Used with "--git", git signators for _all_ files in and below
820 directory are examined as git recurses directories.
821 Any specified X: (exclude) pattern matches are _not_ ignored.
822 Used with "--nogit", directory is used as a pattern match,
823 no individual file within the directory or subdirectory
825 Used with "--git-blame", does not iterate all files in directory
826 Using "--git-blame" is slow and may add old committers and authors
827 that are no longer active maintainers to the output.
828 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
829 other automated tools that expect only ["name"] <email address>
830 may not work because of additional output after <email address>.
831 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
832 not the percentage of the entire file authored. # of commits is
833 not a good measure of amount of code authored. 1 major commit may
834 contain a thousand lines, 5 trivial commits may modify a single line.
835 If git is not installed, but mercurial (hg) is installed and an .hg
836 repository exists, the following options apply to mercurial:
838 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
840 Use --hg-since not --git-since to control date selection
841 File ".get_maintainer.conf", if it exists in the linux kernel source root
842 directory, can change whatever get_maintainer defaults are desired.
843 Entries in this file can be any command line argument.
844 This file is prepended to any additional command line arguments.
845 Multiple lines and # comments are allowed.
849 sub top_of_kernel_tree
{
852 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
855 if ( (-f
"${lk_path}COPYING")
856 && (-f
"${lk_path}CREDITS")
857 && (-f
"${lk_path}Kbuild")
858 && (-f
"${lk_path}MAINTAINERS")
859 && (-f
"${lk_path}Makefile")
860 && (-f
"${lk_path}README")
861 && (-d
"${lk_path}Documentation")
862 && (-d
"${lk_path}arch")
863 && (-d
"${lk_path}include")
864 && (-d
"${lk_path}drivers")
865 && (-d
"${lk_path}fs")
866 && (-d
"${lk_path}init")
867 && (-d
"${lk_path}ipc")
868 && (-d
"${lk_path}kernel")
869 && (-d
"${lk_path}lib")
870 && (-d
"${lk_path}scripts")) {
877 my ($formatted_email) = @_;
882 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
885 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
887 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
891 $name =~ s/^\s+|\s+$//g;
892 $name =~ s/^\"|\"$//g;
893 $address =~ s/^\s+|\s+$//g;
895 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
896 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
900 return ($name, $address);
904 my ($name, $address, $usename) = @_;
908 $name =~ s/^\s+|\s+$//g;
909 $name =~ s/^\"|\"$//g;
910 $address =~ s/^\s+|\s+$//g;
912 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
913 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
919 $formatted_email = "$address";
921 $formatted_email = "$name <$address>";
924 $formatted_email = $address;
927 return $formatted_email;
930 sub find_first_section
{
933 while ($index < @typevalue) {
934 my $tv = $typevalue[$index];
935 if (($tv =~ m/^(\C):\s*(.*)/)) {
944 sub find_starting_index
{
948 my $tv = $typevalue[$index];
949 if (!($tv =~ m/^(\C):\s*(.*)/)) {
958 sub find_ending_index
{
961 while ($index < @typevalue) {
962 my $tv = $typevalue[$index];
963 if (!($tv =~ m/^(\C):\s*(.*)/)) {
972 sub get_maintainer_role
{
976 my $start = find_starting_index
($index);
977 my $end = find_ending_index
($index);
979 my $role = "unknown";
980 my $subsystem = $typevalue[$start];
981 if (length($subsystem) > 20) {
982 $subsystem = substr($subsystem, 0, 17);
983 $subsystem =~ s/\s*$//;
984 $subsystem = $subsystem . "...";
987 for ($i = $start + 1; $i < $end; $i++) {
988 my $tv = $typevalue[$i];
989 if ($tv =~ m/^(\C):\s*(.*)/) {
999 if ($role eq "supported") {
1000 $role = "supporter";
1001 } elsif ($role eq "maintained") {
1002 $role = "maintainer";
1003 } elsif ($role eq "odd fixes") {
1004 $role = "odd fixer";
1005 } elsif ($role eq "orphan") {
1006 $role = "orphan minder";
1007 } elsif ($role eq "obsolete") {
1008 $role = "obsolete minder";
1009 } elsif ($role eq "buried alive in reporters") {
1010 $role = "chief penguin";
1013 return $role . ":" . $subsystem;
1020 my $start = find_starting_index
($index);
1021 my $end = find_ending_index
($index);
1023 my $subsystem = $typevalue[$start];
1024 if (length($subsystem) > 20) {
1025 $subsystem = substr($subsystem, 0, 17);
1026 $subsystem =~ s/\s*$//;
1027 $subsystem = $subsystem . "...";
1030 if ($subsystem eq "THE REST") {
1037 sub add_categories
{
1041 my $start = find_starting_index
($index);
1042 my $end = find_ending_index
($index);
1044 push(@subsystem, $typevalue[$start]);
1046 for ($i = $start + 1; $i < $end; $i++) {
1047 my $tv = $typevalue[$i];
1048 if ($tv =~ m/^(\C):\s*(.*)/) {
1051 if ($ptype eq "L") {
1052 my $list_address = $pvalue;
1053 my $list_additional = "";
1054 my $list_role = get_list_role
($i);
1056 if ($list_role ne "") {
1057 $list_role = ":" . $list_role;
1059 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1061 $list_additional = $2;
1063 if ($list_additional =~ m/subscribers-only/) {
1064 if ($email_subscriber_list) {
1065 if (!$hash_list_to{lc($list_address)}) {
1066 $hash_list_to{lc($list_address)} = 1;
1067 push(@list_to, [$list_address,
1068 "subscriber list${list_role}"]);
1073 if (!$hash_list_to{lc($list_address)}) {
1074 $hash_list_to{lc($list_address)} = 1;
1075 if ($list_additional =~ m/moderated/) {
1076 push(@list_to, [$list_address,
1077 "moderated list${list_role}"]);
1079 push(@list_to, [$list_address,
1080 "open list${list_role}"]);
1085 } elsif ($ptype eq "M") {
1086 my ($name, $address) = parse_email
($pvalue);
1089 my $tv = $typevalue[$i - 1];
1090 if ($tv =~ m/^(\C):\s*(.*)/) {
1093 $pvalue = format_email
($name, $address, $email_usename);
1098 if ($email_maintainer) {
1099 my $role = get_maintainer_role
($i);
1100 push_email_addresses
($pvalue, $role);
1102 } elsif ($ptype eq "R") {
1103 my ($name, $address) = parse_email
($pvalue);
1106 my $tv = $typevalue[$i - 1];
1107 if ($tv =~ m/^(\C):\s*(.*)/) {
1110 $pvalue = format_email
($name, $address, $email_usename);
1115 if ($email_reviewer) {
1116 push_email_addresses
($pvalue, 'reviewer');
1118 } elsif ($ptype eq "T") {
1119 push(@scm, $pvalue);
1120 } elsif ($ptype eq "W") {
1121 push(@web, $pvalue);
1122 } elsif ($ptype eq "S") {
1123 push(@status, $pvalue);
1130 my ($name, $address) = @_;
1132 return 1 if (($name eq "") && ($address eq ""));
1133 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1134 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1139 sub push_email_address
{
1140 my ($line, $role) = @_;
1142 my ($name, $address) = parse_email
($line);
1144 if ($address eq "") {
1148 if (!$email_remove_duplicates) {
1149 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1150 } elsif (!email_inuse
($name, $address)) {
1151 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1152 $email_hash_name{lc($name)}++ if ($name ne "");
1153 $email_hash_address{lc($address)}++;
1159 sub push_email_addresses
{
1160 my ($address, $role) = @_;
1162 my @address_list = ();
1164 if (rfc822_valid
($address)) {
1165 push_email_address
($address, $role);
1166 } elsif (@address_list = rfc822_validlist
($address)) {
1167 my $array_count = shift(@address_list);
1168 while (my $entry = shift(@address_list)) {
1169 push_email_address
($entry, $role);
1172 if (!push_email_address
($address, $role)) {
1173 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1179 my ($line, $role) = @_;
1181 my ($name, $address) = parse_email
($line);
1182 my $email = format_email
($name, $address, $email_usename);
1184 foreach my $entry (@email_to) {
1185 if ($email_remove_duplicates) {
1186 my ($entry_name, $entry_address) = parse_email
($entry->[0]);
1187 if (($name eq $entry_name || $address eq $entry_address)
1188 && ($role eq "" || !($entry->[1] =~ m/$role/))
1190 if ($entry->[1] eq "") {
1191 $entry->[1] = "$role";
1193 $entry->[1] = "$entry->[1],$role";
1197 if ($email eq $entry->[0]
1198 && ($role eq "" || !($entry->[1] =~ m/$role/))
1200 if ($entry->[1] eq "") {
1201 $entry->[1] = "$role";
1203 $entry->[1] = "$entry->[1],$role";
1213 foreach my $path (split(/:/, $ENV{PATH
})) {
1214 if (-e
"$path/$bin") {
1215 return "$path/$bin";
1225 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1226 if (-e
"$path/$conf") {
1227 return "$path/$conf";
1237 my ($name, $address) = parse_email
($line);
1238 my $email = format_email
($name, $address, 1);
1239 my $real_name = $name;
1240 my $real_address = $address;
1242 if (exists $mailmap->{names
}->{$email} ||
1243 exists $mailmap->{addresses
}->{$email}) {
1244 if (exists $mailmap->{names
}->{$email}) {
1245 $real_name = $mailmap->{names
}->{$email};
1247 if (exists $mailmap->{addresses
}->{$email}) {
1248 $real_address = $mailmap->{addresses
}->{$email};
1251 if (exists $mailmap->{names
}->{$address}) {
1252 $real_name = $mailmap->{names
}->{$address};
1254 if (exists $mailmap->{addresses
}->{$address}) {
1255 $real_address = $mailmap->{addresses
}->{$address};
1258 return format_email
($real_name, $real_address, 1);
1262 my (@addresses) = @_;
1264 my @mapped_emails = ();
1265 foreach my $line (@addresses) {
1266 push(@mapped_emails, mailmap_email
($line));
1268 merge_by_realname
(@mapped_emails) if ($email_use_mailmap);
1269 return @mapped_emails;
1272 sub merge_by_realname
{
1276 foreach my $email (@emails) {
1277 my ($name, $address) = parse_email
($email);
1278 if (exists $address_map{$name}) {
1279 $address = $address_map{$name};
1280 $email = format_email
($name, $address, 1);
1282 $address_map{$name} = $address;
1287 sub git_execute_cmd
{
1291 my $output = `$cmd`;
1292 $output =~ s/^\s*//gm;
1293 @lines = split("\n", $output);
1298 sub hg_execute_cmd
{
1302 my $output = `$cmd`;
1303 @lines = split("\n", $output);
1308 sub extract_formatted_signatures
{
1309 my (@signature_lines) = @_;
1311 my @type = @signature_lines;
1313 s/\s*(.*):.*/$1/ for (@type);
1316 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1318 ## Reformat email addresses (with names) to avoid badly written signatures
1320 foreach my $signer (@signature_lines) {
1321 $signer = deduplicate_email
($signer);
1324 return (\
@type, \
@signature_lines);
1327 sub vcs_find_signers
{
1328 my ($cmd, $file) = @_;
1331 my @signatures = ();
1335 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1337 my $pattern = $VCS_cmds{"commit_pattern"};
1338 my $author_pattern = $VCS_cmds{"author_pattern"};
1339 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1341 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1343 $commits = grep(/$pattern/, @lines); # of commits
1345 @authors = grep(/$author_pattern/, @lines);
1346 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1347 @stats = grep(/$stat_pattern/, @lines);
1349 # print("stats: <@stats>\n");
1351 return (0, \
@signatures, \
@authors, \
@stats) if !@signatures;
1353 save_commits_by_author
(@lines) if ($interactive);
1354 save_commits_by_signer
(@lines) if ($interactive);
1356 if (!$email_git_penguin_chiefs) {
1357 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1360 my ($author_ref, $authors_ref) = extract_formatted_signatures
(@authors);
1361 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1363 return ($commits, $signers_ref, $authors_ref, \
@stats);
1366 sub vcs_find_author
{
1370 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1372 if (!$email_git_penguin_chiefs) {
1373 @lines = grep(!/${penguin_chiefs}/i, @lines);
1376 return @lines if !@lines;
1379 foreach my $line (@lines) {
1380 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1382 my ($name, $address) = parse_email
($author);
1383 $author = format_email
($name, $address, 1);
1384 push(@authors, $author);
1388 save_commits_by_author
(@lines) if ($interactive);
1389 save_commits_by_signer
(@lines) if ($interactive);
1394 sub vcs_save_commits
{
1399 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1401 foreach my $line (@lines) {
1402 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1415 return @commits if (!(-f
$file));
1417 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1418 my @all_commits = ();
1420 $cmd = $VCS_cmds{"blame_file_cmd"};
1421 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1422 @all_commits = vcs_save_commits
($cmd);
1424 foreach my $file_range_diff (@range) {
1425 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1427 my $diff_start = $2;
1428 my $diff_length = $3;
1429 next if ("$file" ne "$diff_file");
1430 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1431 push(@commits, $all_commits[$i]);
1435 foreach my $file_range_diff (@range) {
1436 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1438 my $diff_start = $2;
1439 my $diff_length = $3;
1440 next if ("$file" ne "$diff_file");
1441 $cmd = $VCS_cmds{"blame_range_cmd"};
1442 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1443 push(@commits, vcs_save_commits
($cmd));
1446 $cmd = $VCS_cmds{"blame_file_cmd"};
1447 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1448 @commits = vcs_save_commits
($cmd);
1451 foreach my $commit (@commits) {
1452 $commit =~ s/^\^//g;
1458 my $printed_novcs = 0;
1460 %VCS_cmds = %VCS_cmds_git;
1461 return 1 if eval $VCS_cmds{"available"};
1462 %VCS_cmds = %VCS_cmds_hg;
1463 return 2 if eval $VCS_cmds{"available"};
1465 if (!$printed_novcs) {
1466 warn("$P: No supported VCS found. Add --nogit to options?\n");
1467 warn("Using a git repository produces better results.\n");
1468 warn("Try Linus Torvalds' latest git repository using:\n");
1469 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1477 return $vcs_used == 1;
1481 return $vcs_used == 2;
1484 sub interactive_get_maintainers
{
1485 my ($list_ref) = @_;
1486 my @list = @
$list_ref;
1495 foreach my $entry (@list) {
1496 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1497 $selected{$count} = 1;
1498 $authored{$count} = 0;
1499 $signed{$count} = 0;
1505 my $print_options = 0;
1510 printf STDERR
"\n%1s %2s %-65s",
1511 "*", "#", "email/list and role:stats";
1513 ($email_git_fallback && !$maintained) ||
1515 print STDERR
"auth sign";
1518 foreach my $entry (@list) {
1519 my $email = $entry->[0];
1520 my $role = $entry->[1];
1522 $sel = "*" if ($selected{$count});
1523 my $commit_author = $commit_author_hash{$email};
1524 my $commit_signer = $commit_signer_hash{$email};
1527 $authored++ for (@
{$commit_author});
1528 $signed++ for (@
{$commit_signer});
1529 printf STDERR
"%1s %2d %-65s", $sel, $count + 1, $email;
1530 printf STDERR
"%4d %4d", $authored, $signed
1531 if ($authored > 0 || $signed > 0);
1532 printf STDERR
"\n %s\n", $role;
1533 if ($authored{$count}) {
1534 my $commit_author = $commit_author_hash{$email};
1535 foreach my $ref (@
{$commit_author}) {
1536 print STDERR
" Author: @{$ref}[1]\n";
1539 if ($signed{$count}) {
1540 my $commit_signer = $commit_signer_hash{$email};
1541 foreach my $ref (@
{$commit_signer}) {
1542 print STDERR
" @{$ref}[2]: @{$ref}[1]\n";
1549 my $date_ref = \
$email_git_since;
1550 $date_ref = \
$email_hg_since if (vcs_is_hg
());
1551 if ($print_options) {
1556 Version Control options:
1557 g use git history [$email_git]
1558 gf use git-fallback [$email_git_fallback]
1559 b use git blame [$email_git_blame]
1560 bs use blame signatures [$email_git_blame_signatures]
1561 c# minimum commits [$email_git_min_signatures]
1562 %# min percent [$email_git_min_percent]
1563 d# history to use [$$date_ref]
1564 x# max maintainers [$email_git_max_maintainers]
1565 t all signature types [$email_git_all_signature_types]
1566 m use .mailmap [$email_use_mailmap]
1573 tm toggle maintainers
1574 tg toggle git entries
1575 tl toggle open list entries
1576 ts toggle subscriber list entries
1577 f emails in file [$file_emails]
1578 k keywords in file [$keywords]
1579 r remove duplicates [$email_remove_duplicates]
1580 p# pattern match depth [$pattern_depth]
1584 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1586 my $input = <STDIN
>;
1591 my @wish = split(/[, ]+/, $input);
1592 foreach my $nr (@wish) {
1594 my $sel = substr($nr, 0, 1);
1595 my $str = substr($nr, 1);
1597 $val = $1 if $str =~ /^(\d+)$/;
1602 $output_rolestats = 0;
1605 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1606 $selected{$nr - 1} = !$selected{$nr - 1};
1607 } elsif ($sel eq "*" || $sel eq '^') {
1609 $toggle = 1 if ($sel eq '*');
1610 for (my $i = 0; $i < $count; $i++) {
1611 $selected{$i} = $toggle;
1613 } elsif ($sel eq "0") {
1614 for (my $i = 0; $i < $count; $i++) {
1615 $selected{$i} = !$selected{$i};
1617 } elsif ($sel eq "t") {
1618 if (lc($str) eq "m") {
1619 for (my $i = 0; $i < $count; $i++) {
1620 $selected{$i} = !$selected{$i}
1621 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1623 } elsif (lc($str) eq "g") {
1624 for (my $i = 0; $i < $count; $i++) {
1625 $selected{$i} = !$selected{$i}
1626 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1628 } elsif (lc($str) eq "l") {
1629 for (my $i = 0; $i < $count; $i++) {
1630 $selected{$i} = !$selected{$i}
1631 if ($list[$i]->[1] =~ /^(open list)/i);
1633 } elsif (lc($str) eq "s") {
1634 for (my $i = 0; $i < $count; $i++) {
1635 $selected{$i} = !$selected{$i}
1636 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1639 } elsif ($sel eq "a") {
1640 if ($val > 0 && $val <= $count) {
1641 $authored{$val - 1} = !$authored{$val - 1};
1642 } elsif ($str eq '*' || $str eq '^') {
1644 $toggle = 1 if ($str eq '*');
1645 for (my $i = 0; $i < $count; $i++) {
1646 $authored{$i} = $toggle;
1649 } elsif ($sel eq "s") {
1650 if ($val > 0 && $val <= $count) {
1651 $signed{$val - 1} = !$signed{$val - 1};
1652 } elsif ($str eq '*' || $str eq '^') {
1654 $toggle = 1 if ($str eq '*');
1655 for (my $i = 0; $i < $count; $i++) {
1656 $signed{$i} = $toggle;
1659 } elsif ($sel eq "o") {
1662 } elsif ($sel eq "g") {
1664 bool_invert
(\
$email_git_fallback);
1666 bool_invert
(\
$email_git);
1669 } elsif ($sel eq "b") {
1671 bool_invert
(\
$email_git_blame_signatures);
1673 bool_invert
(\
$email_git_blame);
1676 } elsif ($sel eq "c") {
1678 $email_git_min_signatures = $val;
1681 } elsif ($sel eq "x") {
1683 $email_git_max_maintainers = $val;
1686 } elsif ($sel eq "%") {
1687 if ($str ne "" && $val >= 0) {
1688 $email_git_min_percent = $val;
1691 } elsif ($sel eq "d") {
1693 $email_git_since = $str;
1694 } elsif (vcs_is_hg
()) {
1695 $email_hg_since = $str;
1698 } elsif ($sel eq "t") {
1699 bool_invert
(\
$email_git_all_signature_types);
1701 } elsif ($sel eq "f") {
1702 bool_invert
(\
$file_emails);
1704 } elsif ($sel eq "r") {
1705 bool_invert
(\
$email_remove_duplicates);
1707 } elsif ($sel eq "m") {
1708 bool_invert
(\
$email_use_mailmap);
1711 } elsif ($sel eq "k") {
1712 bool_invert
(\
$keywords);
1714 } elsif ($sel eq "p") {
1715 if ($str ne "" && $val >= 0) {
1716 $pattern_depth = $val;
1719 } elsif ($sel eq "h" || $sel eq "?") {
1722 Interactive mode allows you to select the various maintainers, submitters,
1723 commit signers and mailing lists that could be CC'd on a patch.
1725 Any *'d entry is selected.
1727 If you have git or hg installed, you can choose to summarize the commit
1728 history of files in the patch. Also, each line of the current file can
1729 be matched to its commit author and that commits signers with blame.
1731 Various knobs exist to control the length of time for active commit
1732 tracking, the maximum number of commit authors and signers to add,
1735 Enter selections at the prompt until you are satisfied that the selected
1736 maintainers are appropriate. You may enter multiple selections separated
1737 by either commas or spaces.
1741 print STDERR
"invalid option: '$nr'\n";
1746 print STDERR
"git-blame can be very slow, please have patience..."
1747 if ($email_git_blame);
1748 goto &get_maintainers
;
1752 #drop not selected entries
1754 my @new_emailto = ();
1755 foreach my $entry (@list) {
1756 if ($selected{$count}) {
1757 push(@new_emailto, $list[$count]);
1761 return @new_emailto;
1765 my ($bool_ref) = @_;
1774 sub deduplicate_email
{
1778 my ($name, $address) = parse_email
($email);
1779 $email = format_email
($name, $address, 1);
1780 $email = mailmap_email
($email);
1782 return $email if (!$email_remove_duplicates);
1784 ($name, $address) = parse_email
($email);
1786 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1787 $name = $deduplicate_name_hash{lc($name)}->[0];
1788 $address = $deduplicate_name_hash{lc($name)}->[1];
1790 } elsif ($deduplicate_address_hash{lc($address)}) {
1791 $name = $deduplicate_address_hash{lc($address)}->[0];
1792 $address = $deduplicate_address_hash{lc($address)}->[1];
1796 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1797 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1799 $email = format_email
($name, $address, 1);
1800 $email = mailmap_email
($email);
1804 sub save_commits_by_author
{
1811 foreach my $line (@lines) {
1812 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1814 $author = deduplicate_email
($author);
1815 push(@authors, $author);
1817 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1818 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1821 for (my $i = 0; $i < @authors; $i++) {
1823 foreach my $ref(@
{$commit_author_hash{$authors[$i]}}) {
1824 if (@
{$ref}[0] eq $commits[$i] &&
1825 @
{$ref}[1] eq $subjects[$i]) {
1831 push(@
{$commit_author_hash{$authors[$i]}},
1832 [ ($commits[$i], $subjects[$i]) ]);
1837 sub save_commits_by_signer
{
1843 foreach my $line (@lines) {
1844 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1845 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1846 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1847 my @signatures = ($line);
1848 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1849 my @types = @
$types_ref;
1850 my @signers = @
$signers_ref;
1852 my $type = $types[0];
1853 my $signer = $signers[0];
1855 $signer = deduplicate_email
($signer);
1858 foreach my $ref(@
{$commit_signer_hash{$signer}}) {
1859 if (@
{$ref}[0] eq $commit &&
1860 @
{$ref}[1] eq $subject &&
1861 @
{$ref}[2] eq $type) {
1867 push(@
{$commit_signer_hash{$signer}},
1868 [ ($commit, $subject, $type) ]);
1875 my ($role, $divisor, @lines) = @_;
1880 return if (@lines <= 0);
1882 if ($divisor <= 0) {
1883 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1887 @lines = mailmap
(@lines);
1889 return if (@lines <= 0);
1891 @lines = sort(@lines);
1894 $hash{$_}++ for @lines;
1897 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1898 my $sign_offs = $hash{$line};
1899 my $percent = $sign_offs * 100 / $divisor;
1901 $percent = 100 if ($percent > 100);
1902 next if (ignore_email_address
($line));
1904 last if ($sign_offs < $email_git_min_signatures ||
1905 $count > $email_git_max_maintainers ||
1906 $percent < $email_git_min_percent);
1907 push_email_address
($line, '');
1908 if ($output_rolestats) {
1909 my $fmt_percent = sprintf("%.0f", $percent);
1910 add_role
($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1912 add_role
($line, $role);
1917 sub vcs_file_signoffs
{
1928 $vcs_used = vcs_exists
();
1929 return if (!$vcs_used);
1931 my $cmd = $VCS_cmds{"find_signers_cmd"};
1932 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1934 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
1936 @signers = @
{$signers_ref} if defined $signers_ref;
1937 @authors = @
{$authors_ref} if defined $authors_ref;
1938 @stats = @
{$stats_ref} if defined $stats_ref;
1940 # print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1942 foreach my $signer (@signers) {
1943 $signer = deduplicate_email
($signer);
1946 vcs_assign
("commit_signer", $commits, @signers);
1947 vcs_assign
("authored", $commits, @authors);
1948 if ($#authors == $#stats) {
1949 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1950 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1954 for (my $i = 0; $i <= $#stats; $i++) {
1955 if ($stats[$i] =~ /$stat_pattern/) {
1960 my @tmp_authors = uniq
(@authors);
1961 foreach my $author (@tmp_authors) {
1962 $author = deduplicate_email
($author);
1964 @tmp_authors = uniq
(@tmp_authors);
1965 my @list_added = ();
1966 my @list_deleted = ();
1967 foreach my $author (@tmp_authors) {
1969 my $auth_deleted = 0;
1970 for (my $i = 0; $i <= $#stats; $i++) {
1971 if ($author eq deduplicate_email
($authors[$i]) &&
1972 $stats[$i] =~ /$stat_pattern/) {
1974 $auth_deleted += $2;
1977 for (my $i = 0; $i < $auth_added; $i++) {
1978 push(@list_added, $author);
1980 for (my $i = 0; $i < $auth_deleted; $i++) {
1981 push(@list_deleted, $author);
1984 vcs_assign
("added_lines", $added, @list_added);
1985 vcs_assign
("removed_lines", $deleted, @list_deleted);
1989 sub vcs_file_blame
{
1993 my @all_commits = ();
1998 $vcs_used = vcs_exists
();
1999 return if (!$vcs_used);
2001 @all_commits = vcs_blame
($file);
2002 @commits = uniq
(@all_commits);
2003 $total_commits = @commits;
2004 $total_lines = @all_commits;
2006 if ($email_git_blame_signatures) {
2009 my $commit_authors_ref;
2010 my $commit_signers_ref;
2012 my @commit_authors = ();
2013 my @commit_signers = ();
2014 my $commit = join(" -r ", @commits);
2017 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2018 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2020 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
2021 @commit_authors = @
{$commit_authors_ref} if defined $commit_authors_ref;
2022 @commit_signers = @
{$commit_signers_ref} if defined $commit_signers_ref;
2024 push(@signers, @commit_signers);
2026 foreach my $commit (@commits) {
2028 my $commit_authors_ref;
2029 my $commit_signers_ref;
2031 my @commit_authors = ();
2032 my @commit_signers = ();
2035 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2036 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2038 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
2039 @commit_authors = @
{$commit_authors_ref} if defined $commit_authors_ref;
2040 @commit_signers = @
{$commit_signers_ref} if defined $commit_signers_ref;
2042 push(@signers, @commit_signers);
2047 if ($from_filename) {
2048 if ($output_rolestats) {
2050 if (vcs_is_hg
()) {{ # Double brace for last exit
2052 my @commit_signers = ();
2053 @commits = uniq
(@commits);
2054 @commits = sort(@commits);
2055 my $commit = join(" -r ", @commits);
2058 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2059 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2063 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2065 if (!$email_git_penguin_chiefs) {
2066 @lines = grep(!/${penguin_chiefs}/i, @lines);
2072 foreach my $line (@lines) {
2073 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2075 $author = deduplicate_email
($author);
2076 push(@authors, $author);
2080 save_commits_by_author
(@lines) if ($interactive);
2081 save_commits_by_signer
(@lines) if ($interactive);
2083 push(@signers, @authors);
2086 foreach my $commit (@commits) {
2088 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2089 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2090 my @author = vcs_find_author
($cmd);
2093 my $formatted_author = deduplicate_email
($author[0]);
2095 my $count = grep(/$commit/, @all_commits);
2096 for ($i = 0; $i < $count ; $i++) {
2097 push(@blame_signers, $formatted_author);
2101 if (@blame_signers) {
2102 vcs_assign
("authored lines", $total_lines, @blame_signers);
2105 foreach my $signer (@signers) {
2106 $signer = deduplicate_email
($signer);
2108 vcs_assign
("commits", $total_commits, @signers);
2110 foreach my $signer (@signers) {
2111 $signer = deduplicate_email
($signer);
2113 vcs_assign
("modified commits", $total_commits, @signers);
2121 @parms = grep(!$saw{$_}++, @parms);
2129 @parms = sort @parms;
2130 @parms = grep(!$saw{$_}++, @parms);
2134 sub clean_file_emails
{
2135 my (@file_emails) = @_;
2136 my @fmt_emails = ();
2138 foreach my $email (@file_emails) {
2139 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2140 my ($name, $address) = parse_email
($email);
2141 if ($name eq '"[,\.]"') {
2145 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2147 my $first = $nw[@nw - 3];
2148 my $middle = $nw[@nw - 2];
2149 my $last = $nw[@nw - 1];
2151 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2152 (length($first) == 2 && substr($first, -1) eq ".")) ||
2153 (length($middle) == 1 ||
2154 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2155 $name = "$first $middle $last";
2157 $name = "$middle $last";
2161 if (substr($name, -1) =~ /[,\.]/) {
2162 $name = substr($name, 0, length($name) - 1);
2163 } elsif (substr($name, -2) =~ /[,\.]"/) {
2164 $name = substr($name, 0, length($name) - 2) . '"';
2167 if (substr($name, 0, 1) =~ /[,\.]/) {
2168 $name = substr($name, 1, length($name) - 1);
2169 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2170 $name = '"' . substr($name, 2, length($name) - 2);
2173 my $fmt_email = format_email
($name, $address, $email_usename);
2174 push(@fmt_emails, $fmt_email);
2184 my ($address, $role) = @
$_;
2185 if (!$saw{$address}) {
2186 if ($output_roles) {
2187 push(@lines, "$address ($role)");
2189 push(@lines, $address);
2201 if ($output_multiline) {
2202 foreach my $line (@parms) {
2206 print(join($output_separator, @parms));
2214 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2215 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2216 # This regexp will only work on addresses which have had comments stripped
2217 # and replaced with rfc822_lwsp.
2219 my $specials = '()<>@,;:\\\\".\\[\\]';
2220 my $controls = '\\000-\\037\\177';
2222 my $dtext = "[^\\[\\]\\r\\\\]";
2223 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2225 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2227 # Use zero-width assertion to spot the limit of an atom. A simple
2228 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2229 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2230 my $word = "(?:$atom|$quoted_string)";
2231 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2233 my $sub_domain = "(?:$atom|$domain_literal)";
2234 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2236 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2238 my $phrase = "$word*";
2239 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2240 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2241 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2243 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2244 my $address = "(?:$mailbox|$group)";
2246 return "$rfc822_lwsp*$address";
2249 sub rfc822_strip_comments
{
2251 # Recursively remove comments, and replace with a single space. The simpler
2252 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2253 # chars in atoms, for example.
2255 while ($s =~ s
/^((?
:[^"\\]|\\.)*
2256 (?:"(?
:[^"\\]|\\.)*"(?
:[^"\\]|\\.)*)*)
2257 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2261 # valid: returns true if the parameter is an RFC822 valid address
2264 my $s = rfc822_strip_comments(shift);
2267 $rfc822re = make_rfc822re();
2270 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2273 # validlist: In scalar context, returns true if the parameter is an RFC822
2274 # valid list of addresses.
2276 # In list context, returns an empty list on failure (an invalid
2277 # address was found); otherwise a list whose first element is the
2278 # number of addresses found and whose remaining elements are the
2279 # addresses. This is needed to disambiguate failure (invalid)
2280 # from success with no addresses found, because an empty string is
2283 sub rfc822_validlist {
2284 my $s = rfc822_strip_comments(shift);
2287 $rfc822re = make_rfc822re();
2289 # * null list items are valid according to the RFC
2290 # * the '1' business is to aid in distinguishing failure from no results
2293 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2294 $s =~ m/^$rfc822_char*$/) {
2295 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2298 return wantarray ? (scalar(@r), @r) : 1;
2300 return wantarray ? () : 0;