2 # (c) 2007, Joe Perches <joe@perches.com>
3 # created from checkpatch.pl
5 # Print selected MAINTAINERS information for
6 # the files modified in a patch or for a file
8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
9 # perl scripts/get_maintainer.pl [OPTIONS] -f <file>
11 # Licensed under the terms of the GNU GPL License version 2
18 use Getopt::Long qw(:config no_auto_abbrev);
22 my $email_usename = 1;
23 my $email_maintainer = 1;
25 my $email_subscriber_list = 0;
26 my $email_git_penguin_chiefs = 0;
28 my $email_git_all_signature_types = 0;
29 my $email_git_blame = 0;
30 my $email_git_blame_signatures = 1;
31 my $email_git_fallback = 1;
32 my $email_git_min_signatures = 1;
33 my $email_git_max_maintainers = 5;
34 my $email_git_min_percent = 5;
35 my $email_git_since = "1-year-ago";
36 my $email_hg_since = "-365";
38 my $email_remove_duplicates = 1;
39 my $email_use_mailmap = 1;
40 my $output_multiline = 1;
41 my $output_separator = ", ";
43 my $output_rolestats = 1;
51 my $from_filename = 0;
52 my $pattern_depth = 0;
60 my %commit_author_hash;
61 my %commit_signer_hash;
63 my @penguin_chief = ();
64 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
65 #Andrew wants in on most everything - 2009/01/14
66 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
68 my @penguin_chief_names = ();
69 foreach my $chief (@penguin_chief) {
70 if ($chief =~ m/^(.*):(.*)/) {
73 push(@penguin_chief_names, $chief_name);
76 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
78 # Signature types of people who are either
79 # a) responsible for the code in question, or
80 # b) familiar enough with it to give relevant feedback
81 my @signature_tags = ();
82 push(@signature_tags, "Signed-off-by:");
83 push(@signature_tags, "Reviewed-by:");
84 push(@signature_tags, "Acked-by:");
86 # rfc822 email address - preloaded methods go here.
87 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
88 my $rfc822_char = '[\\000-\\377]';
90 # VCS command support: class-like functions and strings
95 "execute_cmd" => \&git_execute_cmd,
96 "available" => '(which("git") ne "") && (-d ".git")',
98 "git log --no-color --since=\$email_git_since " .
99 '--format="GitCommit: %H%n' .
100 'GitAuthor: %an <%ae>%n' .
105 "find_commit_signers_cmd" =>
106 "git log --no-color " .
107 '--format="GitCommit: %H%n' .
108 'GitAuthor: %an <%ae>%n' .
113 "find_commit_author_cmd" =>
114 "git log --no-color " .
115 '--format="GitCommit: %H%n' .
116 'GitAuthor: %an <%ae>%n' .
118 'GitSubject: %s%n"' .
120 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
121 "blame_file_cmd" => "git blame -l \$file",
122 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
123 "blame_commit_pattern" => "^([0-9a-f]+) ",
124 "author_pattern" => "^GitAuthor: (.*)",
125 "subject_pattern" => "^GitSubject: (.*)",
129 "execute_cmd" => \&hg_execute_cmd,
130 "available" => '(which("hg") ne "") && (-d ".hg")',
131 "find_signers_cmd" =>
132 "hg log --date=\$email_hg_since " .
133 "--template='HgCommit: {node}\\n" .
134 "HgAuthor: {author}\\n" .
135 "HgSubject: {desc}\\n'" .
137 "find_commit_signers_cmd" =>
139 "--template='HgSubject: {desc}\\n'" .
141 "find_commit_author_cmd" =>
143 "--template='HgCommit: {node}\\n" .
144 "HgAuthor: {author}\\n" .
145 "HgSubject: {desc|firstline}\\n'" .
147 "blame_range_cmd" => "", # not supported
148 "blame_file_cmd" => "hg blame -n \$file",
149 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
150 "blame_commit_pattern" => "^([ 0-9a-f]+):",
151 "author_pattern" => "^HgAuthor: (.*)",
152 "subject_pattern" => "^HgSubject: (.*)",
155 my $conf = which_conf(".get_maintainer.conf");
158 open(my $conffile, '<', "$conf")
159 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
161 while (<$conffile>) {
164 $line =~ s/\s*\n?$//g;
168 next if ($line =~ m/^\s*#/);
169 next if ($line =~ m/^\s*$/);
171 my @words = split(" ", $line);
172 foreach my $word (@words) {
173 last if ($word =~ m/^#/);
174 push (@conf_args, $word);
178 unshift(@ARGV, @conf_args) if @conf_args;
183 'git!' => \$email_git,
184 'git-all-signature-types!' => \$email_git_all_signature_types,
185 'git-blame!' => \$email_git_blame,
186 'git-blame-signatures!' => \$email_git_blame_signatures,
187 'git-fallback!' => \$email_git_fallback,
188 'git-chief-penguins!' => \$email_git_penguin_chiefs,
189 'git-min-signatures=i' => \$email_git_min_signatures,
190 'git-max-maintainers=i' => \$email_git_max_maintainers,
191 'git-min-percent=i' => \$email_git_min_percent,
192 'git-since=s' => \$email_git_since,
193 'hg-since=s' => \$email_hg_since,
194 'i|interactive!' => \$interactive,
195 'remove-duplicates!' => \$email_remove_duplicates,
196 'mailmap!' => \$email_use_mailmap,
197 'm!' => \$email_maintainer,
198 'n!' => \$email_usename,
199 'l!' => \$email_list,
200 's!' => \$email_subscriber_list,
201 'multiline!' => \$output_multiline,
202 'roles!' => \$output_roles,
203 'rolestats!' => \$output_rolestats,
204 'separator=s' => \$output_separator,
205 'subsystem!' => \$subsystem,
206 'status!' => \$status,
209 'pattern-depth=i' => \$pattern_depth,
210 'k|keywords!' => \$keywords,
211 'sections!' => \$sections,
212 'fe|file-emails!' => \$file_emails,
213 'f|file' => \$from_filename,
214 'v|version' => \$version,
215 'h|help|usage' => \$help,
217 die "$P: invalid argument - use --help if necessary\n";
226 print("${P} ${V}\n");
230 if (-t STDIN && !@ARGV) {
231 # We're talking to a terminal, but have no command line arguments.
232 die "$P: missing patchfile or -f file - use --help if necessary\n";
235 $output_multiline = 0 if ($output_separator ne ", ");
236 $output_rolestats = 1 if ($interactive);
237 $output_roles = 1 if ($output_rolestats);
249 my $selections = $email + $scm + $status + $subsystem + $web;
250 if ($selections == 0) {
251 die "$P: Missing required option: email, scm, status, subsystem or web\n";
256 ($email_maintainer + $email_list + $email_subscriber_list +
257 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
258 die "$P: Please select at least 1 email option\n";
261 if (!top_of_tree($lk_path)) {
262 die "$P: The current directory does not appear to be "
263 . "a QEMU source tree.\n";
266 ## Read MAINTAINERS for type/value pairs
271 open (my $maint, '<', "${lk_path}MAINTAINERS")
272 or die "$P: Can't open MAINTAINERS: $!\n";
276 if ($line =~ m/^(\C):\s*(.*)/) {
280 ##Filename pattern matching
281 if ($type eq "F" || $type eq "X") {
282 $value =~ s@\.@\\\.@g; ##Convert . to \.
283 $value =~ s/\*/\.\*/g; ##Convert * to .*
284 $value =~ s/\?/\./g; ##Convert ? to .
285 ##if pattern is a directory and it lacks a trailing slash, add one
287 $value =~ s@([^/])$@$1/@;
289 } elsif ($type eq "K") {
290 $keyword_hash{@typevalue} = $value;
292 push(@typevalue, "$type:$value");
293 } elsif (!/^(\s)*$/) {
295 push(@typevalue, $line);
302 # Read mail address map
315 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
317 open(my $mailmap_file, '<', "${lk_path}.mailmap")
318 or warn "$P: Can't open .mailmap: $!\n";
320 while (<$mailmap_file>) {
321 s/#.*$//; #strip comments
322 s/^\s+|\s+$//g; #trim
324 next if (/^\s*$/); #skip empty lines
325 #entries have one of the following formats:
328 # name1 <mail1> <mail2>
329 # name1 <mail1> name2 <mail2>
330 # (see man git-shortlog)
331 if (/^(.+)<(.+)>$/) {
335 $real_name =~ s/\s+$//;
336 ($real_name, $address) = parse_email("$real_name <$address>");
337 $mailmap->{names}->{$address} = $real_name;
339 } elsif (/^<([^\s]+)>\s*<([^\s]+)>$/) {
340 my $real_address = $1;
341 my $wrong_address = $2;
343 $mailmap->{addresses}->{$wrong_address} = $real_address;
345 } elsif (/^(.+)<([^\s]+)>\s*<([^\s]+)>$/) {
347 my $real_address = $2;
348 my $wrong_address = $3;
350 $real_name =~ s/\s+$//;
351 ($real_name, $real_address) =
352 parse_email("$real_name <$real_address>");
353 $mailmap->{names}->{$wrong_address} = $real_name;
354 $mailmap->{addresses}->{$wrong_address} = $real_address;
356 } elsif (/^(.+)<([^\s]+)>\s*([^\s].*)<([^\s]+)>$/) {
358 my $real_address = $2;
360 my $wrong_address = $4;
362 $real_name =~ s/\s+$//;
363 ($real_name, $real_address) =
364 parse_email("$real_name <$real_address>");
366 $wrong_name =~ s/\s+$//;
367 ($wrong_name, $wrong_address) =
368 parse_email("$wrong_name <$wrong_address>");
370 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
371 $mailmap->{names}->{$wrong_email} = $real_name;
372 $mailmap->{addresses}->{$wrong_email} = $real_address;
375 close($mailmap_file);
378 ## use the filenames on the command line or find the filenames in the patchfiles
382 my @keyword_tvi = ();
383 my @file_emails = ();
386 push(@ARGV, "&STDIN");
389 foreach my $file (@ARGV) {
390 if ($file ne "&STDIN") {
391 ##if $file is a directory and it lacks a trailing slash, add one
393 $file =~ s@([^/])$@$1/@;
394 } elsif (!(-f $file)) {
395 die "$P: file '${file}' not found\n";
398 if ($from_filename) {
400 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
401 open(my $f, '<', $file)
402 or die "$P: Can't open $file: $!\n";
403 my $text = do { local($/) ; <$f> };
406 foreach my $line (keys %keyword_hash) {
407 if ($text =~ m/$keyword_hash{$line}/x) {
408 push(@keyword_tvi, $line);
413 my @poss_addr = $text =~ m$[A-Za-zÀ-ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
414 push(@file_emails, clean_file_emails(@poss_addr));
418 my $file_cnt = @files;
421 open(my $patch, "< $file")
422 or die "$P: Can't open $file: $!\n";
424 # We can check arbitrary information before the patch
425 # like the commit message, mail headers, etc...
426 # This allows us to match arbitrary keywords against any part
427 # of a git format-patch generated file (subject tags, etc...)
429 my $patch_prefix = ""; #Parsing the intro
433 if (m/^\+\+\+\s+(\S+)/) {
435 $filename =~ s@^[^/]*/@@;
437 $lastfile = $filename;
438 push(@files, $filename);
439 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
440 } elsif (m/^\@\@ -(\d+),(\d+)/) {
441 if ($email_git_blame) {
442 push(@range, "$lastfile:$1:$2");
444 } elsif ($keywords) {
445 foreach my $line (keys %keyword_hash) {
446 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
447 push(@keyword_tvi, $line);
454 if ($file_cnt == @files) {
455 warn "$P: file '${file}' doesn't appear to be a patch. "
456 . "Add -f to options?\n";
458 @files = sort_and_uniq(@files);
462 @file_emails = uniq(@file_emails);
465 my %email_hash_address;
473 my %deduplicate_name_hash = ();
474 my %deduplicate_address_hash = ();
475 my $signature_pattern;
477 my @maintainers = get_maintainers();
480 @maintainers = merge_email(@maintainers);
481 output(@maintainers);
490 @status = uniq(@status);
495 @subsystem = uniq(@subsystem);
506 sub range_is_maintained {
507 my ($start, $end) = @_;
509 for (my $i = $start; $i < $end; $i++) {
510 my $line = $typevalue[$i];
511 if ($line =~ m/^(\C):\s*(.*)/) {
515 if ($value =~ /(maintain|support)/i) {
524 sub range_has_maintainer {
525 my ($start, $end) = @_;
527 for (my $i = $start; $i < $end; $i++) {
528 my $line = $typevalue[$i];
529 if ($line =~ m/^(\C):\s*(.*)/) {
540 sub get_maintainers {
541 %email_hash_name = ();
542 %email_hash_address = ();
543 %commit_author_hash = ();
544 %commit_signer_hash = ();
552 %deduplicate_name_hash = ();
553 %deduplicate_address_hash = ();
554 if ($email_git_all_signature_types) {
555 $signature_pattern = "(.+?)[Bb][Yy]:";
557 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
560 # Find responsible parties
562 my %exact_pattern_match_hash = ();
564 foreach my $file (@files) {
567 my $tvi = find_first_section();
568 while ($tvi < @typevalue) {
569 my $start = find_starting_index($tvi);
570 my $end = find_ending_index($tvi);
574 #Do not match excluded file patterns
576 for ($i = $start; $i < $end; $i++) {
577 my $line = $typevalue[$i];
578 if ($line =~ m/^(\C):\s*(.*)/) {
582 if (file_match_pattern($file, $value)) {
591 for ($i = $start; $i < $end; $i++) {
592 my $line = $typevalue[$i];
593 if ($line =~ m/^(\C):\s*(.*)/) {
597 if (file_match_pattern($file, $value)) {
598 my $value_pd = ($value =~ tr@/@@);
599 my $file_pd = ($file =~ tr@/@@);
600 $value_pd++ if (substr($value,-1,1) ne "/");
601 $value_pd = -1 if ($value =~ /^\.\*/);
602 if ($value_pd >= $file_pd &&
603 range_is_maintained($start, $end) &&
604 range_has_maintainer($start, $end)) {
605 $exact_pattern_match_hash{$file} = 1;
607 if ($pattern_depth == 0 ||
608 (($file_pd - $value_pd) < $pattern_depth)) {
609 $hash{$tvi} = $value_pd;
619 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
620 add_categories($line);
623 my $start = find_starting_index($line);
624 my $end = find_ending_index($line);
625 for ($i = $start; $i < $end; $i++) {
626 my $line = $typevalue[$i];
627 if ($line =~ /^[FX]:/) { ##Restore file patterns
628 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
629 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
630 $line =~ s/\\\./\./g; ##Convert \. to .
631 $line =~ s/\.\*/\*/g; ##Convert .* to *
633 $line =~ s/^([A-Z]):/$1:\t/g;
642 @keyword_tvi = sort_and_uniq(@keyword_tvi);
643 foreach my $line (@keyword_tvi) {
644 add_categories($line);
648 foreach my $email (@email_to, @list_to) {
649 $email->[0] = deduplicate_email($email->[0]);
652 foreach my $file (@files) {
654 ($email_git || ($email_git_fallback &&
655 !$exact_pattern_match_hash{$file}))) {
656 vcs_file_signoffs($file);
658 if ($email && $email_git_blame) {
659 vcs_file_blame($file);
664 foreach my $chief (@penguin_chief) {
665 if ($chief =~ m/^(.*):(.*)/) {
668 $email_address = format_email($1, $2, $email_usename);
669 if ($email_git_penguin_chiefs) {
670 push(@email_to, [$email_address, 'chief penguin']);
672 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
677 foreach my $email (@file_emails) {
678 my ($name, $address) = parse_email($email);
680 my $tmp_email = format_email($name, $address, $email_usename);
681 push_email_address($tmp_email, '');
682 add_role($tmp_email, 'in file');
687 if ($email || $email_list) {
689 @to = (@to, @email_to);
692 @to = (@to, @list_to);
697 @to = interactive_get_maintainers(\@to);
703 sub file_match_pattern {
704 my ($file, $pattern) = @_;
705 if (substr($pattern, -1) eq "/") {
706 if ($file =~ m@^$pattern@) {
710 if ($file =~ m@^$pattern@) {
711 my $s1 = ($file =~ tr@/@@);
712 my $s2 = ($pattern =~ tr@/@@);
723 usage: $P [options] patchfile
724 $P [options] -f file|directory
727 MAINTAINER field selection options:
728 --email => print email address(es) if any
729 --git => include recent git \*-by: signers
730 --git-all-signature-types => include signers regardless of signature type
731 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
732 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
733 --git-chief-penguins => include ${penguin_chiefs}
734 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
735 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
736 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
737 --git-blame => use git blame to find modified commits for patch or file
738 --git-since => git history to use (default: $email_git_since)
739 --hg-since => hg history to use (default: $email_hg_since)
740 --interactive => display a menu (mostly useful if used with the --git option)
741 --m => include maintainer(s) if any
742 --n => include name 'Full Name <addr\@domain.tld>'
743 --l => include list(s) if any
744 --s => include subscriber only list(s) if any
745 --remove-duplicates => minimize duplicate email names/addresses
746 --roles => show roles (status:subsystem, git-signer, list, etc...)
747 --rolestats => show roles and statistics (commits/total_commits, %)
748 --file-emails => add email addresses found in -f file (default: 0 (off))
749 --scm => print SCM tree(s) if any
750 --status => print status if any
751 --subsystem => print subsystem name if any
752 --web => print website(s) if any
755 --separator [, ] => separator for multiple entries on 1 line
756 using --separator also sets --nomultiline if --separator is not [, ]
757 --multiline => print 1 entry per line
760 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
761 --keywords => scan patch for keywords (default: $keywords)
762 --sections => print all of the subsystem sections with pattern matches
763 --mailmap => use .mailmap file (default: $email_use_mailmap)
764 --version => show version
765 --help => show this help information
768 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
769 --remove-duplicates --rolestats]
772 Using "-f directory" may give unexpected results:
773 Used with "--git", git signators for _all_ files in and below
774 directory are examined as git recurses directories.
775 Any specified X: (exclude) pattern matches are _not_ ignored.
776 Used with "--nogit", directory is used as a pattern match,
777 no individual file within the directory or subdirectory
779 Used with "--git-blame", does not iterate all files in directory
780 Using "--git-blame" is slow and may add old committers and authors
781 that are no longer active maintainers to the output.
782 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
783 other automated tools that expect only ["name"] <email address>
784 may not work because of additional output after <email address>.
785 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
786 not the percentage of the entire file authored. # of commits is
787 not a good measure of amount of code authored. 1 major commit may
788 contain a thousand lines, 5 trivial commits may modify a single line.
789 If git is not installed, but mercurial (hg) is installed and an .hg
790 repository exists, the following options apply to mercurial:
792 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
794 Use --hg-since not --git-since to control date selection
795 File ".get_maintainer.conf", if it exists in the QEMU source root
796 directory, can change whatever get_maintainer defaults are desired.
797 Entries in this file can be any command line argument.
798 This file is prepended to any additional command line arguments.
799 Multiple lines and # comments are allowed.
806 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
809 if ( (-f "${lk_path}COPYING")
810 && (-f "${lk_path}MAINTAINERS")
811 && (-f "${lk_path}Makefile")
812 && (-d "${lk_path}docs")
813 && (-f "${lk_path}VERSION")
814 && (-f "${lk_path}vl.c")) {
821 my ($formatted_email) = @_;
826 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
829 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
831 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
835 $name =~ s/^\s+|\s+$//g;
836 $name =~ s/^\"|\"$//g;
837 $address =~ s/^\s+|\s+$//g;
839 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
840 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
844 return ($name, $address);
848 my ($name, $address, $usename) = @_;
852 $name =~ s/^\s+|\s+$//g;
853 $name =~ s/^\"|\"$//g;
854 $address =~ s/^\s+|\s+$//g;
856 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
857 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
863 $formatted_email = "$address";
865 $formatted_email = "$name <$address>";
868 $formatted_email = $address;
871 return $formatted_email;
874 sub find_first_section {
877 while ($index < @typevalue) {
878 my $tv = $typevalue[$index];
879 if (($tv =~ m/^(\C):\s*(.*)/)) {
888 sub find_starting_index {
892 my $tv = $typevalue[$index];
893 if (!($tv =~ m/^(\C):\s*(.*)/)) {
902 sub find_ending_index {
905 while ($index < @typevalue) {
906 my $tv = $typevalue[$index];
907 if (!($tv =~ m/^(\C):\s*(.*)/)) {
916 sub get_maintainer_role {
920 my $start = find_starting_index($index);
921 my $end = find_ending_index($index);
924 my $subsystem = $typevalue[$start];
925 if (length($subsystem) > 20) {
926 $subsystem = substr($subsystem, 0, 17);
927 $subsystem =~ s/\s*$//;
928 $subsystem = $subsystem . "...";
931 for ($i = $start + 1; $i < $end; $i++) {
932 my $tv = $typevalue[$i];
933 if ($tv =~ m/^(\C):\s*(.*)/) {
943 if ($role eq "supported") {
945 } elsif ($role eq "maintained") {
946 $role = "maintainer";
947 } elsif ($role eq "odd fixes") {
949 } elsif ($role eq "orphan") {
950 $role = "orphan minder";
951 } elsif ($role eq "obsolete") {
952 $role = "obsolete minder";
953 } elsif ($role eq "buried alive in reporters") {
954 $role = "chief penguin";
957 return $role . ":" . $subsystem;
964 my $start = find_starting_index($index);
965 my $end = find_ending_index($index);
967 my $subsystem = $typevalue[$start];
968 if (length($subsystem) > 20) {
969 $subsystem = substr($subsystem, 0, 17);
970 $subsystem =~ s/\s*$//;
971 $subsystem = $subsystem . "...";
974 if ($subsystem eq "THE REST") {
985 my $start = find_starting_index($index);
986 my $end = find_ending_index($index);
988 push(@subsystem, $typevalue[$start]);
990 for ($i = $start + 1; $i < $end; $i++) {
991 my $tv = $typevalue[$i];
992 if ($tv =~ m/^(\C):\s*(.*)/) {
996 my $list_address = $pvalue;
997 my $list_additional = "";
998 my $list_role = get_list_role($i);
1000 if ($list_role ne "") {
1001 $list_role = ":" . $list_role;
1003 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1005 $list_additional = $2;
1007 if ($list_additional =~ m/subscribers-only/) {
1008 if ($email_subscriber_list) {
1009 if (!$hash_list_to{lc($list_address)}) {
1010 $hash_list_to{lc($list_address)} = 1;
1011 push(@list_to, [$list_address,
1012 "subscriber list${list_role}"]);
1017 if (!$hash_list_to{lc($list_address)}) {
1018 $hash_list_to{lc($list_address)} = 1;
1019 push(@list_to, [$list_address,
1020 "open list${list_role}"]);
1024 } elsif ($ptype eq "M") {
1025 my ($name, $address) = parse_email($pvalue);
1028 my $tv = $typevalue[$i - 1];
1029 if ($tv =~ m/^(\C):\s*(.*)/) {
1032 $pvalue = format_email($name, $address, $email_usename);
1037 if ($email_maintainer) {
1038 my $role = get_maintainer_role($i);
1039 push_email_addresses($pvalue, $role);
1041 } elsif ($ptype eq "T") {
1042 push(@scm, $pvalue);
1043 } elsif ($ptype eq "W") {
1044 push(@web, $pvalue);
1045 } elsif ($ptype eq "S") {
1046 push(@status, $pvalue);
1053 my ($name, $address) = @_;
1055 return 1 if (($name eq "") && ($address eq ""));
1056 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1057 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1062 sub push_email_address {
1063 my ($line, $role) = @_;
1065 my ($name, $address) = parse_email($line);
1067 if ($address eq "") {
1071 if (!$email_remove_duplicates) {
1072 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1073 } elsif (!email_inuse($name, $address)) {
1074 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1075 $email_hash_name{lc($name)}++ if ($name ne "");
1076 $email_hash_address{lc($address)}++;
1082 sub push_email_addresses {
1083 my ($address, $role) = @_;
1085 my @address_list = ();
1087 if (rfc822_valid($address)) {
1088 push_email_address($address, $role);
1089 } elsif (@address_list = rfc822_validlist($address)) {
1090 my $array_count = shift(@address_list);
1091 while (my $entry = shift(@address_list)) {
1092 push_email_address($entry, $role);
1095 if (!push_email_address($address, $role)) {
1096 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1102 my ($line, $role) = @_;
1104 my ($name, $address) = parse_email($line);
1105 my $email = format_email($name, $address, $email_usename);
1107 foreach my $entry (@email_to) {
1108 if ($email_remove_duplicates) {
1109 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1110 if (($name eq $entry_name || $address eq $entry_address)
1111 && ($role eq "" || !($entry->[1] =~ m/$role/))
1113 if ($entry->[1] eq "") {
1114 $entry->[1] = "$role";
1116 $entry->[1] = "$entry->[1],$role";
1120 if ($email eq $entry->[0]
1121 && ($role eq "" || !($entry->[1] =~ m/$role/))
1123 if ($entry->[1] eq "") {
1124 $entry->[1] = "$role";
1126 $entry->[1] = "$entry->[1],$role";
1136 foreach my $path (split(/:/, $ENV{PATH})) {
1137 if (-e "$path/$bin") {
1138 return "$path/$bin";
1148 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1149 if (-e "$path/$conf") {
1150 return "$path/$conf";
1160 my ($name, $address) = parse_email($line);
1161 my $email = format_email($name, $address, 1);
1162 my $real_name = $name;
1163 my $real_address = $address;
1165 if (exists $mailmap->{names}->{$email} ||
1166 exists $mailmap->{addresses}->{$email}) {
1167 if (exists $mailmap->{names}->{$email}) {
1168 $real_name = $mailmap->{names}->{$email};
1170 if (exists $mailmap->{addresses}->{$email}) {
1171 $real_address = $mailmap->{addresses}->{$email};
1174 if (exists $mailmap->{names}->{$address}) {
1175 $real_name = $mailmap->{names}->{$address};
1177 if (exists $mailmap->{addresses}->{$address}) {
1178 $real_address = $mailmap->{addresses}->{$address};
1181 return format_email($real_name, $real_address, 1);
1185 my (@addresses) = @_;
1187 my @mapped_emails = ();
1188 foreach my $line (@addresses) {
1189 push(@mapped_emails, mailmap_email($line));
1191 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1192 return @mapped_emails;
1195 sub merge_by_realname {
1199 foreach my $email (@emails) {
1200 my ($name, $address) = parse_email($email);
1201 if (exists $address_map{$name}) {
1202 $address = $address_map{$name};
1203 $email = format_email($name, $address, 1);
1205 $address_map{$name} = $address;
1210 sub git_execute_cmd {
1214 my $output = `$cmd`;
1215 $output =~ s/^\s*//gm;
1216 @lines = split("\n", $output);
1221 sub hg_execute_cmd {
1225 my $output = `$cmd`;
1226 @lines = split("\n", $output);
1231 sub extract_formatted_signatures {
1232 my (@signature_lines) = @_;
1234 my @type = @signature_lines;
1236 s/\s*(.*):.*/$1/ for (@type);
1239 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1241 ## Reformat email addresses (with names) to avoid badly written signatures
1243 foreach my $signer (@signature_lines) {
1244 $signer = deduplicate_email($signer);
1247 return (\@type, \@signature_lines);
1250 sub vcs_find_signers {
1254 my @signatures = ();
1256 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1258 my $pattern = $VCS_cmds{"commit_pattern"};
1260 $commits = grep(/$pattern/, @lines); # of commits
1262 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1264 return (0, @signatures) if !@signatures;
1266 save_commits_by_author(@lines) if ($interactive);
1267 save_commits_by_signer(@lines) if ($interactive);
1269 if (!$email_git_penguin_chiefs) {
1270 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1273 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1275 return ($commits, @$signers_ref);
1278 sub vcs_find_author {
1282 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1284 if (!$email_git_penguin_chiefs) {
1285 @lines = grep(!/${penguin_chiefs}/i, @lines);
1288 return @lines if !@lines;
1291 foreach my $line (@lines) {
1292 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1294 my ($name, $address) = parse_email($author);
1295 $author = format_email($name, $address, 1);
1296 push(@authors, $author);
1300 save_commits_by_author(@lines) if ($interactive);
1301 save_commits_by_signer(@lines) if ($interactive);
1306 sub vcs_save_commits {
1311 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1313 foreach my $line (@lines) {
1314 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1327 return @commits if (!(-f $file));
1329 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1330 my @all_commits = ();
1332 $cmd = $VCS_cmds{"blame_file_cmd"};
1333 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1334 @all_commits = vcs_save_commits($cmd);
1336 foreach my $file_range_diff (@range) {
1337 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1339 my $diff_start = $2;
1340 my $diff_length = $3;
1341 next if ("$file" ne "$diff_file");
1342 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1343 push(@commits, $all_commits[$i]);
1347 foreach my $file_range_diff (@range) {
1348 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1350 my $diff_start = $2;
1351 my $diff_length = $3;
1352 next if ("$file" ne "$diff_file");
1353 $cmd = $VCS_cmds{"blame_range_cmd"};
1354 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1355 push(@commits, vcs_save_commits($cmd));
1358 $cmd = $VCS_cmds{"blame_file_cmd"};
1359 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1360 @commits = vcs_save_commits($cmd);
1363 foreach my $commit (@commits) {
1364 $commit =~ s/^\^//g;
1370 my $printed_novcs = 0;
1372 %VCS_cmds = %VCS_cmds_git;
1373 return 1 if eval $VCS_cmds{"available"};
1374 %VCS_cmds = %VCS_cmds_hg;
1375 return 2 if eval $VCS_cmds{"available"};
1377 if (!$printed_novcs) {
1378 warn("$P: No supported VCS found. Add --nogit to options?\n");
1379 warn("Using a git repository produces better results.\n");
1380 warn("Try latest git repository using:\n");
1381 warn("git clone git://git.qemu.org/qemu.git\n");
1389 return $vcs_used == 1;
1393 return $vcs_used == 2;
1396 sub interactive_get_maintainers {
1397 my ($list_ref) = @_;
1398 my @list = @$list_ref;
1407 foreach my $entry (@list) {
1408 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1409 $selected{$count} = 1;
1410 $authored{$count} = 0;
1411 $signed{$count} = 0;
1417 my $print_options = 0;
1422 printf STDERR "\n%1s %2s %-65s",
1423 "*", "#", "email/list and role:stats";
1425 ($email_git_fallback && !$maintained) ||
1427 print STDERR "auth sign";
1430 foreach my $entry (@list) {
1431 my $email = $entry->[0];
1432 my $role = $entry->[1];
1434 $sel = "*" if ($selected{$count});
1435 my $commit_author = $commit_author_hash{$email};
1436 my $commit_signer = $commit_signer_hash{$email};
1439 $authored++ for (@{$commit_author});
1440 $signed++ for (@{$commit_signer});
1441 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1442 printf STDERR "%4d %4d", $authored, $signed
1443 if ($authored > 0 || $signed > 0);
1444 printf STDERR "\n %s\n", $role;
1445 if ($authored{$count}) {
1446 my $commit_author = $commit_author_hash{$email};
1447 foreach my $ref (@{$commit_author}) {
1448 print STDERR " Author: @{$ref}[1]\n";
1451 if ($signed{$count}) {
1452 my $commit_signer = $commit_signer_hash{$email};
1453 foreach my $ref (@{$commit_signer}) {
1454 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1461 my $date_ref = \$email_git_since;
1462 $date_ref = \$email_hg_since if (vcs_is_hg());
1463 if ($print_options) {
1468 Version Control options:
1469 g use git history [$email_git]
1470 gf use git-fallback [$email_git_fallback]
1471 b use git blame [$email_git_blame]
1472 bs use blame signatures [$email_git_blame_signatures]
1473 c# minimum commits [$email_git_min_signatures]
1474 %# min percent [$email_git_min_percent]
1475 d# history to use [$$date_ref]
1476 x# max maintainers [$email_git_max_maintainers]
1477 t all signature types [$email_git_all_signature_types]
1478 m use .mailmap [$email_use_mailmap]
1485 tm toggle maintainers
1486 tg toggle git entries
1487 tl toggle open list entries
1488 ts toggle subscriber list entries
1489 f emails in file [$file_emails]
1490 k keywords in file [$keywords]
1491 r remove duplicates [$email_remove_duplicates]
1492 p# pattern match depth [$pattern_depth]
1496 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1498 my $input = <STDIN>;
1503 my @wish = split(/[, ]+/, $input);
1504 foreach my $nr (@wish) {
1506 my $sel = substr($nr, 0, 1);
1507 my $str = substr($nr, 1);
1509 $val = $1 if $str =~ /^(\d+)$/;
1514 $output_rolestats = 0;
1517 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1518 $selected{$nr - 1} = !$selected{$nr - 1};
1519 } elsif ($sel eq "*" || $sel eq '^') {
1521 $toggle = 1 if ($sel eq '*');
1522 for (my $i = 0; $i < $count; $i++) {
1523 $selected{$i} = $toggle;
1525 } elsif ($sel eq "0") {
1526 for (my $i = 0; $i < $count; $i++) {
1527 $selected{$i} = !$selected{$i};
1529 } elsif ($sel eq "t") {
1530 if (lc($str) eq "m") {
1531 for (my $i = 0; $i < $count; $i++) {
1532 $selected{$i} = !$selected{$i}
1533 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1535 } elsif (lc($str) eq "g") {
1536 for (my $i = 0; $i < $count; $i++) {
1537 $selected{$i} = !$selected{$i}
1538 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1540 } elsif (lc($str) eq "l") {
1541 for (my $i = 0; $i < $count; $i++) {
1542 $selected{$i} = !$selected{$i}
1543 if ($list[$i]->[1] =~ /^(open list)/i);
1545 } elsif (lc($str) eq "s") {
1546 for (my $i = 0; $i < $count; $i++) {
1547 $selected{$i} = !$selected{$i}
1548 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1551 } elsif ($sel eq "a") {
1552 if ($val > 0 && $val <= $count) {
1553 $authored{$val - 1} = !$authored{$val - 1};
1554 } elsif ($str eq '*' || $str eq '^') {
1556 $toggle = 1 if ($str eq '*');
1557 for (my $i = 0; $i < $count; $i++) {
1558 $authored{$i} = $toggle;
1561 } elsif ($sel eq "s") {
1562 if ($val > 0 && $val <= $count) {
1563 $signed{$val - 1} = !$signed{$val - 1};
1564 } elsif ($str eq '*' || $str eq '^') {
1566 $toggle = 1 if ($str eq '*');
1567 for (my $i = 0; $i < $count; $i++) {
1568 $signed{$i} = $toggle;
1571 } elsif ($sel eq "o") {
1574 } elsif ($sel eq "g") {
1576 bool_invert(\$email_git_fallback);
1578 bool_invert(\$email_git);
1581 } elsif ($sel eq "b") {
1583 bool_invert(\$email_git_blame_signatures);
1585 bool_invert(\$email_git_blame);
1588 } elsif ($sel eq "c") {
1590 $email_git_min_signatures = $val;
1593 } elsif ($sel eq "x") {
1595 $email_git_max_maintainers = $val;
1598 } elsif ($sel eq "%") {
1599 if ($str ne "" && $val >= 0) {
1600 $email_git_min_percent = $val;
1603 } elsif ($sel eq "d") {
1605 $email_git_since = $str;
1606 } elsif (vcs_is_hg()) {
1607 $email_hg_since = $str;
1610 } elsif ($sel eq "t") {
1611 bool_invert(\$email_git_all_signature_types);
1613 } elsif ($sel eq "f") {
1614 bool_invert(\$file_emails);
1616 } elsif ($sel eq "r") {
1617 bool_invert(\$email_remove_duplicates);
1619 } elsif ($sel eq "m") {
1620 bool_invert(\$email_use_mailmap);
1623 } elsif ($sel eq "k") {
1624 bool_invert(\$keywords);
1626 } elsif ($sel eq "p") {
1627 if ($str ne "" && $val >= 0) {
1628 $pattern_depth = $val;
1631 } elsif ($sel eq "h" || $sel eq "?") {
1634 Interactive mode allows you to select the various maintainers, submitters,
1635 commit signers and mailing lists that could be CC'd on a patch.
1637 Any *'d entry is selected.
1639 If you have git or hg installed, you can choose to summarize the commit
1640 history of files in the patch. Also, each line of the current file can
1641 be matched to its commit author and that commits signers with blame.
1643 Various knobs exist to control the length of time for active commit
1644 tracking, the maximum number of commit authors and signers to add,
1647 Enter selections at the prompt until you are satisfied that the selected
1648 maintainers are appropriate. You may enter multiple selections separated
1649 by either commas or spaces.
1653 print STDERR "invalid option: '$nr'\n";
1658 print STDERR "git-blame can be very slow, please have patience..."
1659 if ($email_git_blame);
1660 goto &get_maintainers;
1664 #drop not selected entries
1666 my @new_emailto = ();
1667 foreach my $entry (@list) {
1668 if ($selected{$count}) {
1669 push(@new_emailto, $list[$count]);
1673 return @new_emailto;
1677 my ($bool_ref) = @_;
1686 sub deduplicate_email {
1690 my ($name, $address) = parse_email($email);
1691 $email = format_email($name, $address, 1);
1692 $email = mailmap_email($email);
1694 return $email if (!$email_remove_duplicates);
1696 ($name, $address) = parse_email($email);
1698 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1699 $name = $deduplicate_name_hash{lc($name)}->[0];
1700 $address = $deduplicate_name_hash{lc($name)}->[1];
1702 } elsif ($deduplicate_address_hash{lc($address)}) {
1703 $name = $deduplicate_address_hash{lc($address)}->[0];
1704 $address = $deduplicate_address_hash{lc($address)}->[1];
1708 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1709 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1711 $email = format_email($name, $address, 1);
1712 $email = mailmap_email($email);
1716 sub save_commits_by_author {
1723 foreach my $line (@lines) {
1724 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1726 $author = deduplicate_email($author);
1727 push(@authors, $author);
1729 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1730 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1733 for (my $i = 0; $i < @authors; $i++) {
1735 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1736 if (@{$ref}[0] eq $commits[$i] &&
1737 @{$ref}[1] eq $subjects[$i]) {
1743 push(@{$commit_author_hash{$authors[$i]}},
1744 [ ($commits[$i], $subjects[$i]) ]);
1749 sub save_commits_by_signer {
1755 foreach my $line (@lines) {
1756 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1757 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1758 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1759 my @signatures = ($line);
1760 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1761 my @types = @$types_ref;
1762 my @signers = @$signers_ref;
1764 my $type = $types[0];
1765 my $signer = $signers[0];
1767 $signer = deduplicate_email($signer);
1770 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1771 if (@{$ref}[0] eq $commit &&
1772 @{$ref}[1] eq $subject &&
1773 @{$ref}[2] eq $type) {
1779 push(@{$commit_signer_hash{$signer}},
1780 [ ($commit, $subject, $type) ]);
1787 my ($role, $divisor, @lines) = @_;
1792 return if (@lines <= 0);
1794 if ($divisor <= 0) {
1795 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1799 @lines = mailmap(@lines);
1801 return if (@lines <= 0);
1803 @lines = sort(@lines);
1806 $hash{$_}++ for @lines;
1809 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1810 my $sign_offs = $hash{$line};
1811 my $percent = $sign_offs * 100 / $divisor;
1813 $percent = 100 if ($percent > 100);
1815 last if ($sign_offs < $email_git_min_signatures ||
1816 $count > $email_git_max_maintainers ||
1817 $percent < $email_git_min_percent);
1818 push_email_address($line, '');
1819 if ($output_rolestats) {
1820 my $fmt_percent = sprintf("%.0f", $percent);
1821 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1823 add_role($line, $role);
1828 sub vcs_file_signoffs {
1834 $vcs_used = vcs_exists();
1835 return if (!$vcs_used);
1837 my $cmd = $VCS_cmds{"find_signers_cmd"};
1838 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1840 ($commits, @signers) = vcs_find_signers($cmd);
1842 foreach my $signer (@signers) {
1843 $signer = deduplicate_email($signer);
1846 vcs_assign("commit_signer", $commits, @signers);
1849 sub vcs_file_blame {
1853 my @all_commits = ();
1858 $vcs_used = vcs_exists();
1859 return if (!$vcs_used);
1861 @all_commits = vcs_blame($file);
1862 @commits = uniq(@all_commits);
1863 $total_commits = @commits;
1864 $total_lines = @all_commits;
1866 if ($email_git_blame_signatures) {
1869 my @commit_signers = ();
1870 my $commit = join(" -r ", @commits);
1873 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1874 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1876 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1878 push(@signers, @commit_signers);
1880 foreach my $commit (@commits) {
1882 my @commit_signers = ();
1885 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1886 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1888 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1890 push(@signers, @commit_signers);
1895 if ($from_filename) {
1896 if ($output_rolestats) {
1898 if (vcs_is_hg()) {{ # Double brace for last exit
1900 my @commit_signers = ();
1901 @commits = uniq(@commits);
1902 @commits = sort(@commits);
1903 my $commit = join(" -r ", @commits);
1906 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1907 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1911 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1913 if (!$email_git_penguin_chiefs) {
1914 @lines = grep(!/${penguin_chiefs}/i, @lines);
1920 foreach my $line (@lines) {
1921 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1923 $author = deduplicate_email($author);
1924 push(@authors, $author);
1928 save_commits_by_author(@lines) if ($interactive);
1929 save_commits_by_signer(@lines) if ($interactive);
1931 push(@signers, @authors);
1934 foreach my $commit (@commits) {
1936 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1937 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1938 my @author = vcs_find_author($cmd);
1941 my $formatted_author = deduplicate_email($author[0]);
1943 my $count = grep(/$commit/, @all_commits);
1944 for ($i = 0; $i < $count ; $i++) {
1945 push(@blame_signers, $formatted_author);
1949 if (@blame_signers) {
1950 vcs_assign("authored lines", $total_lines, @blame_signers);
1953 foreach my $signer (@signers) {
1954 $signer = deduplicate_email($signer);
1956 vcs_assign("commits", $total_commits, @signers);
1958 foreach my $signer (@signers) {
1959 $signer = deduplicate_email($signer);
1961 vcs_assign("modified commits", $total_commits, @signers);
1969 @parms = grep(!$saw{$_}++, @parms);
1977 @parms = sort @parms;
1978 @parms = grep(!$saw{$_}++, @parms);
1982 sub clean_file_emails {
1983 my (@file_emails) = @_;
1984 my @fmt_emails = ();
1986 foreach my $email (@file_emails) {
1987 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1988 my ($name, $address) = parse_email($email);
1989 if ($name eq '"[,\.]"') {
1993 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1995 my $first = $nw[@nw - 3];
1996 my $middle = $nw[@nw - 2];
1997 my $last = $nw[@nw - 1];
1999 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2000 (length($first) == 2 && substr($first, -1) eq ".")) ||
2001 (length($middle) == 1 ||
2002 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2003 $name = "$first $middle $last";
2005 $name = "$middle $last";
2009 if (substr($name, -1) =~ /[,\.]/) {
2010 $name = substr($name, 0, length($name) - 1);
2011 } elsif (substr($name, -2) =~ /[,\.]"/) {
2012 $name = substr($name, 0, length($name) - 2) . '"';
2015 if (substr($name, 0, 1) =~ /[,\.]/) {
2016 $name = substr($name, 1, length($name) - 1);
2017 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2018 $name = '"' . substr($name, 2, length($name) - 2);
2021 my $fmt_email = format_email($name, $address, $email_usename);
2022 push(@fmt_emails, $fmt_email);
2032 my ($address, $role) = @$_;
2033 if (!$saw{$address}) {
2034 if ($output_roles) {
2035 push(@lines, "$address ($role)");
2037 push(@lines, $address);
2049 if ($output_multiline) {
2050 foreach my $line (@parms) {
2054 print(join($output_separator, @parms));
2062 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2063 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2064 # This regexp will only work on addresses which have had comments stripped
2065 # and replaced with rfc822_lwsp.
2067 my $specials = '()<>@,;:\\\\".\\[\\]';
2068 my $controls = '\\000-\\037\\177';
2070 my $dtext = "[^\\[\\]\\r\\\\]";
2071 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2073 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2075 # Use zero-width assertion to spot the limit of an atom. A simple
2076 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2077 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2078 my $word = "(?:$atom|$quoted_string)";
2079 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2081 my $sub_domain = "(?:$atom|$domain_literal)";
2082 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2084 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2086 my $phrase = "$word*";
2087 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2088 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2089 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2091 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2092 my $address = "(?:$mailbox|$group)";
2094 return "$rfc822_lwsp*$address";
2097 sub rfc822_strip_comments {
2099 # Recursively remove comments, and replace with a single space. The simpler
2100 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2101 # chars in atoms, for example.
2103 while ($s =~ s/^((?:[^"\\]|\\.)*
2104 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2105 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2109 # valid: returns true if the parameter is an RFC822 valid address
2112 my $s = rfc822_strip_comments(shift);
2115 $rfc822re = make_rfc822re();
2118 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2121 # validlist: In scalar context, returns true if the parameter is an RFC822
2122 # valid list of addresses.
2124 # In list context, returns an empty list on failure (an invalid
2125 # address was found); otherwise a list whose first element is the
2126 # number of addresses found and whose remaining elements are the
2127 # addresses. This is needed to disambiguate failure (invalid)
2128 # from success with no addresses found, because an empty string is
2131 sub rfc822_validlist {
2132 my $s = rfc822_strip_comments(shift);
2135 $rfc822re = make_rfc822re();
2137 # * null list items are valid according to the RFC
2138 # * the '1' business is to aid in distinguishing failure from no results
2141 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2142 $s =~ m/^$rfc822_char*$/) {
2143 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2146 return wantarray ? (scalar(@r), @r) : 1;
2148 return wantarray ? () : 0;