2 # (c) 2007, Joe Perches <joe@perches.com>
3 # created from checkpatch.pl
5 # Print selected REVIEWERS information for
6 # the files modified in a patch or for a file
8 # usage: perl scripts/get_reviewer.pl [OPTIONS] <patch>
9 # perl scripts/get_reviewer.pl [OPTIONS] -f <file>
11 # A minimally modified version of get_maintainer.pl from the
12 # Linux source tree, adapted for use in mesa.
14 # Licensed under the terms of the GNU GPL License version 2
22 use Getopt
::Long
qw(:config no_auto_abbrev);
25 my $cur_path = fastgetcwd
() . '/';
28 my $email_usename = 1;
29 my $email_maintainer = 1;
30 my $email_reviewer = 1;
32 my $email_subscriber_list = 0;
33 my $email_git_penguin_chiefs = 0;
35 my $email_git_all_signature_types = 0;
36 my $email_git_blame = 0;
37 my $email_git_blame_signatures = 1;
38 my $email_git_fallback = 1;
39 my $email_git_min_signatures = 1;
40 my $email_git_max_maintainers = 5;
41 my $email_git_min_percent = 15;
42 my $email_git_since = "1-year-ago";
43 my $email_hg_since = "-365";
45 my $email_remove_duplicates = 1;
46 my $email_use_mailmap = 1;
47 my $output_multiline = 1;
48 my $output_separator = ", ";
50 my $output_rolestats = 1;
51 my $output_section_maxlen = 50;
59 my $from_filename = 0;
60 my $pattern_depth = 0;
68 my %commit_author_hash;
69 my %commit_signer_hash;
71 my @penguin_chief = ();
72 #push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
73 #Andrew wants in on most everything - 2009/01/14
74 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
76 my @penguin_chief_names = ();
77 foreach my $chief (@penguin_chief) {
78 if ($chief =~ m/^(.*):(.*)/) {
81 push(@penguin_chief_names, $chief_name);
84 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
86 # Signature types of people who are either
87 # a) responsible for the code in question, or
88 # b) familiar enough with it to give relevant feedback
89 my @signature_tags = ();
90 push(@signature_tags, "Signed-off-by:");
91 push(@signature_tags, "Reviewed-by:");
92 push(@signature_tags, "Acked-by:");
94 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
96 # rfc822 email address - preloaded methods go here.
97 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
98 my $rfc822_char = '[\\000-\\377]';
100 # VCS command support: class-like functions and strings
105 "execute_cmd" => \
&git_execute_cmd
,
106 "available" => '(which("git") ne "") && (-e ".git")',
107 "find_signers_cmd" =>
108 "git log --no-color --follow --since=\$email_git_since " .
109 '--numstat --no-merges ' .
110 '--format="GitCommit: %H%n' .
111 'GitAuthor: %an <%ae>%n' .
116 "find_commit_signers_cmd" =>
117 "git log --no-color " .
119 '--format="GitCommit: %H%n' .
120 'GitAuthor: %an <%ae>%n' .
125 "find_commit_author_cmd" =>
126 "git log --no-color " .
128 '--format="GitCommit: %H%n' .
129 'GitAuthor: %an <%ae>%n' .
131 'GitSubject: %s%n"' .
133 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
134 "blame_file_cmd" => "git blame -l \$file",
135 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
136 "blame_commit_pattern" => "^([0-9a-f]+) ",
137 "author_pattern" => "^GitAuthor: (.*)",
138 "subject_pattern" => "^GitSubject: (.*)",
139 "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
143 "execute_cmd" => \
&hg_execute_cmd
,
144 "available" => '(which("hg") ne "") && (-d ".hg")',
145 "find_signers_cmd" =>
146 "hg log --date=\$email_hg_since " .
147 "--template='HgCommit: {node}\\n" .
148 "HgAuthor: {author}\\n" .
149 "HgSubject: {desc}\\n'" .
151 "find_commit_signers_cmd" =>
153 "--template='HgSubject: {desc}\\n'" .
155 "find_commit_author_cmd" =>
157 "--template='HgCommit: {node}\\n" .
158 "HgAuthor: {author}\\n" .
159 "HgSubject: {desc|firstline}\\n'" .
161 "blame_range_cmd" => "", # not supported
162 "blame_file_cmd" => "hg blame -n \$file",
163 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
164 "blame_commit_pattern" => "^([ 0-9a-f]+):",
165 "author_pattern" => "^HgAuthor: (.*)",
166 "subject_pattern" => "^HgSubject: (.*)",
167 "stat_pattern" => "^(\\d+)\t(\\d+)\t\$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 'pattern-depth=i' => \
$pattern_depth,
247 'k|keywords!' => \
$keywords,
248 'sections!' => \
$sections,
249 'fe|file-emails!' => \
$file_emails,
250 'f|file' => \
$from_filename,
251 'v|version' => \
$version,
252 'h|help|usage' => \
$help,
254 die "$P: invalid argument - use --help if necessary\n";
263 print("${P} ${V}\n");
267 if (-t STDIN
&& !@ARGV) {
268 # We're talking to a terminal, but have no command line arguments.
269 die "$P: missing patchfile or -f file - use --help if necessary\n";
272 $output_multiline = 0 if ($output_separator ne ", ");
273 $output_rolestats = 1 if ($interactive);
274 $output_roles = 1 if ($output_rolestats);
286 my $selections = $email + $scm + $status + $subsystem + $web;
287 if ($selections == 0) {
288 die "$P: Missing required option: email, scm, status, subsystem or web\n";
293 ($email_maintainer + $email_reviewer +
294 $email_list + $email_subscriber_list +
295 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
296 die "$P: Please select at least 1 email option\n";
299 if (!top_of_mesa_tree
($lk_path)) {
300 die "$P: The current directory does not appear to be "
301 . "a mesa source tree.\n";
304 ## Read REVIEWERS for type/value pairs
309 open (my $maint, '<', "${lk_path}REVIEWERS")
310 or die "$P: Can't open REVIEWERS: $!\n";
314 if ($line =~ m/^([A-Z]):\s*(.*)/) {
318 ##Filename pattern matching
319 if ($type eq "F" || $type eq "X") {
320 $value =~ s@\
.@
\\\
.@g; ##Convert . to \.
321 $value =~ s/\*/\.\*/g; ##Convert * to .*
322 $value =~ s/\?/\./g; ##Convert ? to .
323 ##if pattern is a directory and it lacks a trailing slash, add one
325 $value =~ s@
([^/])$@$1/@
;
327 } elsif ($type eq "K") {
328 $keyword_hash{@typevalue} = $value;
330 push(@typevalue, "$type:$value");
331 } elsif (!/^(\s)*$/) {
333 push(@typevalue, $line);
340 # Read mail address map
353 return if (!$email_use_mailmap || !(-f
"${lk_path}.mailmap"));
355 open(my $mailmap_file, '<', "${lk_path}.mailmap")
356 or warn "$P: Can't open .mailmap: $!\n";
358 while (<$mailmap_file>) {
359 s/#.*$//; #strip comments
360 s/^\s+|\s+$//g; #trim
362 next if (/^\s*$/); #skip empty lines
363 #entries have one of the following formats:
366 # name1 <mail1> <mail2>
367 # name1 <mail1> name2 <mail2>
368 # (see man git-shortlog)
370 if (/^([^<]+)<([^>]+)>$/) {
374 $real_name =~ s/\s+$//;
375 ($real_name, $address) = parse_email
("$real_name <$address>");
376 $mailmap->{names
}->{$address} = $real_name;
378 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
379 my $real_address = $1;
380 my $wrong_address = $2;
382 $mailmap->{addresses
}->{$wrong_address} = $real_address;
384 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
386 my $real_address = $2;
387 my $wrong_address = $3;
389 $real_name =~ s/\s+$//;
390 ($real_name, $real_address) =
391 parse_email
("$real_name <$real_address>");
392 $mailmap->{names
}->{$wrong_address} = $real_name;
393 $mailmap->{addresses
}->{$wrong_address} = $real_address;
395 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
397 my $real_address = $2;
399 my $wrong_address = $4;
401 $real_name =~ s/\s+$//;
402 ($real_name, $real_address) =
403 parse_email
("$real_name <$real_address>");
405 $wrong_name =~ s/\s+$//;
406 ($wrong_name, $wrong_address) =
407 parse_email
("$wrong_name <$wrong_address>");
409 my $wrong_email = format_email
($wrong_name, $wrong_address, 1);
410 $mailmap->{names
}->{$wrong_email} = $real_name;
411 $mailmap->{addresses
}->{$wrong_email} = $real_address;
414 close($mailmap_file);
417 ## use the filenames on the command line or find the filenames in the patchfiles
421 my @keyword_tvi = ();
422 my @file_emails = ();
425 push(@ARGV, "&STDIN");
428 foreach my $file (@ARGV) {
429 if ($file ne "&STDIN") {
430 ##if $file is a directory and it lacks a trailing slash, add one
432 $file =~ s@
([^/])$@$1/@
;
433 } elsif (!(-f
$file)) {
434 die "$P: file '${file}' not found\n";
437 if ($from_filename) {
438 $file =~ s/^\Q${cur_path}\E//; #strip any absolute path
439 $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree
441 if ($file ne "REVIEWERS" && -f
$file && ($keywords || $file_emails)) {
442 open(my $f, '<', $file)
443 or die "$P: Can't open $file: $!\n";
444 my $text = do { local($/) ; <$f> };
447 foreach my $line (keys %keyword_hash) {
448 if ($text =~ m/$keyword_hash{$line}/x) {
449 push(@keyword_tvi, $line);
454 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;
455 push(@file_emails, clean_file_emails
(@poss_addr));
459 my $file_cnt = @files;
462 open(my $patch, "< $file")
463 or die "$P: Can't open $file: $!\n";
465 # We can check arbitrary information before the patch
466 # like the commit message, mail headers, etc...
467 # This allows us to match arbitrary keywords against any part
468 # of a git format-patch generated file (subject tags, etc...)
470 my $patch_prefix = ""; #Parsing the intro
474 if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
476 $filename =~ s@
^[^/]*/@@
;
478 $lastfile = $filename;
479 push(@files, $filename);
480 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
481 } elsif (m/^\@\@ -(\d+),(\d+)/) {
482 if ($email_git_blame) {
483 push(@range, "$lastfile:$1:$2");
485 } elsif ($keywords) {
486 foreach my $line (keys %keyword_hash) {
487 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
488 push(@keyword_tvi, $line);
495 if ($file_cnt == @files) {
496 warn "$P: file '${file}' doesn't appear to be a patch. "
497 . "Add -f to options?\n";
499 @files = sort_and_uniq
(@files);
503 @file_emails = uniq
(@file_emails);
506 my %email_hash_address;
514 my %deduplicate_name_hash = ();
515 my %deduplicate_address_hash = ();
517 my @maintainers = get_maintainers
();
520 @maintainers = merge_email
(@maintainers);
521 output
(@maintainers);
530 @status = uniq
(@status);
535 @subsystem = uniq
(@subsystem);
546 sub ignore_email_address
{
549 foreach my $ignore (@ignore_emails) {
550 return 1 if ($ignore eq $address);
556 sub range_is_maintained
{
557 my ($start, $end) = @_;
559 for (my $i = $start; $i < $end; $i++) {
560 my $line = $typevalue[$i];
561 if ($line =~ m/^([A-Z]):\s*(.*)/) {
565 if ($value =~ /(maintain|support)/i) {
574 sub range_has_maintainer
{
575 my ($start, $end) = @_;
577 for (my $i = $start; $i < $end; $i++) {
578 my $line = $typevalue[$i];
579 if ($line =~ m/^([A-Z]):\s*(.*)/) {
590 sub get_maintainers
{
591 %email_hash_name = ();
592 %email_hash_address = ();
593 %commit_author_hash = ();
594 %commit_signer_hash = ();
602 %deduplicate_name_hash = ();
603 %deduplicate_address_hash = ();
604 if ($email_git_all_signature_types) {
605 $signature_pattern = "(.+?)[Bb][Yy]:";
607 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
610 # Find responsible parties
612 my %exact_pattern_match_hash = ();
614 foreach my $file (@files) {
617 my $tvi = find_first_section
();
618 while ($tvi < @typevalue) {
619 my $start = find_starting_index
($tvi);
620 my $end = find_ending_index
($tvi);
624 #Do not match excluded file patterns
626 for ($i = $start; $i < $end; $i++) {
627 my $line = $typevalue[$i];
628 if ($line =~ m/^([A-Z]):\s*(.*)/) {
632 if (file_match_pattern
($file, $value)) {
641 for ($i = $start; $i < $end; $i++) {
642 my $line = $typevalue[$i];
643 if ($line =~ m/^([A-Z]):\s*(.*)/) {
647 if (file_match_pattern
($file, $value)) {
648 my $value_pd = ($value =~ tr@
/@@
);
649 my $file_pd = ($file =~ tr@
/@@
);
650 $value_pd++ if (substr($value,-1,1) ne "/");
651 $value_pd = -1 if ($value =~ /^\.\*/);
652 if ($value_pd >= $file_pd &&
653 range_is_maintained
($start, $end) &&
654 range_has_maintainer
($start, $end)) {
655 $exact_pattern_match_hash{$file} = 1;
657 if ($pattern_depth == 0 ||
658 (($file_pd - $value_pd) < $pattern_depth)) {
659 $hash{$tvi} = $value_pd;
662 } elsif ($type eq 'N') {
663 if ($file =~ m/$value/x) {
673 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
674 add_categories
($line);
677 my $start = find_starting_index
($line);
678 my $end = find_ending_index
($line);
679 for ($i = $start; $i < $end; $i++) {
680 my $line = $typevalue[$i];
681 if ($line =~ /^[FX]:/) { ##Restore file patterns
682 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
683 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
684 $line =~ s/\\\./\./g; ##Convert \. to .
685 $line =~ s/\.\*/\*/g; ##Convert .* to *
687 $line =~ s/^([A-Z]):/$1:\t/g;
696 @keyword_tvi = sort_and_uniq
(@keyword_tvi);
697 foreach my $line (@keyword_tvi) {
698 add_categories
($line);
702 foreach my $email (@email_to, @list_to) {
703 $email->[0] = deduplicate_email
($email->[0]);
706 foreach my $file (@files) {
708 ($email_git || ($email_git_fallback &&
709 !$exact_pattern_match_hash{$file}))) {
710 vcs_file_signoffs
($file);
712 if ($email && $email_git_blame) {
713 vcs_file_blame
($file);
718 foreach my $chief (@penguin_chief) {
719 if ($chief =~ m/^(.*):(.*)/) {
722 $email_address = format_email
($1, $2, $email_usename);
723 if ($email_git_penguin_chiefs) {
724 push(@email_to, [$email_address, 'chief penguin']);
726 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
731 foreach my $email (@file_emails) {
732 my ($name, $address) = parse_email
($email);
734 my $tmp_email = format_email
($name, $address, $email_usename);
735 push_email_address
($tmp_email, '');
736 add_role
($tmp_email, 'in file');
741 if ($email || $email_list) {
743 @to = (@to, @email_to);
746 @to = (@to, @list_to);
751 @to = interactive_get_maintainers
(\
@to);
757 sub file_match_pattern
{
758 my ($file, $pattern) = @_;
759 if (substr($pattern, -1) eq "/") {
760 if ($file =~ m@
^$pattern@
) {
764 if ($file =~ m@
^$pattern@
) {
765 my $s1 = ($file =~ tr@
/@@
);
766 my $s2 = ($pattern =~ tr@
/@@
);
777 usage: $P [options] patchfile
778 $P [options] -f file|directory
781 REVIEWER field selection options:
782 --email => print email address(es) if any
783 --git => include recent git \*-by: signers
784 --git-all-signature-types => include signers regardless of signature type
785 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
786 --git-fallback => use git when no exact REVIEWERS pattern (default: $email_git_fallback)
787 --git-chief-penguins => include ${penguin_chiefs}
788 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
789 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
790 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
791 --git-blame => use git blame to find modified commits for patch or file
792 --git-blame-signatures => when used with --git-blame, also include all commit signers
793 --git-since => git history to use (default: $email_git_since)
794 --hg-since => hg history to use (default: $email_hg_since)
795 --interactive => display a menu (mostly useful if used with the --git option)
796 --m => include maintainer(s) if any
797 --r => include reviewer(s) if any
798 --n => include name 'Full Name <addr\@domain.tld>'
799 --l => include list(s) if any
800 --s => include subscriber only list(s) if any
801 --remove-duplicates => minimize duplicate email names/addresses
802 --roles => show roles (status:subsystem, git-signer, list, etc...)
803 --rolestats => show roles and statistics (commits/total_commits, %)
804 --file-emails => add email addresses found in -f file (default: 0 (off))
805 --scm => print SCM tree(s) if any
806 --status => print status if any
807 --subsystem => print subsystem name if any
808 --web => print website(s) if any
811 --separator [, ] => separator for multiple entries on 1 line
812 using --separator also sets --nomultiline if --separator is not [, ]
813 --multiline => print 1 entry per line
816 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
817 --keywords => scan patch for keywords (default: $keywords)
818 --sections => print all of the subsystem sections with pattern matches
819 --mailmap => use .mailmap file (default: $email_use_mailmap)
820 --version => show version
821 --help => show this help information
824 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
825 --remove-duplicates --rolestats]
828 Using "-f directory" may give unexpected results:
829 Used with "--git", git signators for _all_ files in and below
830 directory are examined as git recurses directories.
831 Any specified X: (exclude) pattern matches are _not_ ignored.
832 Used with "--nogit", directory is used as a pattern match,
833 no individual file within the directory or subdirectory
835 Used with "--git-blame", does not iterate all files in directory
836 Using "--git-blame" is slow and may add old committers and authors
837 that are no longer active maintainers to the output.
838 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
839 other automated tools that expect only ["name"] <email address>
840 may not work because of additional output after <email address>.
841 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
842 not the percentage of the entire file authored. # of commits is
843 not a good measure of amount of code authored. 1 major commit may
844 contain a thousand lines, 5 trivial commits may modify a single line.
845 If git is not installed, but mercurial (hg) is installed and an .hg
846 repository exists, the following options apply to mercurial:
848 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
850 Use --hg-since not --git-since to control date selection
851 File ".get_maintainer.conf", if it exists in the linux kernel source root
852 directory, can change whatever get_maintainer defaults are desired.
853 Entries in this file can be any command line argument.
854 This file is prepended to any additional command line arguments.
855 Multiple lines and # comments are allowed.
856 Most options have both positive and negative forms.
857 The negative forms for --<foo> are --no<foo> and --no-<foo>.
862 sub top_of_mesa_tree
{
865 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
868 if ( (-f
"${lk_path}docs/mesa.css")
869 && (-f
"${lk_path}docs/features.txt")
870 && (-f
"${lk_path}src/mesa/main/version.c")
871 && (-f
"${lk_path}REVIEWERS")
872 && (-d
"${lk_path}scripts")) {
879 my ($formatted_email) = @_;
884 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
887 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
889 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
893 $name =~ s/^\s+|\s+$//g;
894 $name =~ s/^\"|\"$//g;
895 $address =~ s/^\s+|\s+$//g;
897 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
898 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
902 return ($name, $address);
906 my ($name, $address, $usename) = @_;
910 $name =~ s/^\s+|\s+$//g;
911 $name =~ s/^\"|\"$//g;
912 $address =~ s/^\s+|\s+$//g;
914 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
915 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
921 $formatted_email = "$address";
923 $formatted_email = "$name <$address>";
926 $formatted_email = $address;
929 return $formatted_email;
932 sub find_first_section
{
935 while ($index < @typevalue) {
936 my $tv = $typevalue[$index];
937 if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
946 sub find_starting_index
{
950 my $tv = $typevalue[$index];
951 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
960 sub find_ending_index
{
963 while ($index < @typevalue) {
964 my $tv = $typevalue[$index];
965 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
974 sub get_subsystem_name
{
977 my $start = find_starting_index
($index);
979 my $subsystem = $typevalue[$start];
980 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
981 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
982 $subsystem =~ s/\s*$//;
983 $subsystem = $subsystem . "...";
988 sub get_maintainer_role
{
992 my $start = find_starting_index
($index);
993 my $end = find_ending_index
($index);
995 my $role = "unknown";
996 my $subsystem = get_subsystem_name
($index);
998 for ($i = $start + 1; $i < $end; $i++) {
999 my $tv = $typevalue[$i];
1000 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1003 if ($ptype eq "S") {
1010 if ($role eq "supported") {
1011 $role = "supporter";
1012 } elsif ($role eq "maintained") {
1013 $role = "maintainer";
1014 } elsif ($role eq "odd fixes") {
1015 $role = "odd fixer";
1016 } elsif ($role eq "orphan") {
1017 $role = "orphan minder";
1018 } elsif ($role eq "obsolete") {
1019 $role = "obsolete minder";
1020 } elsif ($role eq "buried alive in reporters") {
1021 $role = "chief penguin";
1024 return $role . ":" . $subsystem;
1030 my $subsystem = get_subsystem_name
($index);
1032 if ($subsystem eq "THE REST") {
1039 sub add_categories
{
1043 my $start = find_starting_index
($index);
1044 my $end = find_ending_index
($index);
1046 push(@subsystem, $typevalue[$start]);
1048 for ($i = $start + 1; $i < $end; $i++) {
1049 my $tv = $typevalue[$i];
1050 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1053 if ($ptype eq "L") {
1054 my $list_address = $pvalue;
1055 my $list_additional = "";
1056 my $list_role = get_list_role
($i);
1058 if ($list_role ne "") {
1059 $list_role = ":" . $list_role;
1061 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1063 $list_additional = $2;
1065 if ($list_additional =~ m/subscribers-only/) {
1066 if ($email_subscriber_list) {
1067 if (!$hash_list_to{lc($list_address)}) {
1068 $hash_list_to{lc($list_address)} = 1;
1069 push(@list_to, [$list_address,
1070 "subscriber list${list_role}"]);
1075 if (!$hash_list_to{lc($list_address)}) {
1076 $hash_list_to{lc($list_address)} = 1;
1077 if ($list_additional =~ m/moderated/) {
1078 push(@list_to, [$list_address,
1079 "moderated list${list_role}"]);
1081 push(@list_to, [$list_address,
1082 "open list${list_role}"]);
1087 } elsif ($ptype eq "M") {
1088 my ($name, $address) = parse_email
($pvalue);
1091 my $tv = $typevalue[$i - 1];
1092 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1095 $pvalue = format_email
($name, $address, $email_usename);
1100 if ($email_maintainer) {
1101 my $role = get_maintainer_role
($i);
1102 push_email_addresses
($pvalue, $role);
1104 } elsif ($ptype eq "R") {
1105 my ($name, $address) = parse_email
($pvalue);
1108 my $tv = $typevalue[$i - 1];
1109 if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1112 $pvalue = format_email
($name, $address, $email_usename);
1117 if ($email_reviewer) {
1118 my $subsystem = get_subsystem_name
($i);
1119 push_email_addresses
($pvalue, "reviewer:$subsystem");
1121 } elsif ($ptype eq "T") {
1122 push(@scm, $pvalue);
1123 } elsif ($ptype eq "W") {
1124 push(@web, $pvalue);
1125 } elsif ($ptype eq "S") {
1126 push(@status, $pvalue);
1133 my ($name, $address) = @_;
1135 return 1 if (($name eq "") && ($address eq ""));
1136 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1137 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1142 sub push_email_address
{
1143 my ($line, $role) = @_;
1145 my ($name, $address) = parse_email
($line);
1147 if ($address eq "") {
1151 if (!$email_remove_duplicates) {
1152 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1153 } elsif (!email_inuse
($name, $address)) {
1154 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1155 $email_hash_name{lc($name)}++ if ($name ne "");
1156 $email_hash_address{lc($address)}++;
1162 sub push_email_addresses
{
1163 my ($address, $role) = @_;
1165 my @address_list = ();
1167 if (rfc822_valid
($address)) {
1168 push_email_address
($address, $role);
1169 } elsif (@address_list = rfc822_validlist
($address)) {
1170 my $array_count = shift(@address_list);
1171 while (my $entry = shift(@address_list)) {
1172 push_email_address
($entry, $role);
1175 if (!push_email_address
($address, $role)) {
1176 warn("Invalid REVIEWERS address: '" . $address . "'\n");
1182 my ($line, $role) = @_;
1184 my ($name, $address) = parse_email
($line);
1185 my $email = format_email
($name, $address, $email_usename);
1187 foreach my $entry (@email_to) {
1188 if ($email_remove_duplicates) {
1189 my ($entry_name, $entry_address) = parse_email
($entry->[0]);
1190 if (($name eq $entry_name || $address eq $entry_address)
1191 && ($role eq "" || !($entry->[1] =~ m/$role/))
1193 if ($entry->[1] eq "") {
1194 $entry->[1] = "$role";
1196 $entry->[1] = "$entry->[1],$role";
1200 if ($email eq $entry->[0]
1201 && ($role eq "" || !($entry->[1] =~ m/$role/))
1203 if ($entry->[1] eq "") {
1204 $entry->[1] = "$role";
1206 $entry->[1] = "$entry->[1],$role";
1216 foreach my $path (split(/:/, $ENV{PATH
})) {
1217 if (-e
"$path/$bin") {
1218 return "$path/$bin";
1228 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1229 if (-e
"$path/$conf") {
1230 return "$path/$conf";
1240 my ($name, $address) = parse_email
($line);
1241 my $email = format_email
($name, $address, 1);
1242 my $real_name = $name;
1243 my $real_address = $address;
1245 if (exists $mailmap->{names
}->{$email} ||
1246 exists $mailmap->{addresses
}->{$email}) {
1247 if (exists $mailmap->{names
}->{$email}) {
1248 $real_name = $mailmap->{names
}->{$email};
1250 if (exists $mailmap->{addresses
}->{$email}) {
1251 $real_address = $mailmap->{addresses
}->{$email};
1254 if (exists $mailmap->{names
}->{$address}) {
1255 $real_name = $mailmap->{names
}->{$address};
1257 if (exists $mailmap->{addresses
}->{$address}) {
1258 $real_address = $mailmap->{addresses
}->{$address};
1261 return format_email
($real_name, $real_address, 1);
1265 my (@addresses) = @_;
1267 my @mapped_emails = ();
1268 foreach my $line (@addresses) {
1269 push(@mapped_emails, mailmap_email
($line));
1271 merge_by_realname
(@mapped_emails) if ($email_use_mailmap);
1272 return @mapped_emails;
1275 sub merge_by_realname
{
1279 foreach my $email (@emails) {
1280 my ($name, $address) = parse_email
($email);
1281 if (exists $address_map{$name}) {
1282 $address = $address_map{$name};
1283 $email = format_email
($name, $address, 1);
1285 $address_map{$name} = $address;
1290 sub git_execute_cmd
{
1294 my $output = `$cmd`;
1295 $output =~ s/^\s*//gm;
1296 @lines = split("\n", $output);
1301 sub hg_execute_cmd
{
1305 my $output = `$cmd`;
1306 @lines = split("\n", $output);
1311 sub extract_formatted_signatures
{
1312 my (@signature_lines) = @_;
1314 my @type = @signature_lines;
1316 s/\s*(.*):.*/$1/ for (@type);
1319 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1321 ## Reformat email addresses (with names) to avoid badly written signatures
1323 foreach my $signer (@signature_lines) {
1324 $signer = deduplicate_email
($signer);
1327 return (\
@type, \
@signature_lines);
1330 sub vcs_find_signers
{
1331 my ($cmd, $file) = @_;
1334 my @signatures = ();
1338 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1340 my $pattern = $VCS_cmds{"commit_pattern"};
1341 my $author_pattern = $VCS_cmds{"author_pattern"};
1342 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1344 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1346 $commits = grep(/$pattern/, @lines); # of commits
1348 @authors = grep(/$author_pattern/, @lines);
1349 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1350 @stats = grep(/$stat_pattern/, @lines);
1352 # print("stats: <@stats>\n");
1354 return (0, \
@signatures, \
@authors, \
@stats) if !@signatures;
1356 save_commits_by_author
(@lines) if ($interactive);
1357 save_commits_by_signer
(@lines) if ($interactive);
1359 if (!$email_git_penguin_chiefs) {
1360 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1363 my ($author_ref, $authors_ref) = extract_formatted_signatures
(@authors);
1364 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1366 return ($commits, $signers_ref, $authors_ref, \
@stats);
1369 sub vcs_find_author
{
1373 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1375 if (!$email_git_penguin_chiefs) {
1376 @lines = grep(!/${penguin_chiefs}/i, @lines);
1379 return @lines if !@lines;
1382 foreach my $line (@lines) {
1383 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1385 my ($name, $address) = parse_email
($author);
1386 $author = format_email
($name, $address, 1);
1387 push(@authors, $author);
1391 save_commits_by_author
(@lines) if ($interactive);
1392 save_commits_by_signer
(@lines) if ($interactive);
1397 sub vcs_save_commits
{
1402 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1404 foreach my $line (@lines) {
1405 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1418 return @commits if (!(-f
$file));
1420 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1421 my @all_commits = ();
1423 $cmd = $VCS_cmds{"blame_file_cmd"};
1424 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1425 @all_commits = vcs_save_commits
($cmd);
1427 foreach my $file_range_diff (@range) {
1428 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1430 my $diff_start = $2;
1431 my $diff_length = $3;
1432 next if ("$file" ne "$diff_file");
1433 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1434 push(@commits, $all_commits[$i]);
1438 foreach my $file_range_diff (@range) {
1439 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1441 my $diff_start = $2;
1442 my $diff_length = $3;
1443 next if ("$file" ne "$diff_file");
1444 $cmd = $VCS_cmds{"blame_range_cmd"};
1445 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1446 push(@commits, vcs_save_commits
($cmd));
1449 $cmd = $VCS_cmds{"blame_file_cmd"};
1450 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1451 @commits = vcs_save_commits
($cmd);
1454 foreach my $commit (@commits) {
1455 $commit =~ s/^\^//g;
1461 my $printed_novcs = 0;
1463 %VCS_cmds = %VCS_cmds_git;
1464 return 1 if eval $VCS_cmds{"available"};
1465 %VCS_cmds = %VCS_cmds_hg;
1466 return 2 if eval $VCS_cmds{"available"};
1468 if (!$printed_novcs) {
1469 warn("$P: No supported VCS found. Add --nogit to options?\n");
1470 warn("Using a git repository produces better results.\n");
1478 return $vcs_used == 1;
1482 return $vcs_used == 2;
1485 sub interactive_get_maintainers
{
1486 my ($list_ref) = @_;
1487 my @list = @
$list_ref;
1496 foreach my $entry (@list) {
1497 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1498 $selected{$count} = 1;
1499 $authored{$count} = 0;
1500 $signed{$count} = 0;
1506 my $print_options = 0;
1511 printf STDERR
"\n%1s %2s %-65s",
1512 "*", "#", "email/list and role:stats";
1514 ($email_git_fallback && !$maintained) ||
1516 print STDERR
"auth sign";
1519 foreach my $entry (@list) {
1520 my $email = $entry->[0];
1521 my $role = $entry->[1];
1523 $sel = "*" if ($selected{$count});
1524 my $commit_author = $commit_author_hash{$email};
1525 my $commit_signer = $commit_signer_hash{$email};
1528 $authored++ for (@
{$commit_author});
1529 $signed++ for (@
{$commit_signer});
1530 printf STDERR
"%1s %2d %-65s", $sel, $count + 1, $email;
1531 printf STDERR
"%4d %4d", $authored, $signed
1532 if ($authored > 0 || $signed > 0);
1533 printf STDERR
"\n %s\n", $role;
1534 if ($authored{$count}) {
1535 my $commit_author = $commit_author_hash{$email};
1536 foreach my $ref (@
{$commit_author}) {
1537 print STDERR
" Author: @{$ref}[1]\n";
1540 if ($signed{$count}) {
1541 my $commit_signer = $commit_signer_hash{$email};
1542 foreach my $ref (@
{$commit_signer}) {
1543 print STDERR
" @{$ref}[2]: @{$ref}[1]\n";
1550 my $date_ref = \
$email_git_since;
1551 $date_ref = \
$email_hg_since if (vcs_is_hg
());
1552 if ($print_options) {
1557 Version Control options:
1558 g use git history [$email_git]
1559 gf use git-fallback [$email_git_fallback]
1560 b use git blame [$email_git_blame]
1561 bs use blame signatures [$email_git_blame_signatures]
1562 c# minimum commits [$email_git_min_signatures]
1563 %# min percent [$email_git_min_percent]
1564 d# history to use [$$date_ref]
1565 x# max maintainers [$email_git_max_maintainers]
1566 t all signature types [$email_git_all_signature_types]
1567 m use .mailmap [$email_use_mailmap]
1574 tm toggle maintainers
1575 tg toggle git entries
1576 tl toggle open list entries
1577 ts toggle subscriber list entries
1578 f emails in file [$file_emails]
1579 k keywords in file [$keywords]
1580 r remove duplicates [$email_remove_duplicates]
1581 p# pattern match depth [$pattern_depth]
1585 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1587 my $input = <STDIN
>;
1592 my @wish = split(/[, ]+/, $input);
1593 foreach my $nr (@wish) {
1595 my $sel = substr($nr, 0, 1);
1596 my $str = substr($nr, 1);
1598 $val = $1 if $str =~ /^(\d+)$/;
1603 $output_rolestats = 0;
1606 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1607 $selected{$nr - 1} = !$selected{$nr - 1};
1608 } elsif ($sel eq "*" || $sel eq '^') {
1610 $toggle = 1 if ($sel eq '*');
1611 for (my $i = 0; $i < $count; $i++) {
1612 $selected{$i} = $toggle;
1614 } elsif ($sel eq "0") {
1615 for (my $i = 0; $i < $count; $i++) {
1616 $selected{$i} = !$selected{$i};
1618 } elsif ($sel eq "t") {
1619 if (lc($str) eq "m") {
1620 for (my $i = 0; $i < $count; $i++) {
1621 $selected{$i} = !$selected{$i}
1622 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1624 } elsif (lc($str) eq "g") {
1625 for (my $i = 0; $i < $count; $i++) {
1626 $selected{$i} = !$selected{$i}
1627 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1629 } elsif (lc($str) eq "l") {
1630 for (my $i = 0; $i < $count; $i++) {
1631 $selected{$i} = !$selected{$i}
1632 if ($list[$i]->[1] =~ /^(open list)/i);
1634 } elsif (lc($str) eq "s") {
1635 for (my $i = 0; $i < $count; $i++) {
1636 $selected{$i} = !$selected{$i}
1637 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1640 } elsif ($sel eq "a") {
1641 if ($val > 0 && $val <= $count) {
1642 $authored{$val - 1} = !$authored{$val - 1};
1643 } elsif ($str eq '*' || $str eq '^') {
1645 $toggle = 1 if ($str eq '*');
1646 for (my $i = 0; $i < $count; $i++) {
1647 $authored{$i} = $toggle;
1650 } elsif ($sel eq "s") {
1651 if ($val > 0 && $val <= $count) {
1652 $signed{$val - 1} = !$signed{$val - 1};
1653 } elsif ($str eq '*' || $str eq '^') {
1655 $toggle = 1 if ($str eq '*');
1656 for (my $i = 0; $i < $count; $i++) {
1657 $signed{$i} = $toggle;
1660 } elsif ($sel eq "o") {
1663 } elsif ($sel eq "g") {
1665 bool_invert
(\
$email_git_fallback);
1667 bool_invert
(\
$email_git);
1670 } elsif ($sel eq "b") {
1672 bool_invert
(\
$email_git_blame_signatures);
1674 bool_invert
(\
$email_git_blame);
1677 } elsif ($sel eq "c") {
1679 $email_git_min_signatures = $val;
1682 } elsif ($sel eq "x") {
1684 $email_git_max_maintainers = $val;
1687 } elsif ($sel eq "%") {
1688 if ($str ne "" && $val >= 0) {
1689 $email_git_min_percent = $val;
1692 } elsif ($sel eq "d") {
1694 $email_git_since = $str;
1695 } elsif (vcs_is_hg
()) {
1696 $email_hg_since = $str;
1699 } elsif ($sel eq "t") {
1700 bool_invert
(\
$email_git_all_signature_types);
1702 } elsif ($sel eq "f") {
1703 bool_invert
(\
$file_emails);
1705 } elsif ($sel eq "r") {
1706 bool_invert
(\
$email_remove_duplicates);
1708 } elsif ($sel eq "m") {
1709 bool_invert
(\
$email_use_mailmap);
1712 } elsif ($sel eq "k") {
1713 bool_invert
(\
$keywords);
1715 } elsif ($sel eq "p") {
1716 if ($str ne "" && $val >= 0) {
1717 $pattern_depth = $val;
1720 } elsif ($sel eq "h" || $sel eq "?") {
1723 Interactive mode allows you to select the various maintainers, submitters,
1724 commit signers and mailing lists that could be CC'd on a patch.
1726 Any *'d entry is selected.
1728 If you have git or hg installed, you can choose to summarize the commit
1729 history of files in the patch. Also, each line of the current file can
1730 be matched to its commit author and that commits signers with blame.
1732 Various knobs exist to control the length of time for active commit
1733 tracking, the maximum number of commit authors and signers to add,
1736 Enter selections at the prompt until you are satisfied that the selected
1737 maintainers are appropriate. You may enter multiple selections separated
1738 by either commas or spaces.
1742 print STDERR
"invalid option: '$nr'\n";
1747 print STDERR
"git-blame can be very slow, please have patience..."
1748 if ($email_git_blame);
1749 goto &get_maintainers
;
1753 #drop not selected entries
1755 my @new_emailto = ();
1756 foreach my $entry (@list) {
1757 if ($selected{$count}) {
1758 push(@new_emailto, $list[$count]);
1762 return @new_emailto;
1766 my ($bool_ref) = @_;
1775 sub deduplicate_email
{
1779 my ($name, $address) = parse_email
($email);
1780 $email = format_email
($name, $address, 1);
1781 $email = mailmap_email
($email);
1783 return $email if (!$email_remove_duplicates);
1785 ($name, $address) = parse_email
($email);
1787 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1788 $name = $deduplicate_name_hash{lc($name)}->[0];
1789 $address = $deduplicate_name_hash{lc($name)}->[1];
1791 } elsif ($deduplicate_address_hash{lc($address)}) {
1792 $name = $deduplicate_address_hash{lc($address)}->[0];
1793 $address = $deduplicate_address_hash{lc($address)}->[1];
1797 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1798 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1800 $email = format_email
($name, $address, 1);
1801 $email = mailmap_email
($email);
1805 sub save_commits_by_author
{
1812 foreach my $line (@lines) {
1813 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1815 $author = deduplicate_email
($author);
1816 push(@authors, $author);
1818 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1819 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1822 for (my $i = 0; $i < @authors; $i++) {
1824 foreach my $ref(@
{$commit_author_hash{$authors[$i]}}) {
1825 if (@
{$ref}[0] eq $commits[$i] &&
1826 @
{$ref}[1] eq $subjects[$i]) {
1832 push(@
{$commit_author_hash{$authors[$i]}},
1833 [ ($commits[$i], $subjects[$i]) ]);
1838 sub save_commits_by_signer
{
1844 foreach my $line (@lines) {
1845 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1846 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1847 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1848 my @signatures = ($line);
1849 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1850 my @types = @
$types_ref;
1851 my @signers = @
$signers_ref;
1853 my $type = $types[0];
1854 my $signer = $signers[0];
1856 $signer = deduplicate_email
($signer);
1859 foreach my $ref(@
{$commit_signer_hash{$signer}}) {
1860 if (@
{$ref}[0] eq $commit &&
1861 @
{$ref}[1] eq $subject &&
1862 @
{$ref}[2] eq $type) {
1868 push(@
{$commit_signer_hash{$signer}},
1869 [ ($commit, $subject, $type) ]);
1876 my ($role, $divisor, @lines) = @_;
1881 return if (@lines <= 0);
1883 if ($divisor <= 0) {
1884 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1888 @lines = mailmap
(@lines);
1890 return if (@lines <= 0);
1892 @lines = sort(@lines);
1895 $hash{$_}++ for @lines;
1898 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1899 my $sign_offs = $hash{$line};
1900 my $percent = $sign_offs * 100 / $divisor;
1902 $percent = 100 if ($percent > 100);
1903 next if (ignore_email_address
($line));
1905 last if ($sign_offs < $email_git_min_signatures ||
1906 $count > $email_git_max_maintainers ||
1907 $percent < $email_git_min_percent);
1908 push_email_address
($line, '');
1909 if ($output_rolestats) {
1910 my $fmt_percent = sprintf("%.0f", $percent);
1911 add_role
($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1913 add_role
($line, $role);
1918 sub vcs_file_signoffs
{
1929 $vcs_used = vcs_exists
();
1930 return if (!$vcs_used);
1932 my $cmd = $VCS_cmds{"find_signers_cmd"};
1933 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1935 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
1937 @signers = @
{$signers_ref} if defined $signers_ref;
1938 @authors = @
{$authors_ref} if defined $authors_ref;
1939 @stats = @
{$stats_ref} if defined $stats_ref;
1941 # print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1943 foreach my $signer (@signers) {
1944 $signer = deduplicate_email
($signer);
1947 vcs_assign
("commit_signer", $commits, @signers);
1948 vcs_assign
("authored", $commits, @authors);
1949 if ($#authors == $#stats) {
1950 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1951 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1955 for (my $i = 0; $i <= $#stats; $i++) {
1956 if ($stats[$i] =~ /$stat_pattern/) {
1961 my @tmp_authors = uniq
(@authors);
1962 foreach my $author (@tmp_authors) {
1963 $author = deduplicate_email
($author);
1965 @tmp_authors = uniq
(@tmp_authors);
1966 my @list_added = ();
1967 my @list_deleted = ();
1968 foreach my $author (@tmp_authors) {
1970 my $auth_deleted = 0;
1971 for (my $i = 0; $i <= $#stats; $i++) {
1972 if ($author eq deduplicate_email
($authors[$i]) &&
1973 $stats[$i] =~ /$stat_pattern/) {
1975 $auth_deleted += $2;
1978 for (my $i = 0; $i < $auth_added; $i++) {
1979 push(@list_added, $author);
1981 for (my $i = 0; $i < $auth_deleted; $i++) {
1982 push(@list_deleted, $author);
1985 vcs_assign
("added_lines", $added, @list_added);
1986 vcs_assign
("removed_lines", $deleted, @list_deleted);
1990 sub vcs_file_blame
{
1994 my @all_commits = ();
1999 $vcs_used = vcs_exists
();
2000 return if (!$vcs_used);
2002 @all_commits = vcs_blame
($file);
2003 @commits = uniq
(@all_commits);
2004 $total_commits = @commits;
2005 $total_lines = @all_commits;
2007 if ($email_git_blame_signatures) {
2010 my $commit_authors_ref;
2011 my $commit_signers_ref;
2013 my @commit_authors = ();
2014 my @commit_signers = ();
2015 my $commit = join(" -r ", @commits);
2018 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2019 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2021 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers
($cmd, $file);
2022 @commit_authors = @
{$commit_authors_ref} if defined $commit_authors_ref;
2023 @commit_signers = @
{$commit_signers_ref} if defined $commit_signers_ref;
2025 push(@signers, @commit_signers);
2027 foreach my $commit (@commits) {
2029 my $commit_authors_ref;
2030 my $commit_signers_ref;
2032 my @commit_authors = ();
2033 my @commit_signers = ();
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);
2048 if ($from_filename) {
2049 if ($output_rolestats) {
2051 if (vcs_is_hg
()) {{ # Double brace for last exit
2053 my @commit_signers = ();
2054 @commits = uniq
(@commits);
2055 @commits = sort(@commits);
2056 my $commit = join(" -r ", @commits);
2059 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2060 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2064 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2066 if (!$email_git_penguin_chiefs) {
2067 @lines = grep(!/${penguin_chiefs}/i, @lines);
2073 foreach my $line (@lines) {
2074 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2076 $author = deduplicate_email
($author);
2077 push(@authors, $author);
2081 save_commits_by_author
(@lines) if ($interactive);
2082 save_commits_by_signer
(@lines) if ($interactive);
2084 push(@signers, @authors);
2087 foreach my $commit (@commits) {
2089 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2090 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2091 my @author = vcs_find_author
($cmd);
2094 my $formatted_author = deduplicate_email
($author[0]);
2096 my $count = grep(/$commit/, @all_commits);
2097 for ($i = 0; $i < $count ; $i++) {
2098 push(@blame_signers, $formatted_author);
2102 if (@blame_signers) {
2103 vcs_assign
("authored lines", $total_lines, @blame_signers);
2106 foreach my $signer (@signers) {
2107 $signer = deduplicate_email
($signer);
2109 vcs_assign
("commits", $total_commits, @signers);
2111 foreach my $signer (@signers) {
2112 $signer = deduplicate_email
($signer);
2114 vcs_assign
("modified commits", $total_commits, @signers);
2122 @parms = grep(!$saw{$_}++, @parms);
2130 @parms = sort @parms;
2131 @parms = grep(!$saw{$_}++, @parms);
2135 sub clean_file_emails
{
2136 my (@file_emails) = @_;
2137 my @fmt_emails = ();
2139 foreach my $email (@file_emails) {
2140 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2141 my ($name, $address) = parse_email
($email);
2142 if ($name eq '"[,\.]"') {
2146 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2148 my $first = $nw[@nw - 3];
2149 my $middle = $nw[@nw - 2];
2150 my $last = $nw[@nw - 1];
2152 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2153 (length($first) == 2 && substr($first, -1) eq ".")) ||
2154 (length($middle) == 1 ||
2155 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2156 $name = "$first $middle $last";
2158 $name = "$middle $last";
2162 if (substr($name, -1) =~ /[,\.]/) {
2163 $name = substr($name, 0, length($name) - 1);
2164 } elsif (substr($name, -2) =~ /[,\.]"/) {
2165 $name = substr($name, 0, length($name) - 2) . '"';
2168 if (substr($name, 0, 1) =~ /[,\.]/) {
2169 $name = substr($name, 1, length($name) - 1);
2170 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2171 $name = '"' . substr($name, 2, length($name) - 2);
2174 my $fmt_email = format_email
($name, $address, $email_usename);
2175 push(@fmt_emails, $fmt_email);
2185 my ($address, $role) = @
$_;
2186 if (!$saw{$address}) {
2187 if ($output_roles) {
2188 push(@lines, "$address ($role)");
2190 push(@lines, $address);
2202 if ($output_multiline) {
2203 foreach my $line (@parms) {
2207 print(join($output_separator, @parms));
2215 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2216 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2217 # This regexp will only work on addresses which have had comments stripped
2218 # and replaced with rfc822_lwsp.
2220 my $specials = '()<>@,;:\\\\".\\[\\]';
2221 my $controls = '\\000-\\037\\177';
2223 my $dtext = "[^\\[\\]\\r\\\\]";
2224 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2226 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2228 # Use zero-width assertion to spot the limit of an atom. A simple
2229 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2230 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2231 my $word = "(?:$atom|$quoted_string)";
2232 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2234 my $sub_domain = "(?:$atom|$domain_literal)";
2235 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2237 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2239 my $phrase = "$word*";
2240 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2241 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2242 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2244 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2245 my $address = "(?:$mailbox|$group)";
2247 return "$rfc822_lwsp*$address";
2250 sub rfc822_strip_comments
{
2252 # Recursively remove comments, and replace with a single space. The simpler
2253 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2254 # chars in atoms, for example.
2256 while ($s =~ s
/^((?
:[^"\\]|\\.)*
2257 (?:"(?
:[^"\\]|\\.)*"(?
:[^"\\]|\\.)*)*)
2258 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2262 # valid: returns true if the parameter is an RFC822 valid address
2265 my $s = rfc822_strip_comments(shift);
2268 $rfc822re = make_rfc822re();
2271 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2274 # validlist: In scalar context, returns true if the parameter is an RFC822
2275 # valid list of addresses.
2277 # In list context, returns an empty list on failure (an invalid
2278 # address was found); otherwise a list whose first element is the
2279 # number of addresses found and whose remaining elements are the
2280 # addresses. This is needed to disambiguate failure (invalid)
2281 # from success with no addresses found, because an empty string is
2284 sub rfc822_validlist {
2285 my $s = rfc822_strip_comments(shift);
2288 $rfc822re = make_rfc822re();
2290 # * null list items are valid according to the RFC
2291 # * the '1' business is to aid in distinguishing failure from no results
2294 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2295 $s =~ m/^$rfc822_char*$/) {
2296 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2299 return wantarray ? (scalar(@r), @r) : 1;
2301 return wantarray ? () : 0;