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 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
88 # rfc822 email address - preloaded methods go here.
89 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
90 my $rfc822_char = '[\\000-\\377]';
92 # VCS command support: class-like functions and strings
97 "execute_cmd" => \&git_execute_cmd,
98 "available" => '(which("git") ne "") && (-d ".git")',
100 "git log --no-color --follow --since=\$email_git_since " .
101 '--format="GitCommit: %H%n' .
102 'GitAuthor: %an <%ae>%n' .
107 "find_commit_signers_cmd" =>
108 "git log --no-color " .
109 '--format="GitCommit: %H%n' .
110 'GitAuthor: %an <%ae>%n' .
115 "find_commit_author_cmd" =>
116 "git log --no-color " .
117 '--format="GitCommit: %H%n' .
118 'GitAuthor: %an <%ae>%n' .
120 'GitSubject: %s%n"' .
122 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
123 "blame_file_cmd" => "git blame -l \$file",
124 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
125 "blame_commit_pattern" => "^([0-9a-f]+) ",
126 "author_pattern" => "^GitAuthor: (.*)",
127 "subject_pattern" => "^GitSubject: (.*)",
131 "execute_cmd" => \&hg_execute_cmd,
132 "available" => '(which("hg") ne "") && (-d ".hg")',
133 "find_signers_cmd" =>
134 "hg log --date=\$email_hg_since " .
135 "--template='HgCommit: {node}\\n" .
136 "HgAuthor: {author}\\n" .
137 "HgSubject: {desc}\\n'" .
139 "find_commit_signers_cmd" =>
141 "--template='HgSubject: {desc}\\n'" .
143 "find_commit_author_cmd" =>
145 "--template='HgCommit: {node}\\n" .
146 "HgAuthor: {author}\\n" .
147 "HgSubject: {desc|firstline}\\n'" .
149 "blame_range_cmd" => "", # not supported
150 "blame_file_cmd" => "hg blame -n \$file",
151 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
152 "blame_commit_pattern" => "^([ 0-9a-f]+):",
153 "author_pattern" => "^HgAuthor: (.*)",
154 "subject_pattern" => "^HgSubject: (.*)",
157 my $conf = which_conf(".get_maintainer.conf");
160 open(my $conffile, '<', "$conf")
161 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
163 while (<$conffile>) {
166 $line =~ s/\s*\n?$//g;
170 next if ($line =~ m/^\s*#/);
171 next if ($line =~ m/^\s*$/);
173 my @words = split(" ", $line);
174 foreach my $word (@words) {
175 last if ($word =~ m/^#/);
176 push (@conf_args, $word);
180 unshift(@ARGV, @conf_args) if @conf_args;
185 'git!' => \$email_git,
186 'git-all-signature-types!' => \$email_git_all_signature_types,
187 'git-blame!' => \$email_git_blame,
188 'git-blame-signatures!' => \$email_git_blame_signatures,
189 'git-fallback!' => \$email_git_fallback,
190 'git-chief-penguins!' => \$email_git_penguin_chiefs,
191 'git-min-signatures=i' => \$email_git_min_signatures,
192 'git-max-maintainers=i' => \$email_git_max_maintainers,
193 'git-min-percent=i' => \$email_git_min_percent,
194 'git-since=s' => \$email_git_since,
195 'hg-since=s' => \$email_hg_since,
196 'i|interactive!' => \$interactive,
197 'remove-duplicates!' => \$email_remove_duplicates,
198 'mailmap!' => \$email_use_mailmap,
199 'm!' => \$email_maintainer,
200 'n!' => \$email_usename,
201 'l!' => \$email_list,
202 's!' => \$email_subscriber_list,
203 'multiline!' => \$output_multiline,
204 'roles!' => \$output_roles,
205 'rolestats!' => \$output_rolestats,
206 'separator=s' => \$output_separator,
207 'subsystem!' => \$subsystem,
208 'status!' => \$status,
211 'pattern-depth=i' => \$pattern_depth,
212 'k|keywords!' => \$keywords,
213 'sections!' => \$sections,
214 'fe|file-emails!' => \$file_emails,
215 'f|file' => \$from_filename,
216 'v|version' => \$version,
217 'h|help|usage' => \$help,
219 die "$P: invalid argument - use --help if necessary\n";
228 print("${P} ${V}\n");
232 if (-t STDIN && !@ARGV) {
233 # We're talking to a terminal, but have no command line arguments.
234 die "$P: missing patchfile or -f file - use --help if necessary\n";
237 $output_multiline = 0 if ($output_separator ne ", ");
238 $output_rolestats = 1 if ($interactive);
239 $output_roles = 1 if ($output_rolestats);
251 my $selections = $email + $scm + $status + $subsystem + $web;
252 if ($selections == 0) {
253 die "$P: Missing required option: email, scm, status, subsystem or web\n";
258 ($email_maintainer + $email_list + $email_subscriber_list +
259 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
260 die "$P: Please select at least 1 email option\n";
263 if (!top_of_kernel_tree($lk_path)) {
264 die "$P: The current directory does not appear to be "
265 . "a linux kernel source tree.\n";
268 ## Read MAINTAINERS for type/value pairs
273 open (my $maint, '<', "${lk_path}MAINTAINERS")
274 or die "$P: Can't open MAINTAINERS: $!\n";
278 if ($line =~ m/^(\C):\s*(.*)/) {
282 ##Filename pattern matching
283 if ($type eq "F" || $type eq "X") {
284 $value =~ s@\.@\\\.@g; ##Convert . to \.
285 $value =~ s/\*/\.\*/g; ##Convert * to .*
286 $value =~ s/\?/\./g; ##Convert ? to .
287 ##if pattern is a directory and it lacks a trailing slash, add one
289 $value =~ s@([^/])$@$1/@;
291 } elsif ($type eq "K") {
292 $keyword_hash{@typevalue} = $value;
294 push(@typevalue, "$type:$value");
295 } elsif (!/^(\s)*$/) {
297 push(@typevalue, $line);
304 # Read mail address map
317 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
319 open(my $mailmap_file, '<', "${lk_path}.mailmap")
320 or warn "$P: Can't open .mailmap: $!\n";
322 while (<$mailmap_file>) {
323 s/#.*$//; #strip comments
324 s/^\s+|\s+$//g; #trim
326 next if (/^\s*$/); #skip empty lines
327 #entries have one of the following formats:
330 # name1 <mail1> <mail2>
331 # name1 <mail1> name2 <mail2>
332 # (see man git-shortlog)
334 if (/^([^<]+)<([^>]+)>$/) {
338 $real_name =~ s/\s+$//;
339 ($real_name, $address) = parse_email("$real_name <$address>");
340 $mailmap->{names}->{$address} = $real_name;
342 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
343 my $real_address = $1;
344 my $wrong_address = $2;
346 $mailmap->{addresses}->{$wrong_address} = $real_address;
348 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
350 my $real_address = $2;
351 my $wrong_address = $3;
353 $real_name =~ s/\s+$//;
354 ($real_name, $real_address) =
355 parse_email("$real_name <$real_address>");
356 $mailmap->{names}->{$wrong_address} = $real_name;
357 $mailmap->{addresses}->{$wrong_address} = $real_address;
359 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
361 my $real_address = $2;
363 my $wrong_address = $4;
365 $real_name =~ s/\s+$//;
366 ($real_name, $real_address) =
367 parse_email("$real_name <$real_address>");
369 $wrong_name =~ s/\s+$//;
370 ($wrong_name, $wrong_address) =
371 parse_email("$wrong_name <$wrong_address>");
373 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
374 $mailmap->{names}->{$wrong_email} = $real_name;
375 $mailmap->{addresses}->{$wrong_email} = $real_address;
378 close($mailmap_file);
381 ## use the filenames on the command line or find the filenames in the patchfiles
385 my @keyword_tvi = ();
386 my @file_emails = ();
389 push(@ARGV, "&STDIN");
392 foreach my $file (@ARGV) {
393 if ($file ne "&STDIN") {
394 ##if $file is a directory and it lacks a trailing slash, add one
396 $file =~ s@([^/])$@$1/@;
397 } elsif (!(-f $file)) {
398 die "$P: file '${file}' not found\n";
401 if ($from_filename) {
403 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
404 open(my $f, '<', $file)
405 or die "$P: Can't open $file: $!\n";
406 my $text = do { local($/) ; <$f> };
409 foreach my $line (keys %keyword_hash) {
410 if ($text =~ m/$keyword_hash{$line}/x) {
411 push(@keyword_tvi, $line);
416 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;
417 push(@file_emails, clean_file_emails(@poss_addr));
421 my $file_cnt = @files;
424 open(my $patch, "< $file")
425 or die "$P: Can't open $file: $!\n";
427 # We can check arbitrary information before the patch
428 # like the commit message, mail headers, etc...
429 # This allows us to match arbitrary keywords against any part
430 # of a git format-patch generated file (subject tags, etc...)
432 my $patch_prefix = ""; #Parsing the intro
436 if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
438 $filename =~ s@^[^/]*/@@;
440 $lastfile = $filename;
441 push(@files, $filename);
442 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
443 } elsif (m/^\@\@ -(\d+),(\d+)/) {
444 if ($email_git_blame) {
445 push(@range, "$lastfile:$1:$2");
447 } elsif ($keywords) {
448 foreach my $line (keys %keyword_hash) {
449 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
450 push(@keyword_tvi, $line);
457 if ($file_cnt == @files) {
458 warn "$P: file '${file}' doesn't appear to be a patch. "
459 . "Add -f to options?\n";
461 @files = sort_and_uniq(@files);
465 @file_emails = uniq(@file_emails);
468 my %email_hash_address;
476 my %deduplicate_name_hash = ();
477 my %deduplicate_address_hash = ();
479 my @maintainers = get_maintainers();
482 @maintainers = merge_email(@maintainers);
483 output(@maintainers);
492 @status = uniq(@status);
497 @subsystem = uniq(@subsystem);
508 sub range_is_maintained {
509 my ($start, $end) = @_;
511 for (my $i = $start; $i < $end; $i++) {
512 my $line = $typevalue[$i];
513 if ($line =~ m/^(\C):\s*(.*)/) {
517 if ($value =~ /(maintain|support)/i) {
526 sub range_has_maintainer {
527 my ($start, $end) = @_;
529 for (my $i = $start; $i < $end; $i++) {
530 my $line = $typevalue[$i];
531 if ($line =~ m/^(\C):\s*(.*)/) {
542 sub get_maintainers {
543 %email_hash_name = ();
544 %email_hash_address = ();
545 %commit_author_hash = ();
546 %commit_signer_hash = ();
554 %deduplicate_name_hash = ();
555 %deduplicate_address_hash = ();
556 if ($email_git_all_signature_types) {
557 $signature_pattern = "(.+?)[Bb][Yy]:";
559 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
562 # Find responsible parties
564 my %exact_pattern_match_hash = ();
566 foreach my $file (@files) {
569 my $tvi = find_first_section();
570 while ($tvi < @typevalue) {
571 my $start = find_starting_index($tvi);
572 my $end = find_ending_index($tvi);
576 #Do not match excluded file patterns
578 for ($i = $start; $i < $end; $i++) {
579 my $line = $typevalue[$i];
580 if ($line =~ m/^(\C):\s*(.*)/) {
584 if (file_match_pattern($file, $value)) {
593 for ($i = $start; $i < $end; $i++) {
594 my $line = $typevalue[$i];
595 if ($line =~ m/^(\C):\s*(.*)/) {
599 if (file_match_pattern($file, $value)) {
600 my $value_pd = ($value =~ tr@/@@);
601 my $file_pd = ($file =~ tr@/@@);
602 $value_pd++ if (substr($value,-1,1) ne "/");
603 $value_pd = -1 if ($value =~ /^\.\*/);
604 if ($value_pd >= $file_pd &&
605 range_is_maintained($start, $end) &&
606 range_has_maintainer($start, $end)) {
607 $exact_pattern_match_hash{$file} = 1;
609 if ($pattern_depth == 0 ||
610 (($file_pd - $value_pd) < $pattern_depth)) {
611 $hash{$tvi} = $value_pd;
614 } elsif ($type eq 'K') {
615 if ($file =~ m/$value/x) {
625 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
626 add_categories($line);
629 my $start = find_starting_index($line);
630 my $end = find_ending_index($line);
631 for ($i = $start; $i < $end; $i++) {
632 my $line = $typevalue[$i];
633 if ($line =~ /^[FX]:/) { ##Restore file patterns
634 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
635 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
636 $line =~ s/\\\./\./g; ##Convert \. to .
637 $line =~ s/\.\*/\*/g; ##Convert .* to *
639 $line =~ s/^([A-Z]):/$1:\t/g;
648 @keyword_tvi = sort_and_uniq(@keyword_tvi);
649 foreach my $line (@keyword_tvi) {
650 add_categories($line);
654 foreach my $email (@email_to, @list_to) {
655 $email->[0] = deduplicate_email($email->[0]);
658 foreach my $file (@files) {
660 ($email_git || ($email_git_fallback &&
661 !$exact_pattern_match_hash{$file}))) {
662 vcs_file_signoffs($file);
664 if ($email && $email_git_blame) {
665 vcs_file_blame($file);
670 foreach my $chief (@penguin_chief) {
671 if ($chief =~ m/^(.*):(.*)/) {
674 $email_address = format_email($1, $2, $email_usename);
675 if ($email_git_penguin_chiefs) {
676 push(@email_to, [$email_address, 'chief penguin']);
678 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
683 foreach my $email (@file_emails) {
684 my ($name, $address) = parse_email($email);
686 my $tmp_email = format_email($name, $address, $email_usename);
687 push_email_address($tmp_email, '');
688 add_role($tmp_email, 'in file');
693 if ($email || $email_list) {
695 @to = (@to, @email_to);
698 @to = (@to, @list_to);
703 @to = interactive_get_maintainers(\@to);
709 sub file_match_pattern {
710 my ($file, $pattern) = @_;
711 if (substr($pattern, -1) eq "/") {
712 if ($file =~ m@^$pattern@) {
716 if ($file =~ m@^$pattern@) {
717 my $s1 = ($file =~ tr@/@@);
718 my $s2 = ($pattern =~ tr@/@@);
729 usage: $P [options] patchfile
730 $P [options] -f file|directory
733 MAINTAINER field selection options:
734 --email => print email address(es) if any
735 --git => include recent git \*-by: signers
736 --git-all-signature-types => include signers regardless of signature type
737 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
738 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
739 --git-chief-penguins => include ${penguin_chiefs}
740 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
741 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
742 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
743 --git-blame => use git blame to find modified commits for patch or file
744 --git-since => git history to use (default: $email_git_since)
745 --hg-since => hg history to use (default: $email_hg_since)
746 --interactive => display a menu (mostly useful if used with the --git option)
747 --m => include maintainer(s) if any
748 --n => include name 'Full Name <addr\@domain.tld>'
749 --l => include list(s) if any
750 --s => include subscriber only list(s) if any
751 --remove-duplicates => minimize duplicate email names/addresses
752 --roles => show roles (status:subsystem, git-signer, list, etc...)
753 --rolestats => show roles and statistics (commits/total_commits, %)
754 --file-emails => add email addresses found in -f file (default: 0 (off))
755 --scm => print SCM tree(s) if any
756 --status => print status if any
757 --subsystem => print subsystem name if any
758 --web => print website(s) if any
761 --separator [, ] => separator for multiple entries on 1 line
762 using --separator also sets --nomultiline if --separator is not [, ]
763 --multiline => print 1 entry per line
766 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
767 --keywords => scan patch for keywords (default: $keywords)
768 --sections => print all of the subsystem sections with pattern matches
769 --mailmap => use .mailmap file (default: $email_use_mailmap)
770 --version => show version
771 --help => show this help information
774 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
775 --remove-duplicates --rolestats]
778 Using "-f directory" may give unexpected results:
779 Used with "--git", git signators for _all_ files in and below
780 directory are examined as git recurses directories.
781 Any specified X: (exclude) pattern matches are _not_ ignored.
782 Used with "--nogit", directory is used as a pattern match,
783 no individual file within the directory or subdirectory
785 Used with "--git-blame", does not iterate all files in directory
786 Using "--git-blame" is slow and may add old committers and authors
787 that are no longer active maintainers to the output.
788 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
789 other automated tools that expect only ["name"] <email address>
790 may not work because of additional output after <email address>.
791 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
792 not the percentage of the entire file authored. # of commits is
793 not a good measure of amount of code authored. 1 major commit may
794 contain a thousand lines, 5 trivial commits may modify a single line.
795 If git is not installed, but mercurial (hg) is installed and an .hg
796 repository exists, the following options apply to mercurial:
798 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
800 Use --hg-since not --git-since to control date selection
801 File ".get_maintainer.conf", if it exists in the linux kernel source root
802 directory, can change whatever get_maintainer defaults are desired.
803 Entries in this file can be any command line argument.
804 This file is prepended to any additional command line arguments.
805 Multiple lines and # comments are allowed.
809 sub top_of_kernel_tree {
812 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
815 if ( (-f "${lk_path}COPYING")
816 && (-f "${lk_path}CREDITS")
817 && (-f "${lk_path}Kbuild")
818 && (-f "${lk_path}MAINTAINERS")
819 && (-f "${lk_path}Makefile")
820 && (-f "${lk_path}README")
821 && (-d "${lk_path}Documentation")
822 && (-d "${lk_path}arch")
823 && (-d "${lk_path}include")
824 && (-d "${lk_path}drivers")
825 && (-d "${lk_path}fs")
826 && (-d "${lk_path}init")
827 && (-d "${lk_path}ipc")
828 && (-d "${lk_path}kernel")
829 && (-d "${lk_path}lib")
830 && (-d "${lk_path}scripts")) {
837 my ($formatted_email) = @_;
842 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
845 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
847 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
851 $name =~ s/^\s+|\s+$//g;
852 $name =~ s/^\"|\"$//g;
853 $address =~ s/^\s+|\s+$//g;
855 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
856 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
860 return ($name, $address);
864 my ($name, $address, $usename) = @_;
868 $name =~ s/^\s+|\s+$//g;
869 $name =~ s/^\"|\"$//g;
870 $address =~ s/^\s+|\s+$//g;
872 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
873 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
879 $formatted_email = "$address";
881 $formatted_email = "$name <$address>";
884 $formatted_email = $address;
887 return $formatted_email;
890 sub find_first_section {
893 while ($index < @typevalue) {
894 my $tv = $typevalue[$index];
895 if (($tv =~ m/^(\C):\s*(.*)/)) {
904 sub find_starting_index {
908 my $tv = $typevalue[$index];
909 if (!($tv =~ m/^(\C):\s*(.*)/)) {
918 sub find_ending_index {
921 while ($index < @typevalue) {
922 my $tv = $typevalue[$index];
923 if (!($tv =~ m/^(\C):\s*(.*)/)) {
932 sub get_maintainer_role {
936 my $start = find_starting_index($index);
937 my $end = find_ending_index($index);
939 my $role = "unknown";
940 my $subsystem = $typevalue[$start];
941 if (length($subsystem) > 20) {
942 $subsystem = substr($subsystem, 0, 17);
943 $subsystem =~ s/\s*$//;
944 $subsystem = $subsystem . "...";
947 for ($i = $start + 1; $i < $end; $i++) {
948 my $tv = $typevalue[$i];
949 if ($tv =~ m/^(\C):\s*(.*)/) {
959 if ($role eq "supported") {
961 } elsif ($role eq "maintained") {
962 $role = "maintainer";
963 } elsif ($role eq "odd fixes") {
965 } elsif ($role eq "orphan") {
966 $role = "orphan minder";
967 } elsif ($role eq "obsolete") {
968 $role = "obsolete minder";
969 } elsif ($role eq "buried alive in reporters") {
970 $role = "chief penguin";
973 return $role . ":" . $subsystem;
980 my $start = find_starting_index($index);
981 my $end = find_ending_index($index);
983 my $subsystem = $typevalue[$start];
984 if (length($subsystem) > 20) {
985 $subsystem = substr($subsystem, 0, 17);
986 $subsystem =~ s/\s*$//;
987 $subsystem = $subsystem . "...";
990 if ($subsystem eq "THE REST") {
1001 my $start = find_starting_index($index);
1002 my $end = find_ending_index($index);
1004 push(@subsystem, $typevalue[$start]);
1006 for ($i = $start + 1; $i < $end; $i++) {
1007 my $tv = $typevalue[$i];
1008 if ($tv =~ m/^(\C):\s*(.*)/) {
1011 if ($ptype eq "L") {
1012 my $list_address = $pvalue;
1013 my $list_additional = "";
1014 my $list_role = get_list_role($i);
1016 if ($list_role ne "") {
1017 $list_role = ":" . $list_role;
1019 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1021 $list_additional = $2;
1023 if ($list_additional =~ m/subscribers-only/) {
1024 if ($email_subscriber_list) {
1025 if (!$hash_list_to{lc($list_address)}) {
1026 $hash_list_to{lc($list_address)} = 1;
1027 push(@list_to, [$list_address,
1028 "subscriber list${list_role}"]);
1033 if (!$hash_list_to{lc($list_address)}) {
1034 $hash_list_to{lc($list_address)} = 1;
1035 if ($list_additional =~ m/moderated/) {
1036 push(@list_to, [$list_address,
1037 "moderated list${list_role}"]);
1039 push(@list_to, [$list_address,
1040 "open list${list_role}"]);
1045 } elsif ($ptype eq "M") {
1046 my ($name, $address) = parse_email($pvalue);
1049 my $tv = $typevalue[$i - 1];
1050 if ($tv =~ m/^(\C):\s*(.*)/) {
1053 $pvalue = format_email($name, $address, $email_usename);
1058 if ($email_maintainer) {
1059 my $role = get_maintainer_role($i);
1060 push_email_addresses($pvalue, $role);
1062 } elsif ($ptype eq "T") {
1063 push(@scm, $pvalue);
1064 } elsif ($ptype eq "W") {
1065 push(@web, $pvalue);
1066 } elsif ($ptype eq "S") {
1067 push(@status, $pvalue);
1074 my ($name, $address) = @_;
1076 return 1 if (($name eq "") && ($address eq ""));
1077 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1078 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1083 sub push_email_address {
1084 my ($line, $role) = @_;
1086 my ($name, $address) = parse_email($line);
1088 if ($address eq "") {
1092 if (!$email_remove_duplicates) {
1093 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1094 } elsif (!email_inuse($name, $address)) {
1095 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1096 $email_hash_name{lc($name)}++ if ($name ne "");
1097 $email_hash_address{lc($address)}++;
1103 sub push_email_addresses {
1104 my ($address, $role) = @_;
1106 my @address_list = ();
1108 if (rfc822_valid($address)) {
1109 push_email_address($address, $role);
1110 } elsif (@address_list = rfc822_validlist($address)) {
1111 my $array_count = shift(@address_list);
1112 while (my $entry = shift(@address_list)) {
1113 push_email_address($entry, $role);
1116 if (!push_email_address($address, $role)) {
1117 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1123 my ($line, $role) = @_;
1125 my ($name, $address) = parse_email($line);
1126 my $email = format_email($name, $address, $email_usename);
1128 foreach my $entry (@email_to) {
1129 if ($email_remove_duplicates) {
1130 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1131 if (($name eq $entry_name || $address eq $entry_address)
1132 && ($role eq "" || !($entry->[1] =~ m/$role/))
1134 if ($entry->[1] eq "") {
1135 $entry->[1] = "$role";
1137 $entry->[1] = "$entry->[1],$role";
1141 if ($email eq $entry->[0]
1142 && ($role eq "" || !($entry->[1] =~ m/$role/))
1144 if ($entry->[1] eq "") {
1145 $entry->[1] = "$role";
1147 $entry->[1] = "$entry->[1],$role";
1157 foreach my $path (split(/:/, $ENV{PATH})) {
1158 if (-e "$path/$bin") {
1159 return "$path/$bin";
1169 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1170 if (-e "$path/$conf") {
1171 return "$path/$conf";
1181 my ($name, $address) = parse_email($line);
1182 my $email = format_email($name, $address, 1);
1183 my $real_name = $name;
1184 my $real_address = $address;
1186 if (exists $mailmap->{names}->{$email} ||
1187 exists $mailmap->{addresses}->{$email}) {
1188 if (exists $mailmap->{names}->{$email}) {
1189 $real_name = $mailmap->{names}->{$email};
1191 if (exists $mailmap->{addresses}->{$email}) {
1192 $real_address = $mailmap->{addresses}->{$email};
1195 if (exists $mailmap->{names}->{$address}) {
1196 $real_name = $mailmap->{names}->{$address};
1198 if (exists $mailmap->{addresses}->{$address}) {
1199 $real_address = $mailmap->{addresses}->{$address};
1202 return format_email($real_name, $real_address, 1);
1206 my (@addresses) = @_;
1208 my @mapped_emails = ();
1209 foreach my $line (@addresses) {
1210 push(@mapped_emails, mailmap_email($line));
1212 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1213 return @mapped_emails;
1216 sub merge_by_realname {
1220 foreach my $email (@emails) {
1221 my ($name, $address) = parse_email($email);
1222 if (exists $address_map{$name}) {
1223 $address = $address_map{$name};
1224 $email = format_email($name, $address, 1);
1226 $address_map{$name} = $address;
1231 sub git_execute_cmd {
1235 my $output = `$cmd`;
1236 $output =~ s/^\s*//gm;
1237 @lines = split("\n", $output);
1242 sub hg_execute_cmd {
1246 my $output = `$cmd`;
1247 @lines = split("\n", $output);
1252 sub extract_formatted_signatures {
1253 my (@signature_lines) = @_;
1255 my @type = @signature_lines;
1257 s/\s*(.*):.*/$1/ for (@type);
1260 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1262 ## Reformat email addresses (with names) to avoid badly written signatures
1264 foreach my $signer (@signature_lines) {
1265 $signer = deduplicate_email($signer);
1268 return (\@type, \@signature_lines);
1271 sub vcs_find_signers {
1275 my @signatures = ();
1277 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1279 my $pattern = $VCS_cmds{"commit_pattern"};
1281 $commits = grep(/$pattern/, @lines); # of commits
1283 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1285 return (0, @signatures) if !@signatures;
1287 save_commits_by_author(@lines) if ($interactive);
1288 save_commits_by_signer(@lines) if ($interactive);
1290 if (!$email_git_penguin_chiefs) {
1291 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1294 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1296 return ($commits, @$signers_ref);
1299 sub vcs_find_author {
1303 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1305 if (!$email_git_penguin_chiefs) {
1306 @lines = grep(!/${penguin_chiefs}/i, @lines);
1309 return @lines if !@lines;
1312 foreach my $line (@lines) {
1313 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1315 my ($name, $address) = parse_email($author);
1316 $author = format_email($name, $address, 1);
1317 push(@authors, $author);
1321 save_commits_by_author(@lines) if ($interactive);
1322 save_commits_by_signer(@lines) if ($interactive);
1327 sub vcs_save_commits {
1332 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1334 foreach my $line (@lines) {
1335 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1348 return @commits if (!(-f $file));
1350 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1351 my @all_commits = ();
1353 $cmd = $VCS_cmds{"blame_file_cmd"};
1354 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1355 @all_commits = vcs_save_commits($cmd);
1357 foreach my $file_range_diff (@range) {
1358 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1360 my $diff_start = $2;
1361 my $diff_length = $3;
1362 next if ("$file" ne "$diff_file");
1363 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1364 push(@commits, $all_commits[$i]);
1368 foreach my $file_range_diff (@range) {
1369 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1371 my $diff_start = $2;
1372 my $diff_length = $3;
1373 next if ("$file" ne "$diff_file");
1374 $cmd = $VCS_cmds{"blame_range_cmd"};
1375 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1376 push(@commits, vcs_save_commits($cmd));
1379 $cmd = $VCS_cmds{"blame_file_cmd"};
1380 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1381 @commits = vcs_save_commits($cmd);
1384 foreach my $commit (@commits) {
1385 $commit =~ s/^\^//g;
1391 my $printed_novcs = 0;
1393 %VCS_cmds = %VCS_cmds_git;
1394 return 1 if eval $VCS_cmds{"available"};
1395 %VCS_cmds = %VCS_cmds_hg;
1396 return 2 if eval $VCS_cmds{"available"};
1398 if (!$printed_novcs) {
1399 warn("$P: No supported VCS found. Add --nogit to options?\n");
1400 warn("Using a git repository produces better results.\n");
1401 warn("Try Linus Torvalds' latest git repository using:\n");
1402 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1410 return $vcs_used == 1;
1414 return $vcs_used == 2;
1417 sub interactive_get_maintainers {
1418 my ($list_ref) = @_;
1419 my @list = @$list_ref;
1428 foreach my $entry (@list) {
1429 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1430 $selected{$count} = 1;
1431 $authored{$count} = 0;
1432 $signed{$count} = 0;
1438 my $print_options = 0;
1443 printf STDERR "\n%1s %2s %-65s",
1444 "*", "#", "email/list and role:stats";
1446 ($email_git_fallback && !$maintained) ||
1448 print STDERR "auth sign";
1451 foreach my $entry (@list) {
1452 my $email = $entry->[0];
1453 my $role = $entry->[1];
1455 $sel = "*" if ($selected{$count});
1456 my $commit_author = $commit_author_hash{$email};
1457 my $commit_signer = $commit_signer_hash{$email};
1460 $authored++ for (@{$commit_author});
1461 $signed++ for (@{$commit_signer});
1462 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1463 printf STDERR "%4d %4d", $authored, $signed
1464 if ($authored > 0 || $signed > 0);
1465 printf STDERR "\n %s\n", $role;
1466 if ($authored{$count}) {
1467 my $commit_author = $commit_author_hash{$email};
1468 foreach my $ref (@{$commit_author}) {
1469 print STDERR " Author: @{$ref}[1]\n";
1472 if ($signed{$count}) {
1473 my $commit_signer = $commit_signer_hash{$email};
1474 foreach my $ref (@{$commit_signer}) {
1475 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1482 my $date_ref = \$email_git_since;
1483 $date_ref = \$email_hg_since if (vcs_is_hg());
1484 if ($print_options) {
1489 Version Control options:
1490 g use git history [$email_git]
1491 gf use git-fallback [$email_git_fallback]
1492 b use git blame [$email_git_blame]
1493 bs use blame signatures [$email_git_blame_signatures]
1494 c# minimum commits [$email_git_min_signatures]
1495 %# min percent [$email_git_min_percent]
1496 d# history to use [$$date_ref]
1497 x# max maintainers [$email_git_max_maintainers]
1498 t all signature types [$email_git_all_signature_types]
1499 m use .mailmap [$email_use_mailmap]
1506 tm toggle maintainers
1507 tg toggle git entries
1508 tl toggle open list entries
1509 ts toggle subscriber list entries
1510 f emails in file [$file_emails]
1511 k keywords in file [$keywords]
1512 r remove duplicates [$email_remove_duplicates]
1513 p# pattern match depth [$pattern_depth]
1517 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1519 my $input = <STDIN>;
1524 my @wish = split(/[, ]+/, $input);
1525 foreach my $nr (@wish) {
1527 my $sel = substr($nr, 0, 1);
1528 my $str = substr($nr, 1);
1530 $val = $1 if $str =~ /^(\d+)$/;
1535 $output_rolestats = 0;
1538 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1539 $selected{$nr - 1} = !$selected{$nr - 1};
1540 } elsif ($sel eq "*" || $sel eq '^') {
1542 $toggle = 1 if ($sel eq '*');
1543 for (my $i = 0; $i < $count; $i++) {
1544 $selected{$i} = $toggle;
1546 } elsif ($sel eq "0") {
1547 for (my $i = 0; $i < $count; $i++) {
1548 $selected{$i} = !$selected{$i};
1550 } elsif ($sel eq "t") {
1551 if (lc($str) eq "m") {
1552 for (my $i = 0; $i < $count; $i++) {
1553 $selected{$i} = !$selected{$i}
1554 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1556 } elsif (lc($str) eq "g") {
1557 for (my $i = 0; $i < $count; $i++) {
1558 $selected{$i} = !$selected{$i}
1559 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1561 } elsif (lc($str) eq "l") {
1562 for (my $i = 0; $i < $count; $i++) {
1563 $selected{$i} = !$selected{$i}
1564 if ($list[$i]->[1] =~ /^(open list)/i);
1566 } elsif (lc($str) eq "s") {
1567 for (my $i = 0; $i < $count; $i++) {
1568 $selected{$i} = !$selected{$i}
1569 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1572 } elsif ($sel eq "a") {
1573 if ($val > 0 && $val <= $count) {
1574 $authored{$val - 1} = !$authored{$val - 1};
1575 } elsif ($str eq '*' || $str eq '^') {
1577 $toggle = 1 if ($str eq '*');
1578 for (my $i = 0; $i < $count; $i++) {
1579 $authored{$i} = $toggle;
1582 } elsif ($sel eq "s") {
1583 if ($val > 0 && $val <= $count) {
1584 $signed{$val - 1} = !$signed{$val - 1};
1585 } elsif ($str eq '*' || $str eq '^') {
1587 $toggle = 1 if ($str eq '*');
1588 for (my $i = 0; $i < $count; $i++) {
1589 $signed{$i} = $toggle;
1592 } elsif ($sel eq "o") {
1595 } elsif ($sel eq "g") {
1597 bool_invert(\$email_git_fallback);
1599 bool_invert(\$email_git);
1602 } elsif ($sel eq "b") {
1604 bool_invert(\$email_git_blame_signatures);
1606 bool_invert(\$email_git_blame);
1609 } elsif ($sel eq "c") {
1611 $email_git_min_signatures = $val;
1614 } elsif ($sel eq "x") {
1616 $email_git_max_maintainers = $val;
1619 } elsif ($sel eq "%") {
1620 if ($str ne "" && $val >= 0) {
1621 $email_git_min_percent = $val;
1624 } elsif ($sel eq "d") {
1626 $email_git_since = $str;
1627 } elsif (vcs_is_hg()) {
1628 $email_hg_since = $str;
1631 } elsif ($sel eq "t") {
1632 bool_invert(\$email_git_all_signature_types);
1634 } elsif ($sel eq "f") {
1635 bool_invert(\$file_emails);
1637 } elsif ($sel eq "r") {
1638 bool_invert(\$email_remove_duplicates);
1640 } elsif ($sel eq "m") {
1641 bool_invert(\$email_use_mailmap);
1644 } elsif ($sel eq "k") {
1645 bool_invert(\$keywords);
1647 } elsif ($sel eq "p") {
1648 if ($str ne "" && $val >= 0) {
1649 $pattern_depth = $val;
1652 } elsif ($sel eq "h" || $sel eq "?") {
1655 Interactive mode allows you to select the various maintainers, submitters,
1656 commit signers and mailing lists that could be CC'd on a patch.
1658 Any *'d entry is selected.
1660 If you have git or hg installed, you can choose to summarize the commit
1661 history of files in the patch. Also, each line of the current file can
1662 be matched to its commit author and that commits signers with blame.
1664 Various knobs exist to control the length of time for active commit
1665 tracking, the maximum number of commit authors and signers to add,
1668 Enter selections at the prompt until you are satisfied that the selected
1669 maintainers are appropriate. You may enter multiple selections separated
1670 by either commas or spaces.
1674 print STDERR "invalid option: '$nr'\n";
1679 print STDERR "git-blame can be very slow, please have patience..."
1680 if ($email_git_blame);
1681 goto &get_maintainers;
1685 #drop not selected entries
1687 my @new_emailto = ();
1688 foreach my $entry (@list) {
1689 if ($selected{$count}) {
1690 push(@new_emailto, $list[$count]);
1694 return @new_emailto;
1698 my ($bool_ref) = @_;
1707 sub deduplicate_email {
1711 my ($name, $address) = parse_email($email);
1712 $email = format_email($name, $address, 1);
1713 $email = mailmap_email($email);
1715 return $email if (!$email_remove_duplicates);
1717 ($name, $address) = parse_email($email);
1719 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1720 $name = $deduplicate_name_hash{lc($name)}->[0];
1721 $address = $deduplicate_name_hash{lc($name)}->[1];
1723 } elsif ($deduplicate_address_hash{lc($address)}) {
1724 $name = $deduplicate_address_hash{lc($address)}->[0];
1725 $address = $deduplicate_address_hash{lc($address)}->[1];
1729 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1730 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1732 $email = format_email($name, $address, 1);
1733 $email = mailmap_email($email);
1737 sub save_commits_by_author {
1744 foreach my $line (@lines) {
1745 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1747 $author = deduplicate_email($author);
1748 push(@authors, $author);
1750 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1751 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1754 for (my $i = 0; $i < @authors; $i++) {
1756 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1757 if (@{$ref}[0] eq $commits[$i] &&
1758 @{$ref}[1] eq $subjects[$i]) {
1764 push(@{$commit_author_hash{$authors[$i]}},
1765 [ ($commits[$i], $subjects[$i]) ]);
1770 sub save_commits_by_signer {
1776 foreach my $line (@lines) {
1777 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1778 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1779 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1780 my @signatures = ($line);
1781 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1782 my @types = @$types_ref;
1783 my @signers = @$signers_ref;
1785 my $type = $types[0];
1786 my $signer = $signers[0];
1788 $signer = deduplicate_email($signer);
1791 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1792 if (@{$ref}[0] eq $commit &&
1793 @{$ref}[1] eq $subject &&
1794 @{$ref}[2] eq $type) {
1800 push(@{$commit_signer_hash{$signer}},
1801 [ ($commit, $subject, $type) ]);
1808 my ($role, $divisor, @lines) = @_;
1813 return if (@lines <= 0);
1815 if ($divisor <= 0) {
1816 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1820 @lines = mailmap(@lines);
1822 return if (@lines <= 0);
1824 @lines = sort(@lines);
1827 $hash{$_}++ for @lines;
1830 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1831 my $sign_offs = $hash{$line};
1832 my $percent = $sign_offs * 100 / $divisor;
1834 $percent = 100 if ($percent > 100);
1836 last if ($sign_offs < $email_git_min_signatures ||
1837 $count > $email_git_max_maintainers ||
1838 $percent < $email_git_min_percent);
1839 push_email_address($line, '');
1840 if ($output_rolestats) {
1841 my $fmt_percent = sprintf("%.0f", $percent);
1842 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1844 add_role($line, $role);
1849 sub vcs_file_signoffs {
1855 $vcs_used = vcs_exists();
1856 return if (!$vcs_used);
1858 my $cmd = $VCS_cmds{"find_signers_cmd"};
1859 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1861 ($commits, @signers) = vcs_find_signers($cmd);
1863 foreach my $signer (@signers) {
1864 $signer = deduplicate_email($signer);
1867 vcs_assign("commit_signer", $commits, @signers);
1870 sub vcs_file_blame {
1874 my @all_commits = ();
1879 $vcs_used = vcs_exists();
1880 return if (!$vcs_used);
1882 @all_commits = vcs_blame($file);
1883 @commits = uniq(@all_commits);
1884 $total_commits = @commits;
1885 $total_lines = @all_commits;
1887 if ($email_git_blame_signatures) {
1890 my @commit_signers = ();
1891 my $commit = join(" -r ", @commits);
1894 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1895 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1897 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1899 push(@signers, @commit_signers);
1901 foreach my $commit (@commits) {
1903 my @commit_signers = ();
1906 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1907 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1909 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1911 push(@signers, @commit_signers);
1916 if ($from_filename) {
1917 if ($output_rolestats) {
1919 if (vcs_is_hg()) {{ # Double brace for last exit
1921 my @commit_signers = ();
1922 @commits = uniq(@commits);
1923 @commits = sort(@commits);
1924 my $commit = join(" -r ", @commits);
1927 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1928 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1932 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1934 if (!$email_git_penguin_chiefs) {
1935 @lines = grep(!/${penguin_chiefs}/i, @lines);
1941 foreach my $line (@lines) {
1942 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1944 $author = deduplicate_email($author);
1945 push(@authors, $author);
1949 save_commits_by_author(@lines) if ($interactive);
1950 save_commits_by_signer(@lines) if ($interactive);
1952 push(@signers, @authors);
1955 foreach my $commit (@commits) {
1957 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1958 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1959 my @author = vcs_find_author($cmd);
1962 my $formatted_author = deduplicate_email($author[0]);
1964 my $count = grep(/$commit/, @all_commits);
1965 for ($i = 0; $i < $count ; $i++) {
1966 push(@blame_signers, $formatted_author);
1970 if (@blame_signers) {
1971 vcs_assign("authored lines", $total_lines, @blame_signers);
1974 foreach my $signer (@signers) {
1975 $signer = deduplicate_email($signer);
1977 vcs_assign("commits", $total_commits, @signers);
1979 foreach my $signer (@signers) {
1980 $signer = deduplicate_email($signer);
1982 vcs_assign("modified commits", $total_commits, @signers);
1990 @parms = grep(!$saw{$_}++, @parms);
1998 @parms = sort @parms;
1999 @parms = grep(!$saw{$_}++, @parms);
2003 sub clean_file_emails {
2004 my (@file_emails) = @_;
2005 my @fmt_emails = ();
2007 foreach my $email (@file_emails) {
2008 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2009 my ($name, $address) = parse_email($email);
2010 if ($name eq '"[,\.]"') {
2014 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2016 my $first = $nw[@nw - 3];
2017 my $middle = $nw[@nw - 2];
2018 my $last = $nw[@nw - 1];
2020 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2021 (length($first) == 2 && substr($first, -1) eq ".")) ||
2022 (length($middle) == 1 ||
2023 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2024 $name = "$first $middle $last";
2026 $name = "$middle $last";
2030 if (substr($name, -1) =~ /[,\.]/) {
2031 $name = substr($name, 0, length($name) - 1);
2032 } elsif (substr($name, -2) =~ /[,\.]"/) {
2033 $name = substr($name, 0, length($name) - 2) . '"';
2036 if (substr($name, 0, 1) =~ /[,\.]/) {
2037 $name = substr($name, 1, length($name) - 1);
2038 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2039 $name = '"' . substr($name, 2, length($name) - 2);
2042 my $fmt_email = format_email($name, $address, $email_usename);
2043 push(@fmt_emails, $fmt_email);
2053 my ($address, $role) = @$_;
2054 if (!$saw{$address}) {
2055 if ($output_roles) {
2056 push(@lines, "$address ($role)");
2058 push(@lines, $address);
2070 if ($output_multiline) {
2071 foreach my $line (@parms) {
2075 print(join($output_separator, @parms));
2083 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2084 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2085 # This regexp will only work on addresses which have had comments stripped
2086 # and replaced with rfc822_lwsp.
2088 my $specials = '()<>@,;:\\\\".\\[\\]';
2089 my $controls = '\\000-\\037\\177';
2091 my $dtext = "[^\\[\\]\\r\\\\]";
2092 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2094 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2096 # Use zero-width assertion to spot the limit of an atom. A simple
2097 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2098 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2099 my $word = "(?:$atom|$quoted_string)";
2100 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2102 my $sub_domain = "(?:$atom|$domain_literal)";
2103 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2105 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2107 my $phrase = "$word*";
2108 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2109 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2110 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2112 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2113 my $address = "(?:$mailbox|$group)";
2115 return "$rfc822_lwsp*$address";
2118 sub rfc822_strip_comments {
2120 # Recursively remove comments, and replace with a single space. The simpler
2121 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2122 # chars in atoms, for example.
2124 while ($s =~ s/^((?:[^"\\]|\\.)*
2125 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2126 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2130 # valid: returns true if the parameter is an RFC822 valid address
2133 my $s = rfc822_strip_comments(shift);
2136 $rfc822re = make_rfc822re();
2139 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2142 # validlist: In scalar context, returns true if the parameter is an RFC822
2143 # valid list of addresses.
2145 # In list context, returns an empty list on failure (an invalid
2146 # address was found); otherwise a list whose first element is the
2147 # number of addresses found and whose remaining elements are the
2148 # addresses. This is needed to disambiguate failure (invalid)
2149 # from success with no addresses found, because an empty string is
2152 sub rfc822_validlist {
2153 my $s = rfc822_strip_comments(shift);
2156 $rfc822re = make_rfc822re();
2158 # * null list items are valid according to the RFC
2159 # * the '1' business is to aid in distinguishing failure from no results
2162 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2163 $s =~ m/^$rfc822_char*$/) {
2164 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2167 return wantarray ? (scalar(@r), @r) : 1;
2169 return wantarray ? () : 0;