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);
23 my $email_usename = 1;
24 my $email_maintainer = 1;
25 my $email_reviewer = 1;
27 my $email_subscriber_list = 0;
29 my $email_git_all_signature_types = 0;
30 my $email_git_blame = 0;
31 my $email_git_blame_signatures = 1;
32 my $email_git_fallback = 1;
33 my $email_git_min_signatures = 1;
34 my $email_git_max_maintainers = 5;
35 my $email_git_min_percent = 5;
36 my $email_git_since = "1-year-ago";
37 my $email_hg_since = "-365";
39 my $email_remove_duplicates = 1;
40 my $email_use_mailmap = 1;
41 my $output_multiline = 1;
42 my $output_separator = ", ";
44 my $output_rolestats = 1;
52 my $from_filename = 0;
53 my $pattern_depth = 0;
61 my %commit_author_hash;
62 my %commit_signer_hash;
64 # Signature types of people who are either
65 # a) responsible for the code in question, or
66 # b) familiar enough with it to give relevant feedback
67 my @signature_tags = ();
68 push(@signature_tags, "Signed-off-by:");
69 push(@signature_tags, "Reviewed-by:");
70 push(@signature_tags, "Acked-by:");
72 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
74 # rfc822 email address - preloaded methods go here.
75 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
76 my $rfc822_char = '[\\000-\\377]';
78 # VCS command support: class-like functions and strings
83 "execute_cmd" => \
&git_execute_cmd
,
84 "available" => '(which("git") ne "") && (-e ".git")',
86 "git log --no-color --follow --since=\$email_git_since " .
87 '--format="GitCommit: %H%n' .
88 'GitAuthor: %an <%ae>%n' .
93 "find_commit_signers_cmd" =>
94 "git log --no-color " .
95 '--format="GitCommit: %H%n' .
96 'GitAuthor: %an <%ae>%n' .
101 "find_commit_author_cmd" =>
102 "git log --no-color " .
103 '--format="GitCommit: %H%n' .
104 'GitAuthor: %an <%ae>%n' .
106 'GitSubject: %s%n"' .
108 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
109 "blame_file_cmd" => "git blame -l \$file",
110 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
111 "blame_commit_pattern" => "^([0-9a-f]+) ",
112 "author_pattern" => "^GitAuthor: (.*)",
113 "subject_pattern" => "^GitSubject: (.*)",
117 "execute_cmd" => \
&hg_execute_cmd
,
118 "available" => '(which("hg") ne "") && (-d ".hg")',
119 "find_signers_cmd" =>
120 "hg log --date=\$email_hg_since " .
121 "--template='HgCommit: {node}\\n" .
122 "HgAuthor: {author}\\n" .
123 "HgSubject: {desc}\\n'" .
125 "find_commit_signers_cmd" =>
127 "--template='HgSubject: {desc}\\n'" .
129 "find_commit_author_cmd" =>
131 "--template='HgCommit: {node}\\n" .
132 "HgAuthor: {author}\\n" .
133 "HgSubject: {desc|firstline}\\n'" .
135 "blame_range_cmd" => "", # not supported
136 "blame_file_cmd" => "hg blame -n \$file",
137 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
138 "blame_commit_pattern" => "^([ 0-9a-f]+):",
139 "author_pattern" => "^HgAuthor: (.*)",
140 "subject_pattern" => "^HgSubject: (.*)",
143 my $conf = which_conf
(".get_maintainer.conf");
146 open(my $conffile, '<', "$conf")
147 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
149 while (<$conffile>) {
152 $line =~ s/\s*\n?$//g;
156 next if ($line =~ m/^\s*#/);
157 next if ($line =~ m/^\s*$/);
159 my @words = split(" ", $line);
160 foreach my $word (@words) {
161 last if ($word =~ m/^#/);
162 push (@conf_args, $word);
166 unshift(@ARGV, @conf_args) if @conf_args;
171 'git!' => \
$email_git,
172 'git-all-signature-types!' => \
$email_git_all_signature_types,
173 'git-blame!' => \
$email_git_blame,
174 'git-blame-signatures!' => \
$email_git_blame_signatures,
175 'git-fallback!' => \
$email_git_fallback,
176 'git-min-signatures=i' => \
$email_git_min_signatures,
177 'git-max-maintainers=i' => \
$email_git_max_maintainers,
178 'git-min-percent=i' => \
$email_git_min_percent,
179 'git-since=s' => \
$email_git_since,
180 'hg-since=s' => \
$email_hg_since,
181 'i|interactive!' => \
$interactive,
182 'remove-duplicates!' => \
$email_remove_duplicates,
183 'mailmap!' => \
$email_use_mailmap,
184 'm!' => \
$email_maintainer,
185 'r!' => \
$email_reviewer,
186 'n!' => \
$email_usename,
187 'l!' => \
$email_list,
188 's!' => \
$email_subscriber_list,
189 'multiline!' => \
$output_multiline,
190 'roles!' => \
$output_roles,
191 'rolestats!' => \
$output_rolestats,
192 'separator=s' => \
$output_separator,
193 'subsystem!' => \
$subsystem,
194 'status!' => \
$status,
197 'pattern-depth=i' => \
$pattern_depth,
198 'k|keywords!' => \
$keywords,
199 'sections!' => \
$sections,
200 'fe|file-emails!' => \
$file_emails,
201 'f|file' => \
$from_filename,
202 'v|version' => \
$version,
203 'h|help|usage' => \
$help,
205 die "$P: invalid argument - use --help if necessary\n";
214 print("${P} ${V}\n");
218 if (-t STDIN
&& !@ARGV) {
219 # We're talking to a terminal, but have no command line arguments.
220 die "$P: missing patchfile or -f file - use --help if necessary\n";
223 $output_multiline = 0 if ($output_separator ne ", ");
224 $output_rolestats = 1 if ($interactive);
225 $output_roles = 1 if ($output_rolestats);
237 my $selections = $email + $scm + $status + $subsystem + $web;
238 if ($selections == 0) {
239 die "$P: Missing required option: email, scm, status, subsystem or web\n";
244 ($email_maintainer + $email_reviewer +
245 $email_list + $email_subscriber_list +
246 $email_git + $email_git_blame) == 0) {
247 die "$P: Please select at least 1 email option\n";
250 if (!top_of_tree
($lk_path)) {
251 die "$P: The current directory does not appear to be "
252 . "a QEMU source tree.\n";
255 ## Read MAINTAINERS for type/value pairs
260 open (my $maint, '<', "${lk_path}MAINTAINERS")
261 or die "$P: Can't open MAINTAINERS: $!\n";
265 if ($line =~ m/^(.):\s*(.*)/) {
269 ##Filename pattern matching
270 if ($type eq "F" || $type eq "X") {
271 $value =~ s@\
.@
\\\
.@g; ##Convert . to \.
272 $value =~ s/\*/\.\*/g; ##Convert * to .*
273 $value =~ s/\?/\./g; ##Convert ? to .
274 ##if pattern is a directory and it lacks a trailing slash, add one
276 $value =~ s@
([^/])$@$1/@
;
278 } elsif ($type eq "K") {
279 $keyword_hash{@typevalue} = $value;
281 push(@typevalue, "$type:$value");
282 } elsif (!/^(\s)*$/) {
284 push(@typevalue, $line);
291 # Read mail address map
304 return if (!$email_use_mailmap || !(-f
"${lk_path}.mailmap"));
306 open(my $mailmap_file, '<', "${lk_path}.mailmap")
307 or warn "$P: Can't open .mailmap: $!\n";
309 while (<$mailmap_file>) {
310 s/#.*$//; #strip comments
311 s/^\s+|\s+$//g; #trim
313 next if (/^\s*$/); #skip empty lines
314 #entries have one of the following formats:
317 # name1 <mail1> <mail2>
318 # name1 <mail1> name2 <mail2>
319 # (see man git-shortlog)
321 if (/^([^<]+)<([^>]+)>$/) {
325 $real_name =~ s/\s+$//;
326 ($real_name, $address) = parse_email
("$real_name <$address>");
327 $mailmap->{names
}->{$address} = $real_name;
329 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
330 my $real_address = $1;
331 my $wrong_address = $2;
333 $mailmap->{addresses
}->{$wrong_address} = $real_address;
335 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
337 my $real_address = $2;
338 my $wrong_address = $3;
340 $real_name =~ s/\s+$//;
341 ($real_name, $real_address) =
342 parse_email
("$real_name <$real_address>");
343 $mailmap->{names
}->{$wrong_address} = $real_name;
344 $mailmap->{addresses
}->{$wrong_address} = $real_address;
346 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
348 my $real_address = $2;
350 my $wrong_address = $4;
352 $real_name =~ s/\s+$//;
353 ($real_name, $real_address) =
354 parse_email
("$real_name <$real_address>");
356 $wrong_name =~ s/\s+$//;
357 ($wrong_name, $wrong_address) =
358 parse_email
("$wrong_name <$wrong_address>");
360 my $wrong_email = format_email
($wrong_name, $wrong_address, 1);
361 $mailmap->{names
}->{$wrong_email} = $real_name;
362 $mailmap->{addresses
}->{$wrong_email} = $real_address;
365 close($mailmap_file);
368 ## use the filenames on the command line or find the filenames in the patchfiles
372 my @keyword_tvi = ();
373 my @file_emails = ();
376 push(@ARGV, "&STDIN");
379 foreach my $file (@ARGV) {
380 if ($file ne "&STDIN") {
381 ##if $file is a directory and it lacks a trailing slash, add one
383 $file =~ s@
([^/])$@$1/@
;
384 } elsif (!(stat $file)) {
385 die "$P: file '${file}' not found: $!\n";
388 if ($from_filename) {
390 if ($file ne "MAINTAINERS" && -f
$file && ($keywords || $file_emails)) {
391 open(my $f, '<', $file)
392 or die "$P: Can't open $file: $!\n";
393 my $text = do { local($/) ; <$f> };
396 foreach my $line (keys %keyword_hash) {
397 if ($text =~ m/$keyword_hash{$line}/x) {
398 push(@keyword_tvi, $line);
403 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;
404 push(@file_emails, clean_file_emails
(@poss_addr));
408 my $file_cnt = @files;
411 open(my $patch, "< $file")
412 or die "$P: Can't open $file: $!\n";
414 # We can check arbitrary information before the patch
415 # like the commit message, mail headers, etc...
416 # This allows us to match arbitrary keywords against any part
417 # of a git format-patch generated file (subject tags, etc...)
419 my $patch_prefix = ""; #Parsing the intro
423 if (m/^\+\+\+\s+(\S+)/) {
425 $filename =~ s@
^[^/]*/@@
;
427 $lastfile = $filename;
428 push(@files, $filename);
429 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
430 } elsif (m/^\@\@ -(\d+),(\d+)/) {
431 if ($email_git_blame) {
432 push(@range, "$lastfile:$1:$2");
434 } elsif ($keywords) {
435 foreach my $line (keys %keyword_hash) {
436 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
437 push(@keyword_tvi, $line);
444 if ($file_cnt == @files) {
445 warn "$P: file '${file}' doesn't appear to be a patch. "
446 . "Add -f to options?\n";
448 @files = sort_and_uniq
(@files);
452 @file_emails = uniq
(@file_emails);
455 my %email_hash_address;
463 my %deduplicate_name_hash = ();
464 my %deduplicate_address_hash = ();
466 my @maintainers = get_maintainers
();
469 @maintainers = merge_email
(@maintainers);
470 output
(@maintainers);
479 @status = uniq
(@status);
484 @subsystem = uniq
(@subsystem);
495 sub range_is_maintained
{
496 my ($start, $end) = @_;
498 for (my $i = $start; $i < $end; $i++) {
499 my $line = $typevalue[$i];
500 if ($line =~ m/^(.):\s*(.*)/) {
504 if ($value =~ /(maintain|support)/i) {
513 sub range_has_maintainer
{
514 my ($start, $end) = @_;
516 for (my $i = $start; $i < $end; $i++) {
517 my $line = $typevalue[$i];
518 if ($line =~ m/^(.):\s*(.*)/) {
529 sub get_maintainers
{
530 %email_hash_name = ();
531 %email_hash_address = ();
532 %commit_author_hash = ();
533 %commit_signer_hash = ();
541 %deduplicate_name_hash = ();
542 %deduplicate_address_hash = ();
543 if ($email_git_all_signature_types) {
544 $signature_pattern = "(.+?)[Bb][Yy]:";
546 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
549 # Find responsible parties
551 my %exact_pattern_match_hash = ();
553 foreach my $file (@files) {
556 my $tvi = find_first_section
();
557 while ($tvi < @typevalue) {
558 my $start = find_starting_index
($tvi);
559 my $end = find_ending_index
($tvi);
563 #Do not match excluded file patterns
565 for ($i = $start; $i < $end; $i++) {
566 my $line = $typevalue[$i];
567 if ($line =~ m/^(.):\s*(.*)/) {
571 if (file_match_pattern
($file, $value)) {
580 for ($i = $start; $i < $end; $i++) {
581 my $line = $typevalue[$i];
582 if ($line =~ m/^(.):\s*(.*)/) {
586 if (file_match_pattern
($file, $value)) {
587 my $value_pd = ($value =~ tr@
/@@
);
588 my $file_pd = ($file =~ tr@
/@@
);
589 $value_pd++ if (substr($value,-1,1) ne "/");
590 $value_pd = -1 if ($value =~ /^\.\*/);
591 if ($value_pd >= $file_pd &&
592 range_is_maintained
($start, $end) &&
593 range_has_maintainer
($start, $end)) {
594 $exact_pattern_match_hash{$file} = 1;
596 if ($pattern_depth == 0 ||
597 (($file_pd - $value_pd) < $pattern_depth)) {
598 $hash{$tvi} = $value_pd;
608 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
609 add_categories
($line);
612 my $start = find_starting_index
($line);
613 my $end = find_ending_index
($line);
614 for ($i = $start; $i < $end; $i++) {
615 my $line = $typevalue[$i];
616 if ($line =~ /^[FX]:/) { ##Restore file patterns
617 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
618 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
619 $line =~ s/\\\./\./g; ##Convert \. to .
620 $line =~ s/\.\*/\*/g; ##Convert .* to *
622 $line =~ s/^([A-Z]):/$1:\t/g;
631 @keyword_tvi = sort_and_uniq
(@keyword_tvi);
632 foreach my $line (@keyword_tvi) {
633 add_categories
($line);
637 foreach my $email (@email_to, @list_to) {
638 $email->[0] = deduplicate_email
($email->[0]);
642 if (! $interactive) {
643 $email_git_fallback = 0 if @email_to > 0 || $email_git || $email_git_blame;
644 if ($email_git_fallback) {
645 print STDERR
"get_maintainer.pl: No maintainers found, printing recent contributors.\n";
646 print STDERR
"get_maintainer.pl: Do not blindly cc: them on patches! Use common sense.\n";
651 foreach my $file (@files) {
652 if ($email_git || ($email_git_fallback &&
653 !$exact_pattern_match_hash{$file})) {
654 vcs_file_signoffs
($file);
656 if ($email_git_blame) {
657 vcs_file_blame
($file);
661 foreach my $email (@file_emails) {
662 my ($name, $address) = parse_email
($email);
664 my $tmp_email = format_email
($name, $address, $email_usename);
665 push_email_address
($tmp_email, '');
666 add_role
($tmp_email, 'in file');
671 if ($email || $email_list) {
673 @to = (@to, @email_to);
676 @to = (@to, @list_to);
681 @to = interactive_get_maintainers
(\
@to);
687 sub file_match_pattern
{
688 my ($file, $pattern) = @_;
689 if (substr($pattern, -1) eq "/") {
690 if ($file =~ m@
^$pattern@
) {
694 if ($file =~ m@
^$pattern@
) {
695 my $s1 = ($file =~ tr@
/@@
);
696 my $s2 = ($pattern =~ tr@
/@@
);
707 usage: $P [options] patchfile
708 $P [options] -f file|directory
711 MAINTAINER field selection options:
712 --email => print email address(es) if any
713 --git => include recent git \*-by: signers
714 --git-all-signature-types => include signers regardless of signature type
715 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
716 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
717 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
718 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
719 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
720 --git-blame => use git blame to find modified commits for patch or file
721 --git-since => git history to use (default: $email_git_since)
722 --hg-since => hg history to use (default: $email_hg_since)
723 --interactive => display a menu (mostly useful if used with the --git option)
724 --m => include maintainer(s) if any
725 --r => include reviewer(s) if any
726 --n => include name 'Full Name <addr\@domain.tld>'
727 --l => include list(s) if any
728 --s => include subscriber only list(s) if any
729 --remove-duplicates => minimize duplicate email names/addresses
730 --roles => show roles (status:subsystem, git-signer, list, etc...)
731 --rolestats => show roles and statistics (commits/total_commits, %)
732 --file-emails => add email addresses found in -f file (default: 0 (off))
733 --scm => print SCM tree(s) if any
734 --status => print status if any
735 --subsystem => print subsystem name if any
736 --web => print website(s) if any
739 --separator [, ] => separator for multiple entries on 1 line
740 using --separator also sets --nomultiline if --separator is not [, ]
741 --multiline => print 1 entry per line
744 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
745 --keywords => scan patch for keywords (default: $keywords)
746 --sections => print all of the subsystem sections with pattern matches
747 --mailmap => use .mailmap file (default: $email_use_mailmap)
748 --version => show version
749 --help => show this help information
752 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
753 --remove-duplicates --rolestats]
756 Using "-f directory" may give unexpected results:
757 Used with "--git", git signators for _all_ files in and below
758 directory are examined as git recurses directories.
759 Any specified X: (exclude) pattern matches are _not_ ignored.
760 Used with "--nogit", directory is used as a pattern match,
761 no individual file within the directory or subdirectory
763 Used with "--git-blame", does not iterate all files in directory
764 Using "--git-blame" is slow and may add old committers and authors
765 that are no longer active maintainers to the output.
766 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
767 other automated tools that expect only ["name"] <email address>
768 may not work because of additional output after <email address>.
769 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
770 not the percentage of the entire file authored. # of commits is
771 not a good measure of amount of code authored. 1 major commit may
772 contain a thousand lines, 5 trivial commits may modify a single line.
773 If git is not installed, but mercurial (hg) is installed and an .hg
774 repository exists, the following options apply to mercurial:
776 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
778 Use --hg-since not --git-since to control date selection
779 File ".get_maintainer.conf", if it exists in the QEMU source root
780 directory, can change whatever get_maintainer defaults are desired.
781 Entries in this file can be any command line argument.
782 This file is prepended to any additional command line arguments.
783 Multiple lines and # comments are allowed.
790 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
793 if ( (-f
"${lk_path}COPYING")
794 && (-f
"${lk_path}MAINTAINERS")
795 && (-f
"${lk_path}Makefile")
796 && (-d
"${lk_path}docs")
797 && (-f
"${lk_path}VERSION")
798 && (-d
"${lk_path}linux-user/")
799 && (-d
"${lk_path}softmmu/")) {
806 my ($formatted_email) = @_;
811 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
814 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
816 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
820 $name =~ s/^\s+|\s+$//g;
821 $name =~ s/^\"|\"$//g;
822 $address =~ s/^\s+|\s+$//g;
824 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
825 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
829 return ($name, $address);
833 my ($name, $address, $usename) = @_;
837 $name =~ s/^\s+|\s+$//g;
838 $name =~ s/^\"|\"$//g;
839 $address =~ s/^\s+|\s+$//g;
841 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
842 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
848 $formatted_email = "$address";
850 $formatted_email = "$name <$address>";
853 $formatted_email = $address;
856 return $formatted_email;
859 sub find_first_section
{
862 while ($index < @typevalue) {
863 my $tv = $typevalue[$index];
864 if (($tv =~ m/^(.):\s*(.*)/)) {
873 sub find_starting_index
{
877 my $tv = $typevalue[$index];
878 if (!($tv =~ m/^(.):\s*(.*)/)) {
887 sub find_ending_index
{
890 while ($index < @typevalue) {
891 my $tv = $typevalue[$index];
892 if (!($tv =~ m/^(.):\s*(.*)/)) {
901 sub get_subsystem_name
{
904 my $start = find_starting_index
($index);
906 my $subsystem = $typevalue[$start];
907 if (length($subsystem) > 20) {
908 $subsystem = substr($subsystem, 0, 17);
909 $subsystem =~ s/\s*$//;
910 $subsystem = $subsystem . "...";
915 sub get_maintainer_role
{
919 my $start = find_starting_index
($index);
920 my $end = find_ending_index
($index);
922 my $role = "unknown";
923 my $subsystem = get_subsystem_name
($index);
925 for ($i = $start + 1; $i < $end; $i++) {
926 my $tv = $typevalue[$i];
927 if ($tv =~ m/^(.):\s*(.*)/) {
937 if ($role eq "supported") {
939 } elsif ($role eq "maintained") {
940 $role = "maintainer";
941 } elsif ($role eq "odd fixes") {
943 } elsif ($role eq "orphan") {
944 $role = "orphan minder";
945 } elsif ($role eq "obsolete") {
946 $role = "obsolete minder";
947 } elsif ($role eq "buried alive in reporters") {
948 $role = "chief penguin";
951 return $role . ":" . $subsystem;
957 my $subsystem = get_subsystem_name
($index);
959 if ($subsystem eq "THE REST") {
970 my $start = find_starting_index
($index);
971 my $end = find_ending_index
($index);
973 push(@subsystem, $typevalue[$start]);
975 for ($i = $start + 1; $i < $end; $i++) {
976 my $tv = $typevalue[$i];
977 if ($tv =~ m/^(.):\s*(.*)/) {
981 my $list_address = $pvalue;
982 my $list_additional = "";
983 my $list_role = get_list_role
($i);
985 if ($list_role ne "") {
986 $list_role = ":" . $list_role;
988 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
990 $list_additional = $2;
992 if ($list_additional =~ m/subscribers-only/) {
993 if ($email_subscriber_list) {
994 if (!$hash_list_to{lc($list_address)}) {
995 $hash_list_to{lc($list_address)} = 1;
996 push(@list_to, [$list_address,
997 "subscriber list${list_role}"]);
1002 if (!$hash_list_to{lc($list_address)}) {
1003 $hash_list_to{lc($list_address)} = 1;
1004 if ($list_additional =~ m/moderated/) {
1005 push(@list_to, [$list_address,
1006 "moderated list${list_role}"]);
1008 push(@list_to, [$list_address,
1009 "open list${list_role}"]);
1014 } elsif ($ptype eq "M") {
1015 my ($name, $address) = parse_email
($pvalue);
1018 my $tv = $typevalue[$i - 1];
1019 if ($tv =~ m/^(.):\s*(.*)/) {
1022 $pvalue = format_email
($name, $address, $email_usename);
1027 if ($email_maintainer) {
1028 my $role = get_maintainer_role
($i);
1029 push_email_addresses
($pvalue, $role);
1031 } elsif ($ptype eq "R") {
1032 my ($name, $address) = parse_email
($pvalue);
1035 my $tv = $typevalue[$i - 1];
1036 if ($tv =~ m/^(.):\s*(.*)/) {
1039 $pvalue = format_email
($name, $address, $email_usename);
1044 if ($email_reviewer) {
1045 my $subsystem = get_subsystem_name
($i);
1046 push_email_addresses
($pvalue, "reviewer:$subsystem");
1048 } elsif ($ptype eq "T") {
1049 push(@scm, $pvalue);
1050 } elsif ($ptype eq "W") {
1051 push(@web, $pvalue);
1052 } elsif ($ptype eq "S") {
1053 push(@status, $pvalue);
1060 my ($name, $address) = @_;
1062 return 1 if (($name eq "") && ($address eq ""));
1063 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1064 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1069 sub push_email_address
{
1070 my ($line, $role) = @_;
1072 my ($name, $address) = parse_email
($line);
1074 if ($address eq "") {
1078 if (!$email_remove_duplicates) {
1079 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1080 } elsif (!email_inuse
($name, $address)) {
1081 push(@email_to, [format_email
($name, $address, $email_usename), $role]);
1082 $email_hash_name{lc($name)}++ if ($name ne "");
1083 $email_hash_address{lc($address)}++;
1089 sub push_email_addresses
{
1090 my ($address, $role) = @_;
1092 my @address_list = ();
1094 if (rfc822_valid
($address)) {
1095 push_email_address
($address, $role);
1096 } elsif (@address_list = rfc822_validlist
($address)) {
1097 my $array_count = shift(@address_list);
1098 while (my $entry = shift(@address_list)) {
1099 push_email_address
($entry, $role);
1102 if (!push_email_address
($address, $role)) {
1103 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1109 my ($line, $role) = @_;
1111 my ($name, $address) = parse_email
($line);
1112 my $email = format_email
($name, $address, $email_usename);
1114 foreach my $entry (@email_to) {
1115 if ($email_remove_duplicates) {
1116 my ($entry_name, $entry_address) = parse_email
($entry->[0]);
1117 if (($name eq $entry_name || $address eq $entry_address)
1118 && ($role eq "" || !($entry->[1] =~ m/$role/))
1120 if ($entry->[1] eq "") {
1121 $entry->[1] = "$role";
1123 $entry->[1] = "$entry->[1],$role";
1127 if ($email eq $entry->[0]
1128 && ($role eq "" || !($entry->[1] =~ m/$role/))
1130 if ($entry->[1] eq "") {
1131 $entry->[1] = "$role";
1133 $entry->[1] = "$entry->[1],$role";
1143 foreach my $path (split(/:/, $ENV{PATH
})) {
1144 if (-e
"$path/$bin") {
1145 return "$path/$bin";
1155 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1156 if (-e
"$path/$conf") {
1157 return "$path/$conf";
1167 my ($name, $address) = parse_email
($line);
1168 my $email = format_email
($name, $address, 1);
1169 my $real_name = $name;
1170 my $real_address = $address;
1172 if (exists $mailmap->{names
}->{$email} ||
1173 exists $mailmap->{addresses
}->{$email}) {
1174 if (exists $mailmap->{names
}->{$email}) {
1175 $real_name = $mailmap->{names
}->{$email};
1177 if (exists $mailmap->{addresses
}->{$email}) {
1178 $real_address = $mailmap->{addresses
}->{$email};
1181 if (exists $mailmap->{names
}->{$address}) {
1182 $real_name = $mailmap->{names
}->{$address};
1184 if (exists $mailmap->{addresses
}->{$address}) {
1185 $real_address = $mailmap->{addresses
}->{$address};
1188 return format_email
($real_name, $real_address, 1);
1192 my (@addresses) = @_;
1194 my @mapped_emails = ();
1195 foreach my $line (@addresses) {
1196 push(@mapped_emails, mailmap_email
($line));
1198 merge_by_realname
(@mapped_emails) if ($email_use_mailmap);
1199 return @mapped_emails;
1202 sub merge_by_realname
{
1206 foreach my $email (@emails) {
1207 my ($name, $address) = parse_email
($email);
1208 if (exists $address_map{$name}) {
1209 $address = $address_map{$name};
1210 $email = format_email
($name, $address, 1);
1212 $address_map{$name} = $address;
1217 sub git_execute_cmd
{
1221 my $output = `$cmd`;
1222 $output =~ s/^\s*//gm;
1223 @lines = split("\n", $output);
1228 sub hg_execute_cmd
{
1232 my $output = `$cmd`;
1233 @lines = split("\n", $output);
1238 sub extract_formatted_signatures
{
1239 my (@signature_lines) = @_;
1241 my @type = @signature_lines;
1243 s/\s*(.*):.*/$1/ for (@type);
1246 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1248 ## Reformat email addresses (with names) to avoid badly written signatures
1250 foreach my $signer (@signature_lines) {
1251 $signer = deduplicate_email
($signer);
1254 return (\
@type, \
@signature_lines);
1257 sub vcs_find_signers
{
1261 my @signatures = ();
1263 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1265 my $pattern = $VCS_cmds{"commit_pattern"};
1267 $commits = grep(/$pattern/, @lines); # of commits
1269 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1271 return (0, @signatures) if !@signatures;
1273 save_commits_by_author
(@lines) if ($interactive);
1274 save_commits_by_signer
(@lines) if ($interactive);
1276 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1278 return ($commits, @
$signers_ref);
1281 sub vcs_find_author
{
1285 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1287 return @lines if !@lines;
1290 foreach my $line (@lines) {
1291 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1293 my ($name, $address) = parse_email
($author);
1294 $author = format_email
($name, $address, 1);
1295 push(@authors, $author);
1299 save_commits_by_author
(@lines) if ($interactive);
1300 save_commits_by_signer
(@lines) if ($interactive);
1305 sub vcs_save_commits
{
1310 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1312 foreach my $line (@lines) {
1313 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1326 return @commits if (!(-f
$file));
1328 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1329 my @all_commits = ();
1331 $cmd = $VCS_cmds{"blame_file_cmd"};
1332 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1333 @all_commits = vcs_save_commits
($cmd);
1335 foreach my $file_range_diff (@range) {
1336 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1338 my $diff_start = $2;
1339 my $diff_length = $3;
1340 next if ("$file" ne "$diff_file");
1341 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1342 push(@commits, $all_commits[$i]);
1346 foreach my $file_range_diff (@range) {
1347 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1349 my $diff_start = $2;
1350 my $diff_length = $3;
1351 next if ("$file" ne "$diff_file");
1352 $cmd = $VCS_cmds{"blame_range_cmd"};
1353 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1354 push(@commits, vcs_save_commits
($cmd));
1357 $cmd = $VCS_cmds{"blame_file_cmd"};
1358 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1359 @commits = vcs_save_commits
($cmd);
1362 foreach my $commit (@commits) {
1363 $commit =~ s/^\^//g;
1369 my $printed_novcs = 0;
1371 %VCS_cmds = %VCS_cmds_git;
1372 return 1 if eval $VCS_cmds{"available"};
1373 %VCS_cmds = %VCS_cmds_hg;
1374 return 2 if eval $VCS_cmds{"available"};
1376 if (!$printed_novcs) {
1377 warn("$P: No supported VCS found. Add --nogit to options?\n");
1378 warn("Using a git repository produces better results.\n");
1379 warn("Try latest git repository using:\n");
1380 warn("git clone https://git.qemu.org/git/qemu.git\n");
1388 return $vcs_used == 1;
1392 return $vcs_used == 2;
1395 sub interactive_get_maintainers
{
1396 my ($list_ref) = @_;
1397 my @list = @
$list_ref;
1406 foreach my $entry (@list) {
1407 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1408 $selected{$count} = 1;
1409 $authored{$count} = 0;
1410 $signed{$count} = 0;
1416 my $print_options = 0;
1421 printf STDERR
"\n%1s %2s %-65s",
1422 "*", "#", "email/list and role:stats";
1424 ($email_git_fallback && !$maintained) ||
1426 print STDERR
"auth sign";
1429 foreach my $entry (@list) {
1430 my $email = $entry->[0];
1431 my $role = $entry->[1];
1433 $sel = "*" if ($selected{$count});
1434 my $commit_author = $commit_author_hash{$email};
1435 my $commit_signer = $commit_signer_hash{$email};
1438 $authored++ for (@
{$commit_author});
1439 $signed++ for (@
{$commit_signer});
1440 printf STDERR
"%1s %2d %-65s", $sel, $count + 1, $email;
1441 printf STDERR
"%4d %4d", $authored, $signed
1442 if ($authored > 0 || $signed > 0);
1443 printf STDERR
"\n %s\n", $role;
1444 if ($authored{$count}) {
1445 my $commit_author = $commit_author_hash{$email};
1446 foreach my $ref (@
{$commit_author}) {
1447 print STDERR
" Author: @{$ref}[1]\n";
1450 if ($signed{$count}) {
1451 my $commit_signer = $commit_signer_hash{$email};
1452 foreach my $ref (@
{$commit_signer}) {
1453 print STDERR
" @{$ref}[2]: @{$ref}[1]\n";
1460 my $date_ref = \
$email_git_since;
1461 $date_ref = \
$email_hg_since if (vcs_is_hg
());
1462 if ($print_options) {
1467 Version Control options:
1468 g use git history [$email_git]
1469 gf use git-fallback [$email_git_fallback]
1470 b use git blame [$email_git_blame]
1471 bs use blame signatures [$email_git_blame_signatures]
1472 c# minimum commits [$email_git_min_signatures]
1473 %# min percent [$email_git_min_percent]
1474 d# history to use [$$date_ref]
1475 x# max maintainers [$email_git_max_maintainers]
1476 t all signature types [$email_git_all_signature_types]
1477 m use .mailmap [$email_use_mailmap]
1484 tm toggle maintainers
1485 tg toggle git entries
1486 tl toggle open list entries
1487 ts toggle subscriber list entries
1488 f emails in file [$file_emails]
1489 k keywords in file [$keywords]
1490 r remove duplicates [$email_remove_duplicates]
1491 p# pattern match depth [$pattern_depth]
1495 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1497 my $input = <STDIN
>;
1502 my @wish = split(/[, ]+/, $input);
1503 foreach my $nr (@wish) {
1505 my $sel = substr($nr, 0, 1);
1506 my $str = substr($nr, 1);
1508 $val = $1 if $str =~ /^(\d+)$/;
1513 $output_rolestats = 0;
1516 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1517 $selected{$nr - 1} = !$selected{$nr - 1};
1518 } elsif ($sel eq "*" || $sel eq '^') {
1520 $toggle = 1 if ($sel eq '*');
1521 for (my $i = 0; $i < $count; $i++) {
1522 $selected{$i} = $toggle;
1524 } elsif ($sel eq "0") {
1525 for (my $i = 0; $i < $count; $i++) {
1526 $selected{$i} = !$selected{$i};
1528 } elsif ($sel eq "t") {
1529 if (lc($str) eq "m") {
1530 for (my $i = 0; $i < $count; $i++) {
1531 $selected{$i} = !$selected{$i}
1532 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1534 } elsif (lc($str) eq "g") {
1535 for (my $i = 0; $i < $count; $i++) {
1536 $selected{$i} = !$selected{$i}
1537 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1539 } elsif (lc($str) eq "l") {
1540 for (my $i = 0; $i < $count; $i++) {
1541 $selected{$i} = !$selected{$i}
1542 if ($list[$i]->[1] =~ /^(open list)/i);
1544 } elsif (lc($str) eq "s") {
1545 for (my $i = 0; $i < $count; $i++) {
1546 $selected{$i} = !$selected{$i}
1547 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1550 } elsif ($sel eq "a") {
1551 if ($val > 0 && $val <= $count) {
1552 $authored{$val - 1} = !$authored{$val - 1};
1553 } elsif ($str eq '*' || $str eq '^') {
1555 $toggle = 1 if ($str eq '*');
1556 for (my $i = 0; $i < $count; $i++) {
1557 $authored{$i} = $toggle;
1560 } elsif ($sel eq "s") {
1561 if ($val > 0 && $val <= $count) {
1562 $signed{$val - 1} = !$signed{$val - 1};
1563 } elsif ($str eq '*' || $str eq '^') {
1565 $toggle = 1 if ($str eq '*');
1566 for (my $i = 0; $i < $count; $i++) {
1567 $signed{$i} = $toggle;
1570 } elsif ($sel eq "o") {
1573 } elsif ($sel eq "g") {
1575 bool_invert
(\
$email_git_fallback);
1577 bool_invert
(\
$email_git);
1580 } elsif ($sel eq "b") {
1582 bool_invert
(\
$email_git_blame_signatures);
1584 bool_invert
(\
$email_git_blame);
1587 } elsif ($sel eq "c") {
1589 $email_git_min_signatures = $val;
1592 } elsif ($sel eq "x") {
1594 $email_git_max_maintainers = $val;
1597 } elsif ($sel eq "%") {
1598 if ($str ne "" && $val >= 0) {
1599 $email_git_min_percent = $val;
1602 } elsif ($sel eq "d") {
1604 $email_git_since = $str;
1605 } elsif (vcs_is_hg
()) {
1606 $email_hg_since = $str;
1609 } elsif ($sel eq "t") {
1610 bool_invert
(\
$email_git_all_signature_types);
1612 } elsif ($sel eq "f") {
1613 bool_invert
(\
$file_emails);
1615 } elsif ($sel eq "r") {
1616 bool_invert
(\
$email_remove_duplicates);
1618 } elsif ($sel eq "m") {
1619 bool_invert
(\
$email_use_mailmap);
1622 } elsif ($sel eq "k") {
1623 bool_invert
(\
$keywords);
1625 } elsif ($sel eq "p") {
1626 if ($str ne "" && $val >= 0) {
1627 $pattern_depth = $val;
1630 } elsif ($sel eq "h" || $sel eq "?") {
1633 Interactive mode allows you to select the various maintainers, submitters,
1634 commit signers and mailing lists that could be CC'd on a patch.
1636 Any *'d entry is selected.
1638 If you have git or hg installed, you can choose to summarize the commit
1639 history of files in the patch. Also, each line of the current file can
1640 be matched to its commit author and that commits signers with blame.
1642 Various knobs exist to control the length of time for active commit
1643 tracking, the maximum number of commit authors and signers to add,
1646 Enter selections at the prompt until you are satisfied that the selected
1647 maintainers are appropriate. You may enter multiple selections separated
1648 by either commas or spaces.
1652 print STDERR
"invalid option: '$nr'\n";
1657 print STDERR
"git-blame can be very slow, please have patience..."
1658 if ($email_git_blame);
1659 goto &get_maintainers
;
1663 #drop not selected entries
1665 my @new_emailto = ();
1666 foreach my $entry (@list) {
1667 if ($selected{$count}) {
1668 push(@new_emailto, $list[$count]);
1672 return @new_emailto;
1676 my ($bool_ref) = @_;
1685 sub deduplicate_email
{
1689 my ($name, $address) = parse_email
($email);
1690 $email = format_email
($name, $address, 1);
1691 $email = mailmap_email
($email);
1693 return $email if (!$email_remove_duplicates);
1695 ($name, $address) = parse_email
($email);
1697 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1698 $name = $deduplicate_name_hash{lc($name)}->[0];
1699 $address = $deduplicate_name_hash{lc($name)}->[1];
1701 } elsif ($deduplicate_address_hash{lc($address)}) {
1702 $name = $deduplicate_address_hash{lc($address)}->[0];
1703 $address = $deduplicate_address_hash{lc($address)}->[1];
1707 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1708 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1710 $email = format_email
($name, $address, 1);
1711 $email = mailmap_email
($email);
1715 sub save_commits_by_author
{
1722 foreach my $line (@lines) {
1723 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1725 $author = deduplicate_email
($author);
1726 push(@authors, $author);
1728 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1729 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1732 for (my $i = 0; $i < @authors; $i++) {
1734 foreach my $ref(@
{$commit_author_hash{$authors[$i]}}) {
1735 if (@
{$ref}[0] eq $commits[$i] &&
1736 @
{$ref}[1] eq $subjects[$i]) {
1742 push(@
{$commit_author_hash{$authors[$i]}},
1743 [ ($commits[$i], $subjects[$i]) ]);
1748 sub save_commits_by_signer
{
1754 foreach my $line (@lines) {
1755 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1756 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1757 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1758 my @signatures = ($line);
1759 my ($types_ref, $signers_ref) = extract_formatted_signatures
(@signatures);
1760 my @types = @
$types_ref;
1761 my @signers = @
$signers_ref;
1763 my $type = $types[0];
1764 my $signer = $signers[0];
1766 $signer = deduplicate_email
($signer);
1769 foreach my $ref(@
{$commit_signer_hash{$signer}}) {
1770 if (@
{$ref}[0] eq $commit &&
1771 @
{$ref}[1] eq $subject &&
1772 @
{$ref}[2] eq $type) {
1778 push(@
{$commit_signer_hash{$signer}},
1779 [ ($commit, $subject, $type) ]);
1786 my ($role, $divisor, @lines) = @_;
1791 return if (@lines <= 0);
1793 if ($divisor <= 0) {
1794 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1798 @lines = mailmap
(@lines);
1800 return if (@lines <= 0);
1802 @lines = sort(@lines);
1805 $hash{$_}++ for @lines;
1808 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1809 my $sign_offs = $hash{$line};
1810 my $percent = $sign_offs * 100 / $divisor;
1812 $percent = 100 if ($percent > 100);
1814 last if ($sign_offs < $email_git_min_signatures ||
1815 $count > $email_git_max_maintainers ||
1816 $percent < $email_git_min_percent);
1817 push_email_address
($line, '');
1818 if ($output_rolestats) {
1819 my $fmt_percent = sprintf("%.0f", $percent);
1820 add_role
($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1822 add_role
($line, $role);
1827 sub vcs_file_signoffs
{
1833 $vcs_used = vcs_exists
();
1834 return if (!$vcs_used);
1836 my $cmd = $VCS_cmds{"find_signers_cmd"};
1837 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1839 ($commits, @signers) = vcs_find_signers
($cmd);
1841 foreach my $signer (@signers) {
1842 $signer = deduplicate_email
($signer);
1845 vcs_assign
("commit_signer", $commits, @signers);
1848 sub vcs_file_blame
{
1852 my @all_commits = ();
1857 $vcs_used = vcs_exists
();
1858 return if (!$vcs_used);
1860 @all_commits = vcs_blame
($file);
1861 @commits = uniq
(@all_commits);
1862 $total_commits = @commits;
1863 $total_lines = @all_commits;
1865 if ($email_git_blame_signatures) {
1868 my @commit_signers = ();
1869 my $commit = join(" -r ", @commits);
1872 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1873 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1875 ($commit_count, @commit_signers) = vcs_find_signers
($cmd);
1877 push(@signers, @commit_signers);
1879 foreach my $commit (@commits) {
1881 my @commit_signers = ();
1884 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1885 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1887 ($commit_count, @commit_signers) = vcs_find_signers
($cmd);
1889 push(@signers, @commit_signers);
1894 if ($from_filename) {
1895 if ($output_rolestats) {
1897 if (vcs_is_hg
()) {{ # Double brace for last exit
1899 my @commit_signers = ();
1900 @commits = uniq
(@commits);
1901 @commits = sort(@commits);
1902 my $commit = join(" -r ", @commits);
1905 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1906 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1910 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1915 foreach my $line (@lines) {
1916 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1918 $author = deduplicate_email
($author);
1919 push(@authors, $author);
1923 save_commits_by_author
(@lines) if ($interactive);
1924 save_commits_by_signer
(@lines) if ($interactive);
1926 push(@signers, @authors);
1929 foreach my $commit (@commits) {
1931 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1932 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1933 my @author = vcs_find_author
($cmd);
1936 my $formatted_author = deduplicate_email
($author[0]);
1938 my $count = grep(/$commit/, @all_commits);
1939 for ($i = 0; $i < $count ; $i++) {
1940 push(@blame_signers, $formatted_author);
1944 if (@blame_signers) {
1945 vcs_assign
("authored lines", $total_lines, @blame_signers);
1948 foreach my $signer (@signers) {
1949 $signer = deduplicate_email
($signer);
1951 vcs_assign
("commits", $total_commits, @signers);
1953 foreach my $signer (@signers) {
1954 $signer = deduplicate_email
($signer);
1956 vcs_assign
("modified commits", $total_commits, @signers);
1964 @parms = grep(!$saw{$_}++, @parms);
1972 @parms = sort @parms;
1973 @parms = grep(!$saw{$_}++, @parms);
1977 sub clean_file_emails
{
1978 my (@file_emails) = @_;
1979 my @fmt_emails = ();
1981 foreach my $email (@file_emails) {
1982 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1983 my ($name, $address) = parse_email
($email);
1984 if ($name eq '"[,\.]"') {
1988 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1990 my $first = $nw[@nw - 3];
1991 my $middle = $nw[@nw - 2];
1992 my $last = $nw[@nw - 1];
1994 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1995 (length($first) == 2 && substr($first, -1) eq ".")) ||
1996 (length($middle) == 1 ||
1997 (length($middle) == 2 && substr($middle, -1) eq "."))) {
1998 $name = "$first $middle $last";
2000 $name = "$middle $last";
2004 if (substr($name, -1) =~ /[,\.]/) {
2005 $name = substr($name, 0, length($name) - 1);
2006 } elsif (substr($name, -2) =~ /[,\.]"/) {
2007 $name = substr($name, 0, length($name) - 2) . '"';
2010 if (substr($name, 0, 1) =~ /[,\.]/) {
2011 $name = substr($name, 1, length($name) - 1);
2012 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2013 $name = '"' . substr($name, 2, length($name) - 2);
2016 my $fmt_email = format_email
($name, $address, $email_usename);
2017 push(@fmt_emails, $fmt_email);
2027 my ($address, $role) = @
$_;
2028 if (!$saw{$address}) {
2029 if ($output_roles) {
2030 push(@lines, "$address ($role)");
2032 push(@lines, $address);
2044 if ($output_multiline) {
2045 foreach my $line (@parms) {
2049 print(join($output_separator, @parms));
2057 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2058 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2059 # This regexp will only work on addresses which have had comments stripped
2060 # and replaced with rfc822_lwsp.
2062 my $specials = '()<>@,;:\\\\".\\[\\]';
2063 my $controls = '\\000-\\037\\177';
2065 my $dtext = "[^\\[\\]\\r\\\\]";
2066 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2068 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2070 # Use zero-width assertion to spot the limit of an atom. A simple
2071 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2072 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2073 my $word = "(?:$atom|$quoted_string)";
2074 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2076 my $sub_domain = "(?:$atom|$domain_literal)";
2077 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2079 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2081 my $phrase = "$word*";
2082 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2083 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2084 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2086 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2087 my $address = "(?:$mailbox|$group)";
2089 return "$rfc822_lwsp*$address";
2092 sub rfc822_strip_comments
{
2094 # Recursively remove comments, and replace with a single space. The simpler
2095 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2096 # chars in atoms, for example.
2098 while ($s =~ s
/^((?
:[^"\\]|\\.)*
2099 (?:"(?
:[^"\\]|\\.)*"(?
:[^"\\]|\\.)*)*)
2100 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2104 # valid: returns true if the parameter is an RFC822 valid address
2107 my $s = rfc822_strip_comments(shift);
2110 $rfc822re = make_rfc822re();
2113 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2116 # validlist: In scalar context, returns true if the parameter is an RFC822
2117 # valid list of addresses.
2119 # In list context, returns an empty list on failure (an invalid
2120 # address was found); otherwise a list whose first element is the
2121 # number of addresses found and whose remaining elements are the
2122 # addresses. This is needed to disambiguate failure (invalid)
2123 # from success with no addresses found, because an empty string is
2126 sub rfc822_validlist {
2127 my $s = rfc822_strip_comments(shift);
2130 $rfc822re = make_rfc822re();
2132 # * null list items are valid according to the RFC
2133 # * the '1' business is to aid in distinguishing failure from no results
2136 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2137 $s =~ m/^$rfc822_char*$/) {
2138 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2141 return wantarray ? (scalar(@r), @r) : 1;
2143 return wantarray ? () : 0;