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
19 use Getopt
::Long
qw(:config no_auto_abbrev);
22 my $cur_path = fastgetcwd
() . '/';
25 my $email_usename = 1;
26 my $email_maintainer = 1;
27 my $email_reviewer = 1;
29 my $email_subscriber_list = 0;
30 my $email_git_penguin_chiefs = 0;
32 my $email_git_all_signature_types = 0;
33 my $email_git_blame = 0;
34 my $email_git_blame_signatures = 1;
35 my $email_git_fallback = 1;
36 my $email_git_min_signatures = 1;
37 my $email_git_max_maintainers = 5;
38 my $email_git_min_percent = 5;
39 my $email_git_since = "1-year-ago";
40 my $email_hg_since = "-365";
42 my $email_remove_duplicates = 1;
43 my $email_use_mailmap = 1;
44 my $output_multiline = 1;
45 my $output_separator = ", ";
47 my $output_rolestats = 1;
48 my $output_section_maxlen = 50;
57 my $from_filename = 0;
58 my $pattern_depth = 0;
66 my %commit_author_hash;
67 my %commit_signer_hash;
69 my @penguin_chief = ();
70 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
71 #Andrew wants in on most everything - 2009/01/14
72 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
74 my @penguin_chief_names = ();
75 foreach my $chief (@penguin_chief) {
76 if ($chief =~ m/^(.*):(.*)/) {
79 push(@penguin_chief_names, $chief_name);
82 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
84 # Signature types of people who are either
85 # a) responsible for the code in question, or
86 # b) familiar enough with it to give relevant feedback
87 my @signature_tags = ();
88 push(@signature_tags, "Signed-off-by:");
89 push(@signature_tags, "Reviewed-by:");
90 push(@signature_tags, "Acked-by:");
92 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
94 # rfc822 email address - preloaded methods go here.
95 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
96 my $rfc822_char = '[\\000-\\377]';
98 # VCS command support: class-like functions and strings
103 "execute_cmd" => \
&git_execute_cmd
,
104 "available" => '(which("git") ne "") && (-e ".git")',
105 "find_signers_cmd" =>
106 "git log --no-color --follow --since=\$email_git_since " .
107 '--numstat --no-merges ' .
108 '--format="GitCommit: %H%n' .
109 'GitAuthor: %an <%ae>%n' .
114 "find_commit_signers_cmd" =>
115 "git log --no-color " .
117 '--format="GitCommit: %H%n' .
118 'GitAuthor: %an <%ae>%n' .
123 "find_commit_author_cmd" =>
124 "git log --no-color " .
126 '--format="GitCommit: %H%n' .
127 'GitAuthor: %an <%ae>%n' .
129 'GitSubject: %s%n"' .
131 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
132 "blame_file_cmd" => "git blame -l \$file",
133 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
134 "blame_commit_pattern" => "^([0-9a-f]+) ",
135 "author_pattern" => "^GitAuthor: (.*)",
136 "subject_pattern" => "^GitSubject: (.*)",
137 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
138 "file_exists_cmd" => "git ls-files \$file",
142 "execute_cmd" => \
&hg_execute_cmd
,
143 "available" => '(which("hg") ne "") && (-d ".hg")',
144 "find_signers_cmd" =>
145 "hg log --date=\$email_hg_since " .
146 "--template='HgCommit: {node}\\n" .
147 "HgAuthor: {author}\\n" .
148 "HgSubject: {desc}\\n'" .
150 "find_commit_signers_cmd" =>
152 "--template='HgSubject: {desc}\\n'" .
154 "find_commit_author_cmd" =>
156 "--template='HgCommit: {node}\\n" .
157 "HgAuthor: {author}\\n" .
158 "HgSubject: {desc|firstline}\\n'" .
160 "blame_range_cmd" => "", # not supported
161 "blame_file_cmd" => "hg blame -n \$file",
162 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
163 "blame_commit_pattern" => "^([ 0-9a-f]+):",
164 "author_pattern" => "^HgAuthor: (.*)",
165 "subject_pattern" => "^HgSubject: (.*)",
166 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
167 "file_exists_cmd" => "hg files \$file",
170 my $conf = which_conf
(".get_maintainer.conf");
173 open(my $conffile, '<', "$conf")
174 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
176 while (<$conffile>) {
179 $line =~ s/\s*\n?$//g;
183 next if ($line =~ m/^\s*#/);
184 next if ($line =~ m/^\s*$/);
186 my @words = split(" ", $line);
187 foreach my $word (@words) {
188 last if ($word =~ m/^#/);
189 push (@conf_args, $word);
193 unshift(@ARGV, @conf_args) if @conf_args;
196 my @ignore_emails = ();
197 my $ignore_file = which_conf
(".get_maintainer.ignore");
198 if (-f
$ignore_file) {
199 open(my $ignore, '<', "$ignore_file")
200 or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
204 $line =~ s/\s*\n?$//;
209 next if ($line =~ m/^\s*$/);
210 if (rfc822_valid
($line)) {
211 push(@ignore_emails, $line);
219 'git!' => \
$email_git,
220 'git-all-signature-types!' => \
$email_git_all_signature_types,
221 'git-blame!' => \
$email_git_blame,
222 'git-blame-signatures!' => \
$email_git_blame_signatures,
223 'git-fallback!' => \
$email_git_fallback,
224 'git-chief-penguins!' => \
$email_git_penguin_chiefs,
225 'git-min-signatures=i' => \
$email_git_min_signatures,
226 'git-max-maintainers=i' => \
$email_git_max_maintainers,
227 'git-min-percent=i' => \
$email_git_min_percent,
228 'git-since=s' => \
$email_git_since,
229 'hg-since=s' => \
$email_hg_since,
230 'i|interactive!' => \
$interactive,
231 'remove-duplicates!' => \
$email_remove_duplicates,
232 'mailmap!' => \
$email_use_mailmap,
233 'm!' => \
$email_maintainer,
234 'r!' => \
$email_reviewer,
235 'n!' => \
$email_usename,
236 'l!' => \
$email_list,
237 's!' => \
$email_subscriber_list,
238 'multiline!' => \
$output_multiline,
239 'roles!' => \
$output_roles,
240 'rolestats!' => \
$output_rolestats,
241 'separator=s' => \
$output_separator,
242 'subsystem!' => \
$subsystem,
243 'status!' => \
$status,
246 'letters=s' => \
$letters,
247 'pattern-depth=i' => \
$pattern_depth,
248 'k|keywords!' => \
$keywords,
249 'sections!' => \
$sections,
250 'fe|file-emails!' => \
$file_emails,
251 'f|file' => \
$from_filename,
252 'v|version' => \
$version,
253 'h|help|usage' => \
$help,
255 die "$P: invalid argument - use --help if necessary\n";
264 print("${P} ${V}\n");
268 if (-t STDIN
&& !@ARGV) {
269 # We're talking to a terminal, but have no command line arguments.
270 die "$P: missing patchfile or -f file - use --help if necessary\n";
273 $output_multiline = 0 if ($output_separator ne ", ");
274 $output_rolestats = 1 if ($interactive);
275 $output_roles = 1 if ($output_rolestats);
277 if ($sections || $letters ne "") {
288 my $selections = $email + $scm + $status + $subsystem + $web;
289 if ($selections == 0) {
290 die "$P: Missing required option: email, scm, status, subsystem or web\n";
295 ($email_maintainer + $email_reviewer +
296 $email_list + $email_subscriber_list +
297 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
298 die "$P: Please select at least 1 email option\n";
301 if (!top_of_kernel_tree
($lk_path)) {
302 die "$P: The current directory does not appear to be "
303 . "a linux kernel source tree.\n";
306 ## Read MAINTAINERS for type/value pairs
311 open (my $maint, '<', "${lk_path}MAINTAINERS")
312 or die "$P: Can't open MAINTAINERS: $!\n";
316 if ($line =~ m/^([A-Z]):\s*(.*)/) {
320 ##Filename pattern matching
321 if ($type eq "F" || $type eq "X") {
322 $value =~ s@\
.@
\\\
.@g; ##Convert . to \.
323 $value =~ s/\*/\.\*/g; ##Convert * to .*
324 $value =~ s/\?/\./g; ##Convert ? to .
325 ##if pattern is a directory and it lacks a trailing slash, add one
327 $value =~ s@
([^/])$@$1/@
;
329 } elsif ($type eq "K") {
330 $keyword_hash{@typevalue} = $value;
332 push(@typevalue, "$type:$value");
333 } elsif (!/^(\s)*$/) {
335 push(@typevalue, $line);
342 # Read mail address map
355 return if (!$email_use_mailmap || !(-f
"${lk_path}.mailmap"));
357 open(my $mailmap_file, '<', "${lk_path}.mailmap")
358 or warn "$P: Can't open .mailmap: $!\n";
360 while (<$mailmap_file>) {
361 s/#.*$//; #strip comments
362 s/^\s+|\s+$//g; #trim
364 next if (/^\s*$/); #skip empty lines
365 #entries have one of the following formats:
368 # name1 <mail1> <mail2>
369 # name1 <mail1> name2 <mail2>
370 # (see man git-shortlog)
372 if (/^([^<]+)<([^>]+)>$/) {
376 $real_name =~ s/\s+$//;
377 ($real_name, $address) = parse_email
("$real_name <$address>");
378 $mailmap->{names
}->{$address} = $real_name;
380 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
381 my $real_address = $1;
382 my $wrong_address = $2;
384 $mailmap->{addresses
}->{$wrong_address} = $real_address;
386 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
388 my $real_address = $2;
389 my $wrong_address = $3;
391 $real_name =~ s/\s+$//;
392 ($real_name, $real_address) =
393 parse_email
("$real_name <$real_address>");
394 $mailmap->{names
}->{$wrong_address} = $real_name;
395 $mailmap->{addresses
}->{$wrong_address} = $real_address;
397 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
399 my $real_address = $2;
401 my $wrong_address = $4;
403 $real_name =~ s/\s+$//;
404 ($real_name, $real_address) =
405 parse_email
("$real_name <$real_address>");
407 $wrong_name =~ s/\s+$//;
408 ($wrong_name, $wrong_address) =
409 parse_email
("$wrong_name <$wrong_address>");
411 my $wrong_email = format_email
($wrong_name, $wrong_address, 1);
412 $mailmap->{names
}->{$wrong_email} = $real_name;
413 $mailmap->{addresses
}->{$wrong_email} = $real_address;
416 close($mailmap_file);
419 ## use the filenames on the command line or find the filenames in the patchfiles
423 my @keyword_tvi = ();
424 my @file_emails = ();
427 push(@ARGV, "&STDIN");
430 foreach my $file (@ARGV) {
431 if ($file ne "&STDIN") {
432 ##if $file is a directory and it lacks a trailing slash, add one
434 $file =~ s@
([^/])$@$1/@
;
435 } elsif (!(-f
$file)) {
436 die "$P: file '${file}' not found\n";
439 if ($from_filename || ($file ne "&STDIN" && vcs_file_exists
($file))) {
440 $file =~ s/^\Q${cur_path}\E//; #strip any absolute path
441 $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree
443 if ($file ne "MAINTAINERS" && -f
$file && ($keywords || $file_emails)) {
444 open(my $f, '<', $file)
445 or die "$P: Can't open $file: $!\n";
446 my $text = do { local($/) ; <$f> };
449 foreach my $line (keys %keyword_hash) {
450 if ($text =~ m/$keyword_hash{$line}/x) {
451 push(@keyword_tvi, $line);
456 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;
457 push(@file_emails, clean_file_emails
(@poss_addr));
461 my $file_cnt = @files;
464 open(my $patch, "< $file")
465 or die "$P: Can't open $file: $!\n";
467 # We can check arbitrary information before the patch
468 # like the commit message, mail headers, etc...
469 # This allows us to match arbitrary keywords against any part
470 # of a git format-patch generated file (subject tags, etc...)
472 my $patch_prefix = ""; #Parsing the intro
476 if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
478 $filename =~ s@
^[^/]*/@@
;
480 $lastfile = $filename;
481 push(@files, $filename);
482 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
483 } elsif (m/^\@\@ -(\d+),(\d+)/) {
484 if ($email_git_blame) {
485 push(@range, "$lastfile:$1:$2");
487 } elsif ($keywords) {
488 foreach my $line (keys %keyword_hash) {
489 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
490 push(@keyword_tvi, $line);
497 if ($file_cnt == @files) {
498 warn "$P: file '${file}' doesn't appear to be a patch. "
499 . "Add -f to options?\n";
501 @files = sort_and_uniq
(@files);
505 @file_emails = uniq
(@file_emails);
508 my %email_hash_address;
516 my %deduplicate_name_hash = ();
517 my %deduplicate_address_hash = ();
519 my @maintainers = get_maintainers
();
522 @maintainers = merge_email
(@maintainers);
523 output
(@maintainers);
532 @status = uniq
(@status);
537 @subsystem = uniq
(@subsystem);
548 sub ignore_email_address
{
551 foreach my $ignore (@ignore_emails) {
552 return 1 if ($ignore eq $address);
558 sub range_is_maintained
{
559 my ($start, $end) = @_;
561 for (my $i = $start; $i < $end; $i++) {
562 my $line = $typevalue[$i];
563 if ($line =~ m/^([A-Z]):\s*(.*)/) {
567 if ($value =~ /(maintain|support)/i) {
576 sub range_has_maintainer
{
577 my ($start, $end) = @_;
579 for (my $i = $start; $i < $end; $i++) {
580 my $line = $typevalue[$i];
581 if ($line =~ m/^([A-Z]):\s*(.*)/) {
592 sub get_maintainers
{
593 %email_hash_name = ();
594 %email_hash_address = ();
595 %commit_author_hash = ();
596 %commit_signer_hash = ();
604 %deduplicate_name_hash = ();
605 %deduplicate_address_hash = ();
606 if ($email_git_all_signature_types) {
607 $signature_pattern = "(.+?)[Bb][Yy]:";
609 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
612 # Find responsible parties
614 my %exact_pattern_match_hash = ();
616 foreach my $file (@files) {
619 my $tvi = find_first_section
();
620 while ($tvi < @typevalue) {
621 my $start = find_starting_index
($tvi);
622 my $end = find_ending_index
($tvi);
626 #Do not match excluded file patterns
628 for ($i = $start; $i < $end; $i++) {
629 my $line = $typevalue[$i];
630 if ($line =~ m/^([A-Z]):\s*(.*)/) {
634 if (file_match_pattern
($file, $value)) {
643 for ($i = $start; $i < $end; $i++) {
644 my $line = $typevalue[$i];
645 if ($line =~ m/^([A-Z]):\s*(.*)/) {
649 if (file_match_pattern
($file, $value)) {
650 my $value_pd = ($value =~ tr@
/@@
);
651 my $file_pd = ($file =~ tr@
/@@
);
652 $value_pd++ if (substr($value,-1,1) ne "/");
653 $value_pd = -1 if ($value =~ /^\.\*/);
654 if ($value_pd >= $file_pd &&
655 range_is_maintained
($start, $end) &&
656 range_has_maintainer
($start, $end)) {
657 $exact_pattern_match_hash{$file} = 1;
659 if ($pattern_depth == 0 ||
660 (($file_pd - $value_pd) < $pattern_depth)) {
661 $hash{$tvi} = $value_pd;
664 } elsif ($type eq 'N') {
665 if ($file =~ m/$value/x) {
675 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
676 add_categories
($line);
679 my $start = find_starting_index
($line);
680 my $end = find_ending_index
($line);
681 for ($i = $start; $i < $end; $i++) {
682 my $line = $typevalue[$i];
683 if ($line =~ /^[FX]:/) { ##Restore file patterns
684 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
685 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
686 $line =~ s/\\\./\./g; ##Convert \. to .
687 $line =~ s/\.\*/\*/g; ##Convert .* to *
689 my $count = $line =~ s/^([A-Z]):/$1:\t/g;
690 if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
700 @keyword_tvi = sort_and_uniq
(@keyword_tvi);
701 foreach my $line (@keyword_tvi) {
702 add_categories
($line);
706 foreach my $email (@email_to, @list_to) {
707 $email->[0] = deduplicate_email
($email->[0]);
710 foreach my $file (@files) {
712 ($email_git || ($email_git_fallback &&
713 !$exact_pattern_match_hash{$file}))) {
714 vcs_file_signoffs
($file);
716 if ($email && $email_git_blame) {
717 vcs_file_blame
($file);
722 foreach my $chief (@penguin_chief) {
723 if ($chief =~ m/^(.*):(.*)/) {
726 $email_address = format_email
($1, $2, $email_usename);
727 if ($email_git_penguin_chiefs) {
728 push(@email_to, [$email_address, 'chief penguin']);
730 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
735 foreach my $email (@file_emails) {
736 my ($name, $address) = parse_email
($email);
738 my $tmp_email = format_email
($name, $address, $email_usename);
739 push_email_address
($tmp_email, '');
740 add_role
($tmp_email, 'in file');
745 if ($email || $email_list) {
747 @to = (@to, @email_to);
750 @to = (@to, @list_to);
755 @to = interactive_get_maintainers
(\
@to);
761 sub file_match_pattern
{
762 my ($file, $pattern) = @_;
763 if (substr($pattern, -1) eq "/") {
764 if ($file =~ m@
^$pattern@
) {
768 if ($file =~ m@
^$pattern@
) {
769 my $s1 = ($file =~ tr@
/@@
);
770 my $s2 = ($pattern =~ tr@
/@@
);
781 usage: $P [options] patchfile
782 $P [options] -f file|directory
785 MAINTAINER field selection options:
786 --email => print email address(es) if any
787 --git => include recent git \*-by: signers
788 --git-all-signature-types => include signers regardless of signature type
789 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
790 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
791 --git-chief-penguins => include ${penguin_chiefs}
792 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
793 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
794 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
795 --git-blame => use git blame to find modified commits for patch or file
796 --git-blame-signatures => when used with --git-blame, also include all commit signers
797 --git-since => git history to use (default: $email_git_since)
798 --hg-since => hg history to use (default: $email_hg_since)
799 --interactive => display a menu (mostly useful if used with the --git option)
800 --m => include maintainer(s) if any
801 --r => include reviewer(s) if any
802 --n => include name 'Full Name <addr\@domain.tld>'
803 --l => include list(s) if any
804 --s => include subscriber only list(s) if any
805 --remove-duplicates => minimize duplicate email names/addresses
806 --roles => show roles (status:subsystem, git-signer, list, etc...)
807 --rolestats => show roles and statistics (commits/total_commits, %)
808 --file-emails => add email addresses found in -f file (default: 0 (off))
809 --scm => print SCM tree(s) if any
810 --status => print status if any
811 --subsystem => print subsystem name if any
812 --web => print website(s) if any
815 --separator [, ] => separator for multiple entries on 1 line
816 using --separator also sets --nomultiline if --separator is not [, ]
817 --multiline => print 1 entry per line
820 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
821 --keywords => scan patch for keywords (default: $keywords)
822 --sections => print all of the subsystem sections with pattern matches
823 --letters => print all matching 'letter' types from all matching sections
824 --mailmap => use .mailmap file (default: $email_use_mailmap)
825 --version => show version
826 --help => show this help information
829 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
830 --remove-duplicates --rolestats]
833 Using "-f directory" may give unexpected results:
834 Used with "--git", git signators for _all_ files in and below
835 directory are examined as git recurses directories.
836 Any specified X: (exclude) pattern matches are _not_ ignored.
837 Used with "--nogit", directory is used as a pattern match,
838 no individual file within the directory or subdirectory
840 Used with "--git-blame", does not iterate all files in directory
841 Using "--git-blame" is slow and may add old committers and authors
842 that are no longer active maintainers to the output.
843 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
844 other automated tools that expect only ["name"] <email address>
845 may not work because of additional output after <email address>.
846 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
847 not the percentage of the entire file authored. # of commits is
848 not a good measure of amount of code authored. 1 major commit may
849 contain a thousand lines, 5 trivial commits may modify a single line.
850 If git is not installed, but mercurial (hg) is installed and an .hg
851 repository exists, the following options apply to mercurial:
853 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
855 Use --hg-since not --git-since to control date selection
856 File ".get_maintainer.conf", if it exists in the linux kernel source root
857 directory, can change whatever get_maintainer defaults are desired.
858 Entries in this file can be any command line argument.
859 This file is prepended to any additional command line arguments.
860 Multiple lines and # comments are allowed.
861 Most options have both positive and negative forms.
862 The negative forms for --<foo> are --no<foo> and --no-<foo>.
867 sub top_of_kernel_tree
{
870 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
873 if ( (-f
"${lk_path}COPYING")
874 && (-f
"${lk_path}CREDITS")
875 && (-f
"${lk_path}Kbuild")
876 && (-f
"${lk_path}MAINTAINERS")
877 && (-f
"${lk_path}Makefile")
878 && (-f
"${lk_path}README")
879 && (-d
"${lk_path}Documentation")
880 && (-d
"${lk_path}arch")
881 && (-d
"${lk_path}include")
882 && (-d
"${lk_path}drivers")
883 && (-d
"${lk_path}fs")
884 && (-d
"${lk_path}init")
885 && (-d
"${lk_path}ipc")
886 && (-d
"${lk_path}kernel")
887 && (-d
"${lk_path}lib")
888 && (-d
"${lk_path}scripts")) {
895 my ($formatted_email) = @_;
900 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
903 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
905 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
909 $name =~ s/^\s+|\s+$//g;
910 $name =~ s/^\"|\"$//g;
911 $address =~ s/^\s+|\s+$//g;
913 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
914 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
918 return ($name, $address);
922 my ($name, $address, $usename) = @_;
926 $name =~ s/^\s+|\s+$//g;
927 $name =~ s/^\"|\"$//g;
928 $address =~ s/^\s+|\s+$//g;
930 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
931 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
937 $formatted_email = "$address";
939 $formatted_email = "$name <$address>";
942 $formatted_email = $address;
945 return $formatted_email;
948 sub find_first_section
{
951 while ($index < @typevalue) {
952 my $tv = $typevalue[$index];
953 if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
962 sub find_starting_index
{
966 my $tv = $typevalue[$index];
967 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
976 sub find_ending_index
{
979 while ($index < @typevalue) {
980 my $tv = $typevalue[$index];
981 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
990 sub get_subsystem_name
{
993 my $start = find_starting_index
($index);
995 my $subsystem = $typevalue[$start];
996 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
997 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
998 $subsystem =~ s/\s*$//;
999 $subsystem = $subsystem . "...";
1004 sub get_maintainer_role
{
1008 my $start = find_starting_index
($index);
1009 my $end = find_ending_index
($index);
1011 my $role = "unknown";
1012 my $subsystem = get_subsystem_name
($index);
1014 for ($i = $start + 1; $i < $end; $i++) {
1015 my $tv = $typevalue[$i];
1016 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1019 if ($ptype eq "S") {
1026 if ($role eq "supported") {
1027 $role = "supporter";
1028 } elsif ($role eq "maintained") {
1029 $role = "maintainer";
1030 } elsif ($role eq "odd fixes") {
1031 $role = "odd fixer";
1032 } elsif ($role eq "orphan") {
1033 $role = "orphan minder";
1034 } elsif ($role eq "obsolete") {
1035 $role = "obsolete minder";
1036 } elsif ($role eq "buried alive in reporters") {
1037 $role = "chief penguin";
1040 return $role . ":" . $subsystem;
1046 my $subsystem = get_subsystem_name
($index);
1048 if ($subsystem eq "THE REST") {
1055 sub add_categories
{
1059 my $start = find_starting_index
($index);
1060 my $end = find_ending_index
($index);
1062 push(@subsystem, $typevalue[$start]);
1064 for ($i = $start + 1; $i < $end; $i++) {
1065 my $tv = $typevalue[$i];
1066 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1069 if ($ptype eq "L") {
1070 my $list_address = $pvalue;
1071 my $list_additional = "";
1072 my $list_role = get_list_role
($i);
1074 if ($list_role ne "") {
1075 $list_role = ":" . $list_role;
1077 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1079 $list_additional = $2;
1081 if ($list_additional =~ m/subscribers-only/) {
1082 if ($email_subscriber_list) {
1083 if (!$hash_list_to{lc($list_address)}) {
1084 $hash_list_to{lc($list_address)} = 1;
1085 push(@list_to, [$list_address,
1086 "subscriber list${list_role}"]);
1091 if (!$hash_list_to{lc($list_address)}) {
1092 $hash_list_to{lc($list_address)} = 1;
1093 if ($list_additional =~ m/moderated/) {
1094 push(@list_to, [$list_address,
1095 "moderated list${list_role}"]);
1097 push(@list_to, [$list_address,
1098 "open list${list_role}"]);
1103 } elsif ($ptype eq "M") {
1104 my ($name, $address) = parse_email
($pvalue);
1107 my $tv = $typevalue[$i - 1];
1108 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1111 $pvalue = format_email
($name, $address, $email_usename);
1116 if ($email_maintainer) {
1117 my $role = get_maintainer_role
($i);
1118 push_email_addresses
($pvalue, $role);
1120 } elsif ($ptype eq "R") {
1121 my ($name, $address) = parse_email
($pvalue);
1124 my $tv = $typevalue[$i - 1];
1125 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1128 $pvalue = format_email
($name, $address, $email_usename);
1133 if ($email_reviewer) {
1134 my $subsystem = get_subsystem_name
($i);
1135 push_email_addresses
($pvalue, "reviewer:$subsystem");
1137 } elsif ($ptype eq "T") {
1138 push(@scm, $pvalue);
1139 } elsif ($ptype eq "W") {
1140 push(@web, $pvalue);
1141 } elsif ($ptype eq "S") {
1142 push(@status, $pvalue);
1149 my ($name, $address) = @_;
1151 return 1 if (($name eq "") && ($address eq ""));
1152 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1153 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1158 sub push_email_address
{
1159 my ($line, $role) = @_;
1161 my ($name, $address) = parse_email
($line);
1163 if ($address eq "") {
1167 if (!$email_remove_duplicates) {
1168 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1169 } elsif (!email_inuse
($name, $address)) {
1170 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1171 $email_hash_name{lc($name)}++ if ($name ne "");
1172 $email_hash_address{lc($address)}++;
1178 sub push_email_addresses
{
1179 my ($address, $role) = @_;
1181 my @address_list = ();
1183 if (rfc822_valid
($address)) {
1184 push_email_address
($address, $role);
1185 } elsif (@address_list = rfc822_validlist
($address)) {
1186 my $array_count = shift(@address_list);
1187 while (my $entry = shift(@address_list)) {
1188 push_email_address
($entry, $role);
1191 if (!push_email_address
($address, $role)) {
1192 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1198 my ($line, $role) = @_;
1200 my ($name, $address) = parse_email
($line);
1201 my $email = format_email
($name, $address, $email_usename);
1203 foreach my $entry (@email_to) {
1204 if ($email_remove_duplicates) {
1205 my ($entry_name, $entry_address) = parse_email
($entry->[0]);
1206 if (($name eq $entry_name || $address eq $entry_address)
1207 && ($role eq "" || !($entry->[1] =~ m/$role/))
1209 if ($entry->[1] eq "") {
1210 $entry->[1] = "$role";
1212 $entry->[1] = "$entry->[1],$role";
1216 if ($email eq $entry->[0]
1217 && ($role eq "" || !($entry->[1] =~ m/$role/))
1219 if ($entry->[1] eq "") {
1220 $entry->[1] = "$role";
1222 $entry->[1] = "$entry->[1],$role";
1232 foreach my $path (split(/:/, $ENV{PATH
})) {
1233 if (-e
"$path/$bin") {
1234 return "$path/$bin";
1244 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1245 if (-e
"$path/$conf") {
1246 return "$path/$conf";
1256 my ($name, $address) = parse_email
($line);
1257 my $email = format_email
($name, $address, 1);
1258 my $real_name = $name;
1259 my $real_address = $address;
1261 if (exists $mailmap->{names
}->{$email} ||
1262 exists $mailmap->{addresses
}->{$email}) {
1263 if (exists $mailmap->{names
}->{$email}) {
1264 $real_name = $mailmap->{names
}->{$email};
1266 if (exists $mailmap->{addresses
}->{$email}) {
1267 $real_address = $mailmap->{addresses
}->{$email};
1270 if (exists $mailmap->{names
}->{$address}) {
1271 $real_name = $mailmap->{names
}->{$address};
1273 if (exists $mailmap->{addresses
}->{$address}) {
1274 $real_address = $mailmap->{addresses
}->{$address};
1277 return format_email
($real_name, $real_address, 1);
1281 my (@addresses) = @_;
1283 my @mapped_emails = ();
1284 foreach my $line (@addresses) {
1285 push(@mapped_emails, mailmap_email
($line));
1287 merge_by_realname
(@mapped_emails) if ($email_use_mailmap);
1288 return @mapped_emails;
1291 sub merge_by_realname
{
1295 foreach my $email (@emails) {
1296 my ($name, $address) = parse_email
($email);
1297 if (exists $address_map{$name}) {
1298 $address = $address_map{$name};
1299 $email = format_email
($name, $address, 1);
1301 $address_map{$name} = $address;
1306 sub git_execute_cmd
{
1310 my $output = `$cmd`;
1311 $output =~ s/^\s*//gm;
1312 @lines = split("\n", $output);
1317 sub hg_execute_cmd
{
1321 my $output = `$cmd`;
1322 @lines = split("\n", $output);
1327 sub extract_formatted_signatures
{
1328 my (@signature_lines) = @_;
1330 my @type = @signature_lines;
1332 s/\s*(.*):.*/$1/ for (@type);
1335 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1337 ## Reformat email addresses (with names) to avoid badly written signatures
1339 foreach my $signer (@signature_lines) {
1340 $signer = deduplicate_email
($signer);
1343 return (\
@type, \
@signature_lines);
1346 sub vcs_find_signers
{
1347 my ($cmd, $file) = @_;
1350 my @signatures = ();
1354 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1356 my $pattern = $VCS_cmds{"commit_pattern"};
1357 my $author_pattern = $VCS_cmds{"author_pattern"};
1358 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1360 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1362 $commits = grep(/$pattern/, @lines); # of commits
1364 @authors = grep(/$author_pattern/, @lines);
1365 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1366 @stats = grep(/$stat_pattern/, @lines);
1368 # print("stats: <@stats>\n");
1370 return (0, \
@signatures, \
@authors, \
@stats) if !@signatures;
1372 save_commits_by_author
(@lines) if ($interactive);
1373 save_commits_by_signer
(@lines) if ($interactive);
1375 if (!$email_git_penguin_chiefs) {
1376 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1379 my ($author_ref, $authors_ref) = extract_formatted_signatures
(@authors);
1380 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1382 return ($commits, $signers_ref, $authors_ref, \
@stats);
1385 sub vcs_find_author
{
1389 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1391 if (!$email_git_penguin_chiefs) {
1392 @lines = grep(!/${penguin_chiefs}/i, @lines);
1395 return @lines if !@lines;
1398 foreach my $line (@lines) {
1399 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1401 my ($name, $address) = parse_email
($author);
1402 $author = format_email
($name, $address, 1);
1403 push(@authors, $author);
1407 save_commits_by_author
(@lines) if ($interactive);
1408 save_commits_by_signer
(@lines) if ($interactive);
1413 sub vcs_save_commits
{
1418 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1420 foreach my $line (@lines) {
1421 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1434 return @commits if (!(-f
$file));
1436 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1437 my @all_commits = ();
1439 $cmd = $VCS_cmds{"blame_file_cmd"};
1440 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1441 @all_commits = vcs_save_commits
($cmd);
1443 foreach my $file_range_diff (@range) {
1444 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1446 my $diff_start = $2;
1447 my $diff_length = $3;
1448 next if ("$file" ne "$diff_file");
1449 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1450 push(@commits, $all_commits[$i]);
1454 foreach my $file_range_diff (@range) {
1455 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1457 my $diff_start = $2;
1458 my $diff_length = $3;
1459 next if ("$file" ne "$diff_file");
1460 $cmd = $VCS_cmds{"blame_range_cmd"};
1461 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1462 push(@commits, vcs_save_commits
($cmd));
1465 $cmd = $VCS_cmds{"blame_file_cmd"};
1466 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1467 @commits = vcs_save_commits
($cmd);
1470 foreach my $commit (@commits) {
1471 $commit =~ s/^\^//g;
1477 my $printed_novcs = 0;
1479 %VCS_cmds = %VCS_cmds_git;
1480 return 1 if eval $VCS_cmds{"available"};
1481 %VCS_cmds = %VCS_cmds_hg;
1482 return 2 if eval $VCS_cmds{"available"};
1484 if (!$printed_novcs) {
1485 warn("$P: No supported VCS found. Add --nogit to options?\n");
1486 warn("Using a git repository produces better results.\n");
1487 warn("Try Linus Torvalds' latest git repository using:\n");
1488 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1496 return $vcs_used == 1;
1500 return $vcs_used == 2;
1503 sub interactive_get_maintainers
{
1504 my ($list_ref) = @_;
1505 my @list = @
$list_ref;
1514 foreach my $entry (@list) {
1515 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1516 $selected{$count} = 1;
1517 $authored{$count} = 0;
1518 $signed{$count} = 0;
1524 my $print_options = 0;
1529 printf STDERR
"\n%1s %2s %-65s",
1530 "*", "#", "email/list and role:stats";
1532 ($email_git_fallback && !$maintained) ||
1534 print STDERR
"auth sign";
1537 foreach my $entry (@list) {
1538 my $email = $entry->[0];
1539 my $role = $entry->[1];
1541 $sel = "*" if ($selected{$count});
1542 my $commit_author = $commit_author_hash{$email};
1543 my $commit_signer = $commit_signer_hash{$email};
1546 $authored++ for (@
{$commit_author});
1547 $signed++ for (@
{$commit_signer});
1548 printf STDERR
"%1s %2d %-65s", $sel, $count + 1, $email;
1549 printf STDERR
"%4d %4d", $authored, $signed
1550 if ($authored > 0 || $signed > 0);
1551 printf STDERR
"\n %s\n", $role;
1552 if ($authored{$count}) {
1553 my $commit_author = $commit_author_hash{$email};
1554 foreach my $ref (@
{$commit_author}) {
1555 print STDERR
" Author: @{$ref}[1]\n";
1558 if ($signed{$count}) {
1559 my $commit_signer = $commit_signer_hash{$email};
1560 foreach my $ref (@
{$commit_signer}) {
1561 print STDERR
" @{$ref}[2]: @{$ref}[1]\n";
1568 my $date_ref = \
$email_git_since;
1569 $date_ref = \
$email_hg_since if (vcs_is_hg
());
1570 if ($print_options) {
1575 Version Control options:
1576 g use git history [$email_git]
1577 gf use git-fallback [$email_git_fallback]
1578 b use git blame [$email_git_blame]
1579 bs use blame signatures [$email_git_blame_signatures]
1580 c# minimum commits [$email_git_min_signatures]
1581 %# min percent [$email_git_min_percent]
1582 d# history to use [$$date_ref]
1583 x# max maintainers [$email_git_max_maintainers]
1584 t all signature types [$email_git_all_signature_types]
1585 m use .mailmap [$email_use_mailmap]
1592 tm toggle maintainers
1593 tg toggle git entries
1594 tl toggle open list entries
1595 ts toggle subscriber list entries
1596 f emails in file [$file_emails]
1597 k keywords in file [$keywords]
1598 r remove duplicates [$email_remove_duplicates]
1599 p# pattern match depth [$pattern_depth]
1603 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1605 my $input = <STDIN
>;
1610 my @wish = split(/[, ]+/, $input);
1611 foreach my $nr (@wish) {
1613 my $sel = substr($nr, 0, 1);
1614 my $str = substr($nr, 1);
1616 $val = $1 if $str =~ /^(\d+)$/;
1621 $output_rolestats = 0;
1624 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1625 $selected{$nr - 1} = !$selected{$nr - 1};
1626 } elsif ($sel eq "*" || $sel eq '^') {
1628 $toggle = 1 if ($sel eq '*');
1629 for (my $i = 0; $i < $count; $i++) {
1630 $selected{$i} = $toggle;
1632 } elsif ($sel eq "0") {
1633 for (my $i = 0; $i < $count; $i++) {
1634 $selected{$i} = !$selected{$i};
1636 } elsif ($sel eq "t") {
1637 if (lc($str) eq "m") {
1638 for (my $i = 0; $i < $count; $i++) {
1639 $selected{$i} = !$selected{$i}
1640 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1642 } elsif (lc($str) eq "g") {
1643 for (my $i = 0; $i < $count; $i++) {
1644 $selected{$i} = !$selected{$i}
1645 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1647 } elsif (lc($str) eq "l") {
1648 for (my $i = 0; $i < $count; $i++) {
1649 $selected{$i} = !$selected{$i}
1650 if ($list[$i]->[1] =~ /^(open list)/i);
1652 } elsif (lc($str) eq "s") {
1653 for (my $i = 0; $i < $count; $i++) {
1654 $selected{$i} = !$selected{$i}
1655 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1658 } elsif ($sel eq "a") {
1659 if ($val > 0 && $val <= $count) {
1660 $authored{$val - 1} = !$authored{$val - 1};
1661 } elsif ($str eq '*' || $str eq '^') {
1663 $toggle = 1 if ($str eq '*');
1664 for (my $i = 0; $i < $count; $i++) {
1665 $authored{$i} = $toggle;
1668 } elsif ($sel eq "s") {
1669 if ($val > 0 && $val <= $count) {
1670 $signed{$val - 1} = !$signed{$val - 1};
1671 } elsif ($str eq '*' || $str eq '^') {
1673 $toggle = 1 if ($str eq '*');
1674 for (my $i = 0; $i < $count; $i++) {
1675 $signed{$i} = $toggle;
1678 } elsif ($sel eq "o") {
1681 } elsif ($sel eq "g") {
1683 bool_invert
(\
$email_git_fallback);
1685 bool_invert
(\
$email_git);
1688 } elsif ($sel eq "b") {
1690 bool_invert
(\
$email_git_blame_signatures);
1692 bool_invert
(\
$email_git_blame);
1695 } elsif ($sel eq "c") {
1697 $email_git_min_signatures = $val;
1700 } elsif ($sel eq "x") {
1702 $email_git_max_maintainers = $val;
1705 } elsif ($sel eq "%") {
1706 if ($str ne "" && $val >= 0) {
1707 $email_git_min_percent = $val;
1710 } elsif ($sel eq "d") {
1712 $email_git_since = $str;
1713 } elsif (vcs_is_hg
()) {
1714 $email_hg_since = $str;
1717 } elsif ($sel eq "t") {
1718 bool_invert
(\
$email_git_all_signature_types);
1720 } elsif ($sel eq "f") {
1721 bool_invert
(\
$file_emails);
1723 } elsif ($sel eq "r") {
1724 bool_invert
(\
$email_remove_duplicates);
1726 } elsif ($sel eq "m") {
1727 bool_invert
(\
$email_use_mailmap);
1730 } elsif ($sel eq "k") {
1731 bool_invert
(\
$keywords);
1733 } elsif ($sel eq "p") {
1734 if ($str ne "" && $val >= 0) {
1735 $pattern_depth = $val;
1738 } elsif ($sel eq "h" || $sel eq "?") {
1741 Interactive mode allows you to select the various maintainers, submitters,
1742 commit signers and mailing lists that could be CC'd on a patch.
1744 Any *'d entry is selected.
1746 If you have git or hg installed, you can choose to summarize the commit
1747 history of files in the patch. Also, each line of the current file can
1748 be matched to its commit author and that commits signers with blame.
1750 Various knobs exist to control the length of time for active commit
1751 tracking, the maximum number of commit authors and signers to add,
1754 Enter selections at the prompt until you are satisfied that the selected
1755 maintainers are appropriate. You may enter multiple selections separated
1756 by either commas or spaces.
1760 print STDERR
"invalid option: '$nr'\n";
1765 print STDERR
"git-blame can be very slow, please have patience..."
1766 if ($email_git_blame);
1767 goto &get_maintainers
;
1771 #drop not selected entries
1773 my @new_emailto = ();
1774 foreach my $entry (@list) {
1775 if ($selected{$count}) {
1776 push(@new_emailto, $list[$count]);
1780 return @new_emailto;
1784 my ($bool_ref) = @_;
1793 sub deduplicate_email
{
1797 my ($name, $address) = parse_email
($email);
1798 $email = format_email
($name, $address, 1);
1799 $email = mailmap_email
($email);
1801 return $email if (!$email_remove_duplicates);
1803 ($name, $address) = parse_email
($email);
1805 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1806 $name = $deduplicate_name_hash{lc($name)}->[0];
1807 $address = $deduplicate_name_hash{lc($name)}->[1];
1809 } elsif ($deduplicate_address_hash{lc($address)}) {
1810 $name = $deduplicate_address_hash{lc($address)}->[0];
1811 $address = $deduplicate_address_hash{lc($address)}->[1];
1815 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1816 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1818 $email = format_email
($name, $address, 1);
1819 $email = mailmap_email
($email);
1823 sub save_commits_by_author
{
1830 foreach my $line (@lines) {
1831 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1833 $author = deduplicate_email
($author);
1834 push(@authors, $author);
1836 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1837 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1840 for (my $i = 0; $i < @authors; $i++) {
1842 foreach my $ref(@
{$commit_author_hash{$authors[$i]}}) {
1843 if (@
{$ref}[0] eq $commits[$i] &&
1844 @
{$ref}[1] eq $subjects[$i]) {
1850 push(@
{$commit_author_hash{$authors[$i]}},
1851 [ ($commits[$i], $subjects[$i]) ]);
1856 sub save_commits_by_signer
{
1862 foreach my $line (@lines) {
1863 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1864 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1865 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1866 my @signatures = ($line);
1867 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1868 my @types = @
$types_ref;
1869 my @signers = @
$signers_ref;
1871 my $type = $types[0];
1872 my $signer = $signers[0];
1874 $signer = deduplicate_email
($signer);
1877 foreach my $ref(@
{$commit_signer_hash{$signer}}) {
1878 if (@
{$ref}[0] eq $commit &&
1879 @
{$ref}[1] eq $subject &&
1880 @
{$ref}[2] eq $type) {
1886 push(@
{$commit_signer_hash{$signer}},
1887 [ ($commit, $subject, $type) ]);
1894 my ($role, $divisor, @lines) = @_;
1899 return if (@lines <= 0);
1901 if ($divisor <= 0) {
1902 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1906 @lines = mailmap
(@lines);
1908 return if (@lines <= 0);
1910 @lines = sort(@lines);
1913 $hash{$_}++ for @lines;
1916 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1917 my $sign_offs = $hash{$line};
1918 my $percent = $sign_offs * 100 / $divisor;
1920 $percent = 100 if ($percent > 100);
1921 next if (ignore_email_address
($line));
1923 last if ($sign_offs < $email_git_min_signatures ||
1924 $count > $email_git_max_maintainers ||
1925 $percent < $email_git_min_percent);
1926 push_email_address
($line, '');
1927 if ($output_rolestats) {
1928 my $fmt_percent = sprintf("%.0f", $percent);
1929 add_role
($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1931 add_role
($line, $role);
1936 sub vcs_file_signoffs
{
1947 $vcs_used = vcs_exists
();
1948 return if (!$vcs_used);
1950 my $cmd = $VCS_cmds{"find_signers_cmd"};
1951 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1953 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
1955 @signers = @
{$signers_ref} if defined $signers_ref;
1956 @authors = @
{$authors_ref} if defined $authors_ref;
1957 @stats = @
{$stats_ref} if defined $stats_ref;
1959 # print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1961 foreach my $signer (@signers) {
1962 $signer = deduplicate_email
($signer);
1965 vcs_assign
("commit_signer", $commits, @signers);
1966 vcs_assign
("authored", $commits, @authors);
1967 if ($#authors == $#stats) {
1968 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1969 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1973 for (my $i = 0; $i <= $#stats; $i++) {
1974 if ($stats[$i] =~ /$stat_pattern/) {
1979 my @tmp_authors = uniq
(@authors);
1980 foreach my $author (@tmp_authors) {
1981 $author = deduplicate_email
($author);
1983 @tmp_authors = uniq
(@tmp_authors);
1984 my @list_added = ();
1985 my @list_deleted = ();
1986 foreach my $author (@tmp_authors) {
1988 my $auth_deleted = 0;
1989 for (my $i = 0; $i <= $#stats; $i++) {
1990 if ($author eq deduplicate_email
($authors[$i]) &&
1991 $stats[$i] =~ /$stat_pattern/) {
1993 $auth_deleted += $2;
1996 for (my $i = 0; $i < $auth_added; $i++) {
1997 push(@list_added, $author);
1999 for (my $i = 0; $i < $auth_deleted; $i++) {
2000 push(@list_deleted, $author);
2003 vcs_assign
("added_lines", $added, @list_added);
2004 vcs_assign
("removed_lines", $deleted, @list_deleted);
2008 sub vcs_file_blame
{
2012 my @all_commits = ();
2017 $vcs_used = vcs_exists
();
2018 return if (!$vcs_used);
2020 @all_commits = vcs_blame
($file);
2021 @commits = uniq
(@all_commits);
2022 $total_commits = @commits;
2023 $total_lines = @all_commits;
2025 if ($email_git_blame_signatures) {
2028 my $commit_authors_ref;
2029 my $commit_signers_ref;
2031 my @commit_authors = ();
2032 my @commit_signers = ();
2033 my $commit = join(" -r ", @commits);
2036 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2037 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2039 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
2040 @commit_authors = @
{$commit_authors_ref} if defined $commit_authors_ref;
2041 @commit_signers = @
{$commit_signers_ref} if defined $commit_signers_ref;
2043 push(@signers, @commit_signers);
2045 foreach my $commit (@commits) {
2047 my $commit_authors_ref;
2048 my $commit_signers_ref;
2050 my @commit_authors = ();
2051 my @commit_signers = ();
2054 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2055 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2057 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
2058 @commit_authors = @
{$commit_authors_ref} if defined $commit_authors_ref;
2059 @commit_signers = @
{$commit_signers_ref} if defined $commit_signers_ref;
2061 push(@signers, @commit_signers);
2066 if ($from_filename) {
2067 if ($output_rolestats) {
2069 if (vcs_is_hg
()) {{ # Double brace for last exit
2071 my @commit_signers = ();
2072 @commits = uniq
(@commits);
2073 @commits = sort(@commits);
2074 my $commit = join(" -r ", @commits);
2077 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2078 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2082 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2084 if (!$email_git_penguin_chiefs) {
2085 @lines = grep(!/${penguin_chiefs}/i, @lines);
2091 foreach my $line (@lines) {
2092 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2094 $author = deduplicate_email
($author);
2095 push(@authors, $author);
2099 save_commits_by_author
(@lines) if ($interactive);
2100 save_commits_by_signer
(@lines) if ($interactive);
2102 push(@signers, @authors);
2105 foreach my $commit (@commits) {
2107 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2108 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2109 my @author = vcs_find_author
($cmd);
2112 my $formatted_author = deduplicate_email
($author[0]);
2114 my $count = grep(/$commit/, @all_commits);
2115 for ($i = 0; $i < $count ; $i++) {
2116 push(@blame_signers, $formatted_author);
2120 if (@blame_signers) {
2121 vcs_assign
("authored lines", $total_lines, @blame_signers);
2124 foreach my $signer (@signers) {
2125 $signer = deduplicate_email
($signer);
2127 vcs_assign
("commits", $total_commits, @signers);
2129 foreach my $signer (@signers) {
2130 $signer = deduplicate_email
($signer);
2132 vcs_assign
("modified commits", $total_commits, @signers);
2136 sub vcs_file_exists
{
2141 my $vcs_used = vcs_exists
();
2142 return 0 if (!$vcs_used);
2144 my $cmd = $VCS_cmds{"file_exists_cmd"};
2145 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
2147 $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2149 return 0 if ($?
!= 0);
2158 @parms = grep(!$saw{$_}++, @parms);
2166 @parms = sort @parms;
2167 @parms = grep(!$saw{$_}++, @parms);
2171 sub clean_file_emails
{
2172 my (@file_emails) = @_;
2173 my @fmt_emails = ();
2175 foreach my $email (@file_emails) {
2176 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2177 my ($name, $address) = parse_email
($email);
2178 if ($name eq '"[,\.]"') {
2182 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2184 my $first = $nw[@nw - 3];
2185 my $middle = $nw[@nw - 2];
2186 my $last = $nw[@nw - 1];
2188 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2189 (length($first) == 2 && substr($first, -1) eq ".")) ||
2190 (length($middle) == 1 ||
2191 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2192 $name = "$first $middle $last";
2194 $name = "$middle $last";
2198 if (substr($name, -1) =~ /[,\.]/) {
2199 $name = substr($name, 0, length($name) - 1);
2200 } elsif (substr($name, -2) =~ /[,\.]"/) {
2201 $name = substr($name, 0, length($name) - 2) . '"';
2204 if (substr($name, 0, 1) =~ /[,\.]/) {
2205 $name = substr($name, 1, length($name) - 1);
2206 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2207 $name = '"' . substr($name, 2, length($name) - 2);
2210 my $fmt_email = format_email
($name, $address, $email_usename);
2211 push(@fmt_emails, $fmt_email);
2221 my ($address, $role) = @
$_;
2222 if (!$saw{$address}) {
2223 if ($output_roles) {
2224 push(@lines, "$address ($role)");
2226 push(@lines, $address);
2238 if ($output_multiline) {
2239 foreach my $line (@parms) {
2243 print(join($output_separator, @parms));
2251 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2252 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2253 # This regexp will only work on addresses which have had comments stripped
2254 # and replaced with rfc822_lwsp.
2256 my $specials = '()<>@,;:\\\\".\\[\\]';
2257 my $controls = '\\000-\\037\\177';
2259 my $dtext = "[^\\[\\]\\r\\\\]";
2260 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2262 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2264 # Use zero-width assertion to spot the limit of an atom. A simple
2265 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2266 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2267 my $word = "(?:$atom|$quoted_string)";
2268 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2270 my $sub_domain = "(?:$atom|$domain_literal)";
2271 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2273 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2275 my $phrase = "$word*";
2276 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2277 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2278 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2280 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2281 my $address = "(?:$mailbox|$group)";
2283 return "$rfc822_lwsp*$address";
2286 sub rfc822_strip_comments
{
2288 # Recursively remove comments, and replace with a single space. The simpler
2289 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2290 # chars in atoms, for example.
2292 while ($s =~ s
/^((?
:[^"\\]|\\.)*
2293 (?:"(?
:[^"\\]|\\.)*"(?
:[^"\\]|\\.)*)*)
2294 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2298 # valid: returns true if the parameter is an RFC822 valid address
2301 my $s = rfc822_strip_comments(shift);
2304 $rfc822re = make_rfc822re();
2307 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2310 # validlist: In scalar context, returns true if the parameter is an RFC822
2311 # valid list of addresses.
2313 # In list context, returns an empty list on failure (an invalid
2314 # address was found); otherwise a list whose first element is the
2315 # number of addresses found and whose remaining elements are the
2316 # addresses. This is needed to disambiguate failure (invalid)
2317 # from success with no addresses found, because an empty string is
2320 sub rfc822_validlist {
2321 my $s = rfc822_strip_comments(shift);
2324 $rfc822re = make_rfc822re();
2326 # * null list items are valid according to the RFC
2327 # * the '1' business is to aid in distinguishing failure from no results
2330 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2331 $s =~ m/^$rfc822_char*$/) {
2332 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2335 return wantarray ? (scalar(@r), @r) : 1;
2337 return wantarray ? () : 0;