vmdk: Fix converting to streamOptimized
[qemu/ar7.git] / scripts / get_maintainer.pl
blob7dacf32f435cd0380eb40256db92c6def699aec3
1 #!/usr/bin/perl -w
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
13 use strict;
15 my $P = $0;
16 my $V = '0.26';
18 use Getopt::Long qw(:config no_auto_abbrev);
20 my $lk_path = "./";
21 my $email = 1;
22 my $email_usename = 1;
23 my $email_maintainer = 1;
24 my $email_list = 1;
25 my $email_subscriber_list = 0;
26 my $email_git = 0;
27 my $email_git_all_signature_types = 0;
28 my $email_git_blame = 0;
29 my $email_git_blame_signatures = 1;
30 my $email_git_fallback = 1;
31 my $email_git_min_signatures = 1;
32 my $email_git_max_maintainers = 5;
33 my $email_git_min_percent = 5;
34 my $email_git_since = "1-year-ago";
35 my $email_hg_since = "-365";
36 my $interactive = 0;
37 my $email_remove_duplicates = 1;
38 my $email_use_mailmap = 1;
39 my $output_multiline = 1;
40 my $output_separator = ", ";
41 my $output_roles = 0;
42 my $output_rolestats = 1;
43 my $scm = 0;
44 my $web = 0;
45 my $subsystem = 0;
46 my $status = 0;
47 my $keywords = 1;
48 my $sections = 0;
49 my $file_emails = 0;
50 my $from_filename = 0;
51 my $pattern_depth = 0;
52 my $version = 0;
53 my $help = 0;
55 my $vcs_used = 0;
57 my $exit = 0;
59 my %commit_author_hash;
60 my %commit_signer_hash;
62 # Signature types of people who are either
63 # a) responsible for the code in question, or
64 # b) familiar enough with it to give relevant feedback
65 my @signature_tags = ();
66 push(@signature_tags, "Signed-off-by:");
67 push(@signature_tags, "Reviewed-by:");
68 push(@signature_tags, "Acked-by:");
70 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
72 # rfc822 email address - preloaded methods go here.
73 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
74 my $rfc822_char = '[\\000-\\377]';
76 # VCS command support: class-like functions and strings
78 my %VCS_cmds;
80 my %VCS_cmds_git = (
81 "execute_cmd" => \&git_execute_cmd,
82 "available" => '(which("git") ne "") && (-d ".git")',
83 "find_signers_cmd" =>
84 "git log --no-color --follow --since=\$email_git_since " .
85 '--format="GitCommit: %H%n' .
86 'GitAuthor: %an <%ae>%n' .
87 'GitDate: %aD%n' .
88 'GitSubject: %s%n' .
89 '%b%n"' .
90 " -- \$file",
91 "find_commit_signers_cmd" =>
92 "git log --no-color " .
93 '--format="GitCommit: %H%n' .
94 'GitAuthor: %an <%ae>%n' .
95 'GitDate: %aD%n' .
96 'GitSubject: %s%n' .
97 '%b%n"' .
98 " -1 \$commit",
99 "find_commit_author_cmd" =>
100 "git log --no-color " .
101 '--format="GitCommit: %H%n' .
102 'GitAuthor: %an <%ae>%n' .
103 'GitDate: %aD%n' .
104 'GitSubject: %s%n"' .
105 " -1 \$commit",
106 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
107 "blame_file_cmd" => "git blame -l \$file",
108 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
109 "blame_commit_pattern" => "^([0-9a-f]+) ",
110 "author_pattern" => "^GitAuthor: (.*)",
111 "subject_pattern" => "^GitSubject: (.*)",
114 my %VCS_cmds_hg = (
115 "execute_cmd" => \&hg_execute_cmd,
116 "available" => '(which("hg") ne "") && (-d ".hg")',
117 "find_signers_cmd" =>
118 "hg log --date=\$email_hg_since " .
119 "--template='HgCommit: {node}\\n" .
120 "HgAuthor: {author}\\n" .
121 "HgSubject: {desc}\\n'" .
122 " -- \$file",
123 "find_commit_signers_cmd" =>
124 "hg log " .
125 "--template='HgSubject: {desc}\\n'" .
126 " -r \$commit",
127 "find_commit_author_cmd" =>
128 "hg log " .
129 "--template='HgCommit: {node}\\n" .
130 "HgAuthor: {author}\\n" .
131 "HgSubject: {desc|firstline}\\n'" .
132 " -r \$commit",
133 "blame_range_cmd" => "", # not supported
134 "blame_file_cmd" => "hg blame -n \$file",
135 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
136 "blame_commit_pattern" => "^([ 0-9a-f]+):",
137 "author_pattern" => "^HgAuthor: (.*)",
138 "subject_pattern" => "^HgSubject: (.*)",
141 my $conf = which_conf(".get_maintainer.conf");
142 if (-f $conf) {
143 my @conf_args;
144 open(my $conffile, '<', "$conf")
145 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
147 while (<$conffile>) {
148 my $line = $_;
150 $line =~ s/\s*\n?$//g;
151 $line =~ s/^\s*//g;
152 $line =~ s/\s+/ /g;
154 next if ($line =~ m/^\s*#/);
155 next if ($line =~ m/^\s*$/);
157 my @words = split(" ", $line);
158 foreach my $word (@words) {
159 last if ($word =~ m/^#/);
160 push (@conf_args, $word);
163 close($conffile);
164 unshift(@ARGV, @conf_args) if @conf_args;
167 if (!GetOptions(
168 'email!' => \$email,
169 'git!' => \$email_git,
170 'git-all-signature-types!' => \$email_git_all_signature_types,
171 'git-blame!' => \$email_git_blame,
172 'git-blame-signatures!' => \$email_git_blame_signatures,
173 'git-fallback!' => \$email_git_fallback,
174 'git-min-signatures=i' => \$email_git_min_signatures,
175 'git-max-maintainers=i' => \$email_git_max_maintainers,
176 'git-min-percent=i' => \$email_git_min_percent,
177 'git-since=s' => \$email_git_since,
178 'hg-since=s' => \$email_hg_since,
179 'i|interactive!' => \$interactive,
180 'remove-duplicates!' => \$email_remove_duplicates,
181 'mailmap!' => \$email_use_mailmap,
182 'm!' => \$email_maintainer,
183 'n!' => \$email_usename,
184 'l!' => \$email_list,
185 's!' => \$email_subscriber_list,
186 'multiline!' => \$output_multiline,
187 'roles!' => \$output_roles,
188 'rolestats!' => \$output_rolestats,
189 'separator=s' => \$output_separator,
190 'subsystem!' => \$subsystem,
191 'status!' => \$status,
192 'scm!' => \$scm,
193 'web!' => \$web,
194 'pattern-depth=i' => \$pattern_depth,
195 'k|keywords!' => \$keywords,
196 'sections!' => \$sections,
197 'fe|file-emails!' => \$file_emails,
198 'f|file' => \$from_filename,
199 'v|version' => \$version,
200 'h|help|usage' => \$help,
201 )) {
202 die "$P: invalid argument - use --help if necessary\n";
205 if ($help != 0) {
206 usage();
207 exit 0;
210 if ($version != 0) {
211 print("${P} ${V}\n");
212 exit 0;
215 if (-t STDIN && !@ARGV) {
216 # We're talking to a terminal, but have no command line arguments.
217 die "$P: missing patchfile or -f file - use --help if necessary\n";
220 $output_multiline = 0 if ($output_separator ne ", ");
221 $output_rolestats = 1 if ($interactive);
222 $output_roles = 1 if ($output_rolestats);
224 if ($sections) {
225 $email = 0;
226 $email_list = 0;
227 $scm = 0;
228 $status = 0;
229 $subsystem = 0;
230 $web = 0;
231 $keywords = 0;
232 $interactive = 0;
233 } else {
234 my $selections = $email + $scm + $status + $subsystem + $web;
235 if ($selections == 0) {
236 die "$P: Missing required option: email, scm, status, subsystem or web\n";
240 if ($email &&
241 ($email_maintainer + $email_list + $email_subscriber_list +
242 $email_git + $email_git_blame) == 0) {
243 die "$P: Please select at least 1 email option\n";
246 if (!top_of_tree($lk_path)) {
247 die "$P: The current directory does not appear to be "
248 . "a QEMU source tree.\n";
251 ## Read MAINTAINERS for type/value pairs
253 my @typevalue = ();
254 my %keyword_hash;
256 open (my $maint, '<', "${lk_path}MAINTAINERS")
257 or die "$P: Can't open MAINTAINERS: $!\n";
258 while (<$maint>) {
259 my $line = $_;
261 if ($line =~ m/^(.):\s*(.*)/) {
262 my $type = $1;
263 my $value = $2;
265 ##Filename pattern matching
266 if ($type eq "F" || $type eq "X") {
267 $value =~ s@\.@\\\.@g; ##Convert . to \.
268 $value =~ s/\*/\.\*/g; ##Convert * to .*
269 $value =~ s/\?/\./g; ##Convert ? to .
270 ##if pattern is a directory and it lacks a trailing slash, add one
271 if ((-d $value)) {
272 $value =~ s@([^/])$@$1/@;
274 } elsif ($type eq "K") {
275 $keyword_hash{@typevalue} = $value;
277 push(@typevalue, "$type:$value");
278 } elsif (!/^(\s)*$/) {
279 $line =~ s/\n$//g;
280 push(@typevalue, $line);
283 close($maint);
287 # Read mail address map
290 my $mailmap;
292 read_mailmap();
294 sub read_mailmap {
295 $mailmap = {
296 names => {},
297 addresses => {}
300 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
302 open(my $mailmap_file, '<', "${lk_path}.mailmap")
303 or warn "$P: Can't open .mailmap: $!\n";
305 while (<$mailmap_file>) {
306 s/#.*$//; #strip comments
307 s/^\s+|\s+$//g; #trim
309 next if (/^\s*$/); #skip empty lines
310 #entries have one of the following formats:
311 # name1 <mail1>
312 # <mail1> <mail2>
313 # name1 <mail1> <mail2>
314 # name1 <mail1> name2 <mail2>
315 # (see man git-shortlog)
317 if (/^([^<]+)<([^>]+)>$/) {
318 my $real_name = $1;
319 my $address = $2;
321 $real_name =~ s/\s+$//;
322 ($real_name, $address) = parse_email("$real_name <$address>");
323 $mailmap->{names}->{$address} = $real_name;
325 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
326 my $real_address = $1;
327 my $wrong_address = $2;
329 $mailmap->{addresses}->{$wrong_address} = $real_address;
331 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
332 my $real_name = $1;
333 my $real_address = $2;
334 my $wrong_address = $3;
336 $real_name =~ s/\s+$//;
337 ($real_name, $real_address) =
338 parse_email("$real_name <$real_address>");
339 $mailmap->{names}->{$wrong_address} = $real_name;
340 $mailmap->{addresses}->{$wrong_address} = $real_address;
342 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
343 my $real_name = $1;
344 my $real_address = $2;
345 my $wrong_name = $3;
346 my $wrong_address = $4;
348 $real_name =~ s/\s+$//;
349 ($real_name, $real_address) =
350 parse_email("$real_name <$real_address>");
352 $wrong_name =~ s/\s+$//;
353 ($wrong_name, $wrong_address) =
354 parse_email("$wrong_name <$wrong_address>");
356 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
357 $mailmap->{names}->{$wrong_email} = $real_name;
358 $mailmap->{addresses}->{$wrong_email} = $real_address;
361 close($mailmap_file);
364 ## use the filenames on the command line or find the filenames in the patchfiles
366 my @files = ();
367 my @range = ();
368 my @keyword_tvi = ();
369 my @file_emails = ();
371 if (!@ARGV) {
372 push(@ARGV, "&STDIN");
375 foreach my $file (@ARGV) {
376 if ($file ne "&STDIN") {
377 ##if $file is a directory and it lacks a trailing slash, add one
378 if ((-d $file)) {
379 $file =~ s@([^/])$@$1/@;
380 } elsif (!(-f $file)) {
381 die "$P: file '${file}' not found\n";
384 if ($from_filename) {
385 push(@files, $file);
386 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
387 open(my $f, '<', $file)
388 or die "$P: Can't open $file: $!\n";
389 my $text = do { local($/) ; <$f> };
390 close($f);
391 if ($keywords) {
392 foreach my $line (keys %keyword_hash) {
393 if ($text =~ m/$keyword_hash{$line}/x) {
394 push(@keyword_tvi, $line);
398 if ($file_emails) {
399 my @poss_addr = $text =~ m$[A-Za--ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
400 push(@file_emails, clean_file_emails(@poss_addr));
403 } else {
404 my $file_cnt = @files;
405 my $lastfile;
407 open(my $patch, "< $file")
408 or die "$P: Can't open $file: $!\n";
410 # We can check arbitrary information before the patch
411 # like the commit message, mail headers, etc...
412 # This allows us to match arbitrary keywords against any part
413 # of a git format-patch generated file (subject tags, etc...)
415 my $patch_prefix = ""; #Parsing the intro
417 while (<$patch>) {
418 my $patch_line = $_;
419 if (m/^\+\+\+\s+(\S+)/) {
420 my $filename = $1;
421 $filename =~ s@^[^/]*/@@;
422 $filename =~ s@\n@@;
423 $lastfile = $filename;
424 push(@files, $filename);
425 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
426 } elsif (m/^\@\@ -(\d+),(\d+)/) {
427 if ($email_git_blame) {
428 push(@range, "$lastfile:$1:$2");
430 } elsif ($keywords) {
431 foreach my $line (keys %keyword_hash) {
432 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
433 push(@keyword_tvi, $line);
438 close($patch);
440 if ($file_cnt == @files) {
441 warn "$P: file '${file}' doesn't appear to be a patch. "
442 . "Add -f to options?\n";
444 @files = sort_and_uniq(@files);
448 @file_emails = uniq(@file_emails);
450 my %email_hash_name;
451 my %email_hash_address;
452 my @email_to = ();
453 my %hash_list_to;
454 my @list_to = ();
455 my @scm = ();
456 my @web = ();
457 my @subsystem = ();
458 my @status = ();
459 my %deduplicate_name_hash = ();
460 my %deduplicate_address_hash = ();
462 my @maintainers = get_maintainers();
464 if (@maintainers) {
465 @maintainers = merge_email(@maintainers);
466 output(@maintainers);
469 if ($scm) {
470 @scm = uniq(@scm);
471 output(@scm);
474 if ($status) {
475 @status = uniq(@status);
476 output(@status);
479 if ($subsystem) {
480 @subsystem = uniq(@subsystem);
481 output(@subsystem);
484 if ($web) {
485 @web = uniq(@web);
486 output(@web);
489 exit($exit);
491 sub range_is_maintained {
492 my ($start, $end) = @_;
494 for (my $i = $start; $i < $end; $i++) {
495 my $line = $typevalue[$i];
496 if ($line =~ m/^(.):\s*(.*)/) {
497 my $type = $1;
498 my $value = $2;
499 if ($type eq 'S') {
500 if ($value =~ /(maintain|support)/i) {
501 return 1;
506 return 0;
509 sub range_has_maintainer {
510 my ($start, $end) = @_;
512 for (my $i = $start; $i < $end; $i++) {
513 my $line = $typevalue[$i];
514 if ($line =~ m/^(.):\s*(.*)/) {
515 my $type = $1;
516 my $value = $2;
517 if ($type eq 'M') {
518 return 1;
522 return 0;
525 sub get_maintainers {
526 %email_hash_name = ();
527 %email_hash_address = ();
528 %commit_author_hash = ();
529 %commit_signer_hash = ();
530 @email_to = ();
531 %hash_list_to = ();
532 @list_to = ();
533 @scm = ();
534 @web = ();
535 @subsystem = ();
536 @status = ();
537 %deduplicate_name_hash = ();
538 %deduplicate_address_hash = ();
539 if ($email_git_all_signature_types) {
540 $signature_pattern = "(.+?)[Bb][Yy]:";
541 } else {
542 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
545 # Find responsible parties
547 my %exact_pattern_match_hash = ();
549 foreach my $file (@files) {
551 my %hash;
552 my $tvi = find_first_section();
553 while ($tvi < @typevalue) {
554 my $start = find_starting_index($tvi);
555 my $end = find_ending_index($tvi);
556 my $exclude = 0;
557 my $i;
559 #Do not match excluded file patterns
561 for ($i = $start; $i < $end; $i++) {
562 my $line = $typevalue[$i];
563 if ($line =~ m/^(.):\s*(.*)/) {
564 my $type = $1;
565 my $value = $2;
566 if ($type eq 'X') {
567 if (file_match_pattern($file, $value)) {
568 $exclude = 1;
569 last;
575 if (!$exclude) {
576 for ($i = $start; $i < $end; $i++) {
577 my $line = $typevalue[$i];
578 if ($line =~ m/^(.):\s*(.*)/) {
579 my $type = $1;
580 my $value = $2;
581 if ($type eq 'F') {
582 if (file_match_pattern($file, $value)) {
583 my $value_pd = ($value =~ tr@/@@);
584 my $file_pd = ($file =~ tr@/@@);
585 $value_pd++ if (substr($value,-1,1) ne "/");
586 $value_pd = -1 if ($value =~ /^\.\*/);
587 if ($value_pd >= $file_pd &&
588 range_is_maintained($start, $end) &&
589 range_has_maintainer($start, $end)) {
590 $exact_pattern_match_hash{$file} = 1;
592 if ($pattern_depth == 0 ||
593 (($file_pd - $value_pd) < $pattern_depth)) {
594 $hash{$tvi} = $value_pd;
601 $tvi = $end + 1;
604 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
605 add_categories($line);
606 if ($sections) {
607 my $i;
608 my $start = find_starting_index($line);
609 my $end = find_ending_index($line);
610 for ($i = $start; $i < $end; $i++) {
611 my $line = $typevalue[$i];
612 if ($line =~ /^[FX]:/) { ##Restore file patterns
613 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
614 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
615 $line =~ s/\\\./\./g; ##Convert \. to .
616 $line =~ s/\.\*/\*/g; ##Convert .* to *
618 $line =~ s/^([A-Z]):/$1:\t/g;
619 print("$line\n");
621 print("\n");
626 if ($keywords) {
627 @keyword_tvi = sort_and_uniq(@keyword_tvi);
628 foreach my $line (@keyword_tvi) {
629 add_categories($line);
633 foreach my $email (@email_to, @list_to) {
634 $email->[0] = deduplicate_email($email->[0]);
637 if ($email) {
638 if (! $interactive) {
639 $email_git_fallback = 0 if @email_to > 0 || @list_to > 0 || $email_git || $email_git_blame;
640 if ($email_git_fallback) {
641 print STDERR "get_maintainer.pl: No maintainers found, printing recent contributors.\n";
642 print STDERR "get_maintainer.pl: Do not blindly cc: them on patches! Use common sense.\n";
643 print STDERR "\n";
647 foreach my $file (@files) {
648 if ($email_git || ($email_git_fallback &&
649 !$exact_pattern_match_hash{$file})) {
650 vcs_file_signoffs($file);
652 if ($email_git_blame) {
653 vcs_file_blame($file);
657 foreach my $email (@file_emails) {
658 my ($name, $address) = parse_email($email);
660 my $tmp_email = format_email($name, $address, $email_usename);
661 push_email_address($tmp_email, '');
662 add_role($tmp_email, 'in file');
666 my @to = ();
667 if ($email || $email_list) {
668 if ($email) {
669 @to = (@to, @email_to);
671 if ($email_list) {
672 @to = (@to, @list_to);
676 if ($interactive) {
677 @to = interactive_get_maintainers(\@to);
680 return @to;
683 sub file_match_pattern {
684 my ($file, $pattern) = @_;
685 if (substr($pattern, -1) eq "/") {
686 if ($file =~ m@^$pattern@) {
687 return 1;
689 } else {
690 if ($file =~ m@^$pattern@) {
691 my $s1 = ($file =~ tr@/@@);
692 my $s2 = ($pattern =~ tr@/@@);
693 if ($s1 == $s2) {
694 return 1;
698 return 0;
701 sub usage {
702 print <<EOT;
703 usage: $P [options] patchfile
704 $P [options] -f file|directory
705 version: $V
707 MAINTAINER field selection options:
708 --email => print email address(es) if any
709 --git => include recent git \*-by: signers
710 --git-all-signature-types => include signers regardless of signature type
711 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
712 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
713 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
714 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
715 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
716 --git-blame => use git blame to find modified commits for patch or file
717 --git-since => git history to use (default: $email_git_since)
718 --hg-since => hg history to use (default: $email_hg_since)
719 --interactive => display a menu (mostly useful if used with the --git option)
720 --m => include maintainer(s) if any
721 --n => include name 'Full Name <addr\@domain.tld>'
722 --l => include list(s) if any
723 --s => include subscriber only list(s) if any
724 --remove-duplicates => minimize duplicate email names/addresses
725 --roles => show roles (status:subsystem, git-signer, list, etc...)
726 --rolestats => show roles and statistics (commits/total_commits, %)
727 --file-emails => add email addresses found in -f file (default: 0 (off))
728 --scm => print SCM tree(s) if any
729 --status => print status if any
730 --subsystem => print subsystem name if any
731 --web => print website(s) if any
733 Output type options:
734 --separator [, ] => separator for multiple entries on 1 line
735 using --separator also sets --nomultiline if --separator is not [, ]
736 --multiline => print 1 entry per line
738 Other options:
739 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
740 --keywords => scan patch for keywords (default: $keywords)
741 --sections => print all of the subsystem sections with pattern matches
742 --mailmap => use .mailmap file (default: $email_use_mailmap)
743 --version => show version
744 --help => show this help information
746 Default options:
747 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
748 --remove-duplicates --rolestats]
750 Notes:
751 Using "-f directory" may give unexpected results:
752 Used with "--git", git signators for _all_ files in and below
753 directory are examined as git recurses directories.
754 Any specified X: (exclude) pattern matches are _not_ ignored.
755 Used with "--nogit", directory is used as a pattern match,
756 no individual file within the directory or subdirectory
757 is matched.
758 Used with "--git-blame", does not iterate all files in directory
759 Using "--git-blame" is slow and may add old committers and authors
760 that are no longer active maintainers to the output.
761 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
762 other automated tools that expect only ["name"] <email address>
763 may not work because of additional output after <email address>.
764 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
765 not the percentage of the entire file authored. # of commits is
766 not a good measure of amount of code authored. 1 major commit may
767 contain a thousand lines, 5 trivial commits may modify a single line.
768 If git is not installed, but mercurial (hg) is installed and an .hg
769 repository exists, the following options apply to mercurial:
770 --git,
771 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
772 --git-blame
773 Use --hg-since not --git-since to control date selection
774 File ".get_maintainer.conf", if it exists in the QEMU source root
775 directory, can change whatever get_maintainer defaults are desired.
776 Entries in this file can be any command line argument.
777 This file is prepended to any additional command line arguments.
778 Multiple lines and # comments are allowed.
782 sub top_of_tree {
783 my ($lk_path) = @_;
785 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
786 $lk_path .= "/";
788 if ( (-f "${lk_path}COPYING")
789 && (-f "${lk_path}MAINTAINERS")
790 && (-f "${lk_path}Makefile")
791 && (-d "${lk_path}docs")
792 && (-f "${lk_path}VERSION")
793 && (-f "${lk_path}vl.c")) {
794 return 1;
796 return 0;
799 sub parse_email {
800 my ($formatted_email) = @_;
802 my $name = "";
803 my $address = "";
805 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
806 $name = $1;
807 $address = $2;
808 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
809 $address = $1;
810 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
811 $address = $1;
814 $name =~ s/^\s+|\s+$//g;
815 $name =~ s/^\"|\"$//g;
816 $address =~ s/^\s+|\s+$//g;
818 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
819 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
820 $name = "\"$name\"";
823 return ($name, $address);
826 sub format_email {
827 my ($name, $address, $usename) = @_;
829 my $formatted_email;
831 $name =~ s/^\s+|\s+$//g;
832 $name =~ s/^\"|\"$//g;
833 $address =~ s/^\s+|\s+$//g;
835 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
836 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
837 $name = "\"$name\"";
840 if ($usename) {
841 if ("$name" eq "") {
842 $formatted_email = "$address";
843 } else {
844 $formatted_email = "$name <$address>";
846 } else {
847 $formatted_email = $address;
850 return $formatted_email;
853 sub find_first_section {
854 my $index = 0;
856 while ($index < @typevalue) {
857 my $tv = $typevalue[$index];
858 if (($tv =~ m/^(.):\s*(.*)/)) {
859 last;
861 $index++;
864 return $index;
867 sub find_starting_index {
868 my ($index) = @_;
870 while ($index > 0) {
871 my $tv = $typevalue[$index];
872 if (!($tv =~ m/^(.):\s*(.*)/)) {
873 last;
875 $index--;
878 return $index;
881 sub find_ending_index {
882 my ($index) = @_;
884 while ($index < @typevalue) {
885 my $tv = $typevalue[$index];
886 if (!($tv =~ m/^(.):\s*(.*)/)) {
887 last;
889 $index++;
892 return $index;
895 sub get_maintainer_role {
896 my ($index) = @_;
898 my $i;
899 my $start = find_starting_index($index);
900 my $end = find_ending_index($index);
902 my $role = "unknown";
903 my $subsystem = $typevalue[$start];
904 if (length($subsystem) > 20) {
905 $subsystem = substr($subsystem, 0, 17);
906 $subsystem =~ s/\s*$//;
907 $subsystem = $subsystem . "...";
910 for ($i = $start + 1; $i < $end; $i++) {
911 my $tv = $typevalue[$i];
912 if ($tv =~ m/^(.):\s*(.*)/) {
913 my $ptype = $1;
914 my $pvalue = $2;
915 if ($ptype eq "S") {
916 $role = $pvalue;
921 $role = lc($role);
922 if ($role eq "supported") {
923 $role = "supporter";
924 } elsif ($role eq "maintained") {
925 $role = "maintainer";
926 } elsif ($role eq "odd fixes") {
927 $role = "odd fixer";
928 } elsif ($role eq "orphan") {
929 $role = "orphan minder";
930 } elsif ($role eq "obsolete") {
931 $role = "obsolete minder";
932 } elsif ($role eq "buried alive in reporters") {
933 $role = "chief penguin";
936 return $role . ":" . $subsystem;
939 sub get_list_role {
940 my ($index) = @_;
942 my $i;
943 my $start = find_starting_index($index);
944 my $end = find_ending_index($index);
946 my $subsystem = $typevalue[$start];
947 if (length($subsystem) > 20) {
948 $subsystem = substr($subsystem, 0, 17);
949 $subsystem =~ s/\s*$//;
950 $subsystem = $subsystem . "...";
953 if ($subsystem eq "THE REST") {
954 $subsystem = "";
957 return $subsystem;
960 sub add_categories {
961 my ($index) = @_;
963 my $i;
964 my $start = find_starting_index($index);
965 my $end = find_ending_index($index);
967 push(@subsystem, $typevalue[$start]);
969 for ($i = $start + 1; $i < $end; $i++) {
970 my $tv = $typevalue[$i];
971 if ($tv =~ m/^(.):\s*(.*)/) {
972 my $ptype = $1;
973 my $pvalue = $2;
974 if ($ptype eq "L") {
975 my $list_address = $pvalue;
976 my $list_additional = "";
977 my $list_role = get_list_role($i);
979 if ($list_role ne "") {
980 $list_role = ":" . $list_role;
982 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
983 $list_address = $1;
984 $list_additional = $2;
986 if ($list_additional =~ m/subscribers-only/) {
987 if ($email_subscriber_list) {
988 if (!$hash_list_to{lc($list_address)}) {
989 $hash_list_to{lc($list_address)} = 1;
990 push(@list_to, [$list_address,
991 "subscriber list${list_role}"]);
994 } else {
995 if ($email_list) {
996 if (!$hash_list_to{lc($list_address)}) {
997 $hash_list_to{lc($list_address)} = 1;
998 if ($list_additional =~ m/moderated/) {
999 push(@list_to, [$list_address,
1000 "moderated list${list_role}"]);
1001 } else {
1002 push(@list_to, [$list_address,
1003 "open list${list_role}"]);
1008 } elsif ($ptype eq "M") {
1009 my ($name, $address) = parse_email($pvalue);
1010 if ($name eq "") {
1011 if ($i > 0) {
1012 my $tv = $typevalue[$i - 1];
1013 if ($tv =~ m/^(.):\s*(.*)/) {
1014 if ($1 eq "P") {
1015 $name = $2;
1016 $pvalue = format_email($name, $address, $email_usename);
1021 if ($email_maintainer) {
1022 my $role = get_maintainer_role($i);
1023 push_email_addresses($pvalue, $role);
1025 } elsif ($ptype eq "T") {
1026 push(@scm, $pvalue);
1027 } elsif ($ptype eq "W") {
1028 push(@web, $pvalue);
1029 } elsif ($ptype eq "S") {
1030 push(@status, $pvalue);
1036 sub email_inuse {
1037 my ($name, $address) = @_;
1039 return 1 if (($name eq "") && ($address eq ""));
1040 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1041 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1043 return 0;
1046 sub push_email_address {
1047 my ($line, $role) = @_;
1049 my ($name, $address) = parse_email($line);
1051 if ($address eq "") {
1052 return 0;
1055 if (!$email_remove_duplicates) {
1056 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1057 } elsif (!email_inuse($name, $address)) {
1058 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1059 $email_hash_name{lc($name)}++ if ($name ne "");
1060 $email_hash_address{lc($address)}++;
1063 return 1;
1066 sub push_email_addresses {
1067 my ($address, $role) = @_;
1069 my @address_list = ();
1071 if (rfc822_valid($address)) {
1072 push_email_address($address, $role);
1073 } elsif (@address_list = rfc822_validlist($address)) {
1074 my $array_count = shift(@address_list);
1075 while (my $entry = shift(@address_list)) {
1076 push_email_address($entry, $role);
1078 } else {
1079 if (!push_email_address($address, $role)) {
1080 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1085 sub add_role {
1086 my ($line, $role) = @_;
1088 my ($name, $address) = parse_email($line);
1089 my $email = format_email($name, $address, $email_usename);
1091 foreach my $entry (@email_to) {
1092 if ($email_remove_duplicates) {
1093 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1094 if (($name eq $entry_name || $address eq $entry_address)
1095 && ($role eq "" || !($entry->[1] =~ m/$role/))
1097 if ($entry->[1] eq "") {
1098 $entry->[1] = "$role";
1099 } else {
1100 $entry->[1] = "$entry->[1],$role";
1103 } else {
1104 if ($email eq $entry->[0]
1105 && ($role eq "" || !($entry->[1] =~ m/$role/))
1107 if ($entry->[1] eq "") {
1108 $entry->[1] = "$role";
1109 } else {
1110 $entry->[1] = "$entry->[1],$role";
1117 sub which {
1118 my ($bin) = @_;
1120 foreach my $path (split(/:/, $ENV{PATH})) {
1121 if (-e "$path/$bin") {
1122 return "$path/$bin";
1126 return "";
1129 sub which_conf {
1130 my ($conf) = @_;
1132 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1133 if (-e "$path/$conf") {
1134 return "$path/$conf";
1138 return "";
1141 sub mailmap_email {
1142 my ($line) = @_;
1144 my ($name, $address) = parse_email($line);
1145 my $email = format_email($name, $address, 1);
1146 my $real_name = $name;
1147 my $real_address = $address;
1149 if (exists $mailmap->{names}->{$email} ||
1150 exists $mailmap->{addresses}->{$email}) {
1151 if (exists $mailmap->{names}->{$email}) {
1152 $real_name = $mailmap->{names}->{$email};
1154 if (exists $mailmap->{addresses}->{$email}) {
1155 $real_address = $mailmap->{addresses}->{$email};
1157 } else {
1158 if (exists $mailmap->{names}->{$address}) {
1159 $real_name = $mailmap->{names}->{$address};
1161 if (exists $mailmap->{addresses}->{$address}) {
1162 $real_address = $mailmap->{addresses}->{$address};
1165 return format_email($real_name, $real_address, 1);
1168 sub mailmap {
1169 my (@addresses) = @_;
1171 my @mapped_emails = ();
1172 foreach my $line (@addresses) {
1173 push(@mapped_emails, mailmap_email($line));
1175 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1176 return @mapped_emails;
1179 sub merge_by_realname {
1180 my %address_map;
1181 my (@emails) = @_;
1183 foreach my $email (@emails) {
1184 my ($name, $address) = parse_email($email);
1185 if (exists $address_map{$name}) {
1186 $address = $address_map{$name};
1187 $email = format_email($name, $address, 1);
1188 } else {
1189 $address_map{$name} = $address;
1194 sub git_execute_cmd {
1195 my ($cmd) = @_;
1196 my @lines = ();
1198 my $output = `$cmd`;
1199 $output =~ s/^\s*//gm;
1200 @lines = split("\n", $output);
1202 return @lines;
1205 sub hg_execute_cmd {
1206 my ($cmd) = @_;
1207 my @lines = ();
1209 my $output = `$cmd`;
1210 @lines = split("\n", $output);
1212 return @lines;
1215 sub extract_formatted_signatures {
1216 my (@signature_lines) = @_;
1218 my @type = @signature_lines;
1220 s/\s*(.*):.*/$1/ for (@type);
1222 # cut -f2- -d":"
1223 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1225 ## Reformat email addresses (with names) to avoid badly written signatures
1227 foreach my $signer (@signature_lines) {
1228 $signer = deduplicate_email($signer);
1231 return (\@type, \@signature_lines);
1234 sub vcs_find_signers {
1235 my ($cmd) = @_;
1236 my $commits;
1237 my @lines = ();
1238 my @signatures = ();
1240 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1242 my $pattern = $VCS_cmds{"commit_pattern"};
1244 $commits = grep(/$pattern/, @lines); # of commits
1246 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1248 return (0, @signatures) if !@signatures;
1250 save_commits_by_author(@lines) if ($interactive);
1251 save_commits_by_signer(@lines) if ($interactive);
1253 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1255 return ($commits, @$signers_ref);
1258 sub vcs_find_author {
1259 my ($cmd) = @_;
1260 my @lines = ();
1262 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1264 return @lines if !@lines;
1266 my @authors = ();
1267 foreach my $line (@lines) {
1268 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1269 my $author = $1;
1270 my ($name, $address) = parse_email($author);
1271 $author = format_email($name, $address, 1);
1272 push(@authors, $author);
1276 save_commits_by_author(@lines) if ($interactive);
1277 save_commits_by_signer(@lines) if ($interactive);
1279 return @authors;
1282 sub vcs_save_commits {
1283 my ($cmd) = @_;
1284 my @lines = ();
1285 my @commits = ();
1287 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1289 foreach my $line (@lines) {
1290 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1291 push(@commits, $1);
1295 return @commits;
1298 sub vcs_blame {
1299 my ($file) = @_;
1300 my $cmd;
1301 my @commits = ();
1303 return @commits if (!(-f $file));
1305 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1306 my @all_commits = ();
1308 $cmd = $VCS_cmds{"blame_file_cmd"};
1309 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1310 @all_commits = vcs_save_commits($cmd);
1312 foreach my $file_range_diff (@range) {
1313 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1314 my $diff_file = $1;
1315 my $diff_start = $2;
1316 my $diff_length = $3;
1317 next if ("$file" ne "$diff_file");
1318 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1319 push(@commits, $all_commits[$i]);
1322 } elsif (@range) {
1323 foreach my $file_range_diff (@range) {
1324 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1325 my $diff_file = $1;
1326 my $diff_start = $2;
1327 my $diff_length = $3;
1328 next if ("$file" ne "$diff_file");
1329 $cmd = $VCS_cmds{"blame_range_cmd"};
1330 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1331 push(@commits, vcs_save_commits($cmd));
1333 } else {
1334 $cmd = $VCS_cmds{"blame_file_cmd"};
1335 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1336 @commits = vcs_save_commits($cmd);
1339 foreach my $commit (@commits) {
1340 $commit =~ s/^\^//g;
1343 return @commits;
1346 my $printed_novcs = 0;
1347 sub vcs_exists {
1348 %VCS_cmds = %VCS_cmds_git;
1349 return 1 if eval $VCS_cmds{"available"};
1350 %VCS_cmds = %VCS_cmds_hg;
1351 return 2 if eval $VCS_cmds{"available"};
1352 %VCS_cmds = ();
1353 if (!$printed_novcs) {
1354 warn("$P: No supported VCS found. Add --nogit to options?\n");
1355 warn("Using a git repository produces better results.\n");
1356 warn("Try latest git repository using:\n");
1357 warn("git clone git://git.qemu-project.org/qemu.git\n");
1358 $printed_novcs = 1;
1360 return 0;
1363 sub vcs_is_git {
1364 vcs_exists();
1365 return $vcs_used == 1;
1368 sub vcs_is_hg {
1369 return $vcs_used == 2;
1372 sub interactive_get_maintainers {
1373 my ($list_ref) = @_;
1374 my @list = @$list_ref;
1376 vcs_exists();
1378 my %selected;
1379 my %authored;
1380 my %signed;
1381 my $count = 0;
1382 my $maintained = 0;
1383 foreach my $entry (@list) {
1384 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1385 $selected{$count} = 1;
1386 $authored{$count} = 0;
1387 $signed{$count} = 0;
1388 $count++;
1391 #menu loop
1392 my $done = 0;
1393 my $print_options = 0;
1394 my $redraw = 1;
1395 while (!$done) {
1396 $count = 0;
1397 if ($redraw) {
1398 printf STDERR "\n%1s %2s %-65s",
1399 "*", "#", "email/list and role:stats";
1400 if ($email_git ||
1401 ($email_git_fallback && !$maintained) ||
1402 $email_git_blame) {
1403 print STDERR "auth sign";
1405 print STDERR "\n";
1406 foreach my $entry (@list) {
1407 my $email = $entry->[0];
1408 my $role = $entry->[1];
1409 my $sel = "";
1410 $sel = "*" if ($selected{$count});
1411 my $commit_author = $commit_author_hash{$email};
1412 my $commit_signer = $commit_signer_hash{$email};
1413 my $authored = 0;
1414 my $signed = 0;
1415 $authored++ for (@{$commit_author});
1416 $signed++ for (@{$commit_signer});
1417 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1418 printf STDERR "%4d %4d", $authored, $signed
1419 if ($authored > 0 || $signed > 0);
1420 printf STDERR "\n %s\n", $role;
1421 if ($authored{$count}) {
1422 my $commit_author = $commit_author_hash{$email};
1423 foreach my $ref (@{$commit_author}) {
1424 print STDERR " Author: @{$ref}[1]\n";
1427 if ($signed{$count}) {
1428 my $commit_signer = $commit_signer_hash{$email};
1429 foreach my $ref (@{$commit_signer}) {
1430 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1434 $count++;
1437 my $date_ref = \$email_git_since;
1438 $date_ref = \$email_hg_since if (vcs_is_hg());
1439 if ($print_options) {
1440 $print_options = 0;
1441 if (vcs_exists()) {
1442 print STDERR <<EOT
1444 Version Control options:
1445 g use git history [$email_git]
1446 gf use git-fallback [$email_git_fallback]
1447 b use git blame [$email_git_blame]
1448 bs use blame signatures [$email_git_blame_signatures]
1449 c# minimum commits [$email_git_min_signatures]
1450 %# min percent [$email_git_min_percent]
1451 d# history to use [$$date_ref]
1452 x# max maintainers [$email_git_max_maintainers]
1453 t all signature types [$email_git_all_signature_types]
1454 m use .mailmap [$email_use_mailmap]
1457 print STDERR <<EOT
1459 Additional options:
1460 0 toggle all
1461 tm toggle maintainers
1462 tg toggle git entries
1463 tl toggle open list entries
1464 ts toggle subscriber list entries
1465 f emails in file [$file_emails]
1466 k keywords in file [$keywords]
1467 r remove duplicates [$email_remove_duplicates]
1468 p# pattern match depth [$pattern_depth]
1471 print STDERR
1472 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1474 my $input = <STDIN>;
1475 chomp($input);
1477 $redraw = 1;
1478 my $rerun = 0;
1479 my @wish = split(/[, ]+/, $input);
1480 foreach my $nr (@wish) {
1481 $nr = lc($nr);
1482 my $sel = substr($nr, 0, 1);
1483 my $str = substr($nr, 1);
1484 my $val = 0;
1485 $val = $1 if $str =~ /^(\d+)$/;
1487 if ($sel eq "y") {
1488 $interactive = 0;
1489 $done = 1;
1490 $output_rolestats = 0;
1491 $output_roles = 0;
1492 last;
1493 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1494 $selected{$nr - 1} = !$selected{$nr - 1};
1495 } elsif ($sel eq "*" || $sel eq '^') {
1496 my $toggle = 0;
1497 $toggle = 1 if ($sel eq '*');
1498 for (my $i = 0; $i < $count; $i++) {
1499 $selected{$i} = $toggle;
1501 } elsif ($sel eq "0") {
1502 for (my $i = 0; $i < $count; $i++) {
1503 $selected{$i} = !$selected{$i};
1505 } elsif ($sel eq "t") {
1506 if (lc($str) eq "m") {
1507 for (my $i = 0; $i < $count; $i++) {
1508 $selected{$i} = !$selected{$i}
1509 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1511 } elsif (lc($str) eq "g") {
1512 for (my $i = 0; $i < $count; $i++) {
1513 $selected{$i} = !$selected{$i}
1514 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1516 } elsif (lc($str) eq "l") {
1517 for (my $i = 0; $i < $count; $i++) {
1518 $selected{$i} = !$selected{$i}
1519 if ($list[$i]->[1] =~ /^(open list)/i);
1521 } elsif (lc($str) eq "s") {
1522 for (my $i = 0; $i < $count; $i++) {
1523 $selected{$i} = !$selected{$i}
1524 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1527 } elsif ($sel eq "a") {
1528 if ($val > 0 && $val <= $count) {
1529 $authored{$val - 1} = !$authored{$val - 1};
1530 } elsif ($str eq '*' || $str eq '^') {
1531 my $toggle = 0;
1532 $toggle = 1 if ($str eq '*');
1533 for (my $i = 0; $i < $count; $i++) {
1534 $authored{$i} = $toggle;
1537 } elsif ($sel eq "s") {
1538 if ($val > 0 && $val <= $count) {
1539 $signed{$val - 1} = !$signed{$val - 1};
1540 } elsif ($str eq '*' || $str eq '^') {
1541 my $toggle = 0;
1542 $toggle = 1 if ($str eq '*');
1543 for (my $i = 0; $i < $count; $i++) {
1544 $signed{$i} = $toggle;
1547 } elsif ($sel eq "o") {
1548 $print_options = 1;
1549 $redraw = 1;
1550 } elsif ($sel eq "g") {
1551 if ($str eq "f") {
1552 bool_invert(\$email_git_fallback);
1553 } else {
1554 bool_invert(\$email_git);
1556 $rerun = 1;
1557 } elsif ($sel eq "b") {
1558 if ($str eq "s") {
1559 bool_invert(\$email_git_blame_signatures);
1560 } else {
1561 bool_invert(\$email_git_blame);
1563 $rerun = 1;
1564 } elsif ($sel eq "c") {
1565 if ($val > 0) {
1566 $email_git_min_signatures = $val;
1567 $rerun = 1;
1569 } elsif ($sel eq "x") {
1570 if ($val > 0) {
1571 $email_git_max_maintainers = $val;
1572 $rerun = 1;
1574 } elsif ($sel eq "%") {
1575 if ($str ne "" && $val >= 0) {
1576 $email_git_min_percent = $val;
1577 $rerun = 1;
1579 } elsif ($sel eq "d") {
1580 if (vcs_is_git()) {
1581 $email_git_since = $str;
1582 } elsif (vcs_is_hg()) {
1583 $email_hg_since = $str;
1585 $rerun = 1;
1586 } elsif ($sel eq "t") {
1587 bool_invert(\$email_git_all_signature_types);
1588 $rerun = 1;
1589 } elsif ($sel eq "f") {
1590 bool_invert(\$file_emails);
1591 $rerun = 1;
1592 } elsif ($sel eq "r") {
1593 bool_invert(\$email_remove_duplicates);
1594 $rerun = 1;
1595 } elsif ($sel eq "m") {
1596 bool_invert(\$email_use_mailmap);
1597 read_mailmap();
1598 $rerun = 1;
1599 } elsif ($sel eq "k") {
1600 bool_invert(\$keywords);
1601 $rerun = 1;
1602 } elsif ($sel eq "p") {
1603 if ($str ne "" && $val >= 0) {
1604 $pattern_depth = $val;
1605 $rerun = 1;
1607 } elsif ($sel eq "h" || $sel eq "?") {
1608 print STDERR <<EOT
1610 Interactive mode allows you to select the various maintainers, submitters,
1611 commit signers and mailing lists that could be CC'd on a patch.
1613 Any *'d entry is selected.
1615 If you have git or hg installed, you can choose to summarize the commit
1616 history of files in the patch. Also, each line of the current file can
1617 be matched to its commit author and that commits signers with blame.
1619 Various knobs exist to control the length of time for active commit
1620 tracking, the maximum number of commit authors and signers to add,
1621 and such.
1623 Enter selections at the prompt until you are satisfied that the selected
1624 maintainers are appropriate. You may enter multiple selections separated
1625 by either commas or spaces.
1628 } else {
1629 print STDERR "invalid option: '$nr'\n";
1630 $redraw = 0;
1633 if ($rerun) {
1634 print STDERR "git-blame can be very slow, please have patience..."
1635 if ($email_git_blame);
1636 goto &get_maintainers;
1640 #drop not selected entries
1641 $count = 0;
1642 my @new_emailto = ();
1643 foreach my $entry (@list) {
1644 if ($selected{$count}) {
1645 push(@new_emailto, $list[$count]);
1647 $count++;
1649 return @new_emailto;
1652 sub bool_invert {
1653 my ($bool_ref) = @_;
1655 if ($$bool_ref) {
1656 $$bool_ref = 0;
1657 } else {
1658 $$bool_ref = 1;
1662 sub deduplicate_email {
1663 my ($email) = @_;
1665 my $matched = 0;
1666 my ($name, $address) = parse_email($email);
1667 $email = format_email($name, $address, 1);
1668 $email = mailmap_email($email);
1670 return $email if (!$email_remove_duplicates);
1672 ($name, $address) = parse_email($email);
1674 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1675 $name = $deduplicate_name_hash{lc($name)}->[0];
1676 $address = $deduplicate_name_hash{lc($name)}->[1];
1677 $matched = 1;
1678 } elsif ($deduplicate_address_hash{lc($address)}) {
1679 $name = $deduplicate_address_hash{lc($address)}->[0];
1680 $address = $deduplicate_address_hash{lc($address)}->[1];
1681 $matched = 1;
1683 if (!$matched) {
1684 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1685 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1687 $email = format_email($name, $address, 1);
1688 $email = mailmap_email($email);
1689 return $email;
1692 sub save_commits_by_author {
1693 my (@lines) = @_;
1695 my @authors = ();
1696 my @commits = ();
1697 my @subjects = ();
1699 foreach my $line (@lines) {
1700 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1701 my $author = $1;
1702 $author = deduplicate_email($author);
1703 push(@authors, $author);
1705 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1706 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1709 for (my $i = 0; $i < @authors; $i++) {
1710 my $exists = 0;
1711 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1712 if (@{$ref}[0] eq $commits[$i] &&
1713 @{$ref}[1] eq $subjects[$i]) {
1714 $exists = 1;
1715 last;
1718 if (!$exists) {
1719 push(@{$commit_author_hash{$authors[$i]}},
1720 [ ($commits[$i], $subjects[$i]) ]);
1725 sub save_commits_by_signer {
1726 my (@lines) = @_;
1728 my $commit = "";
1729 my $subject = "";
1731 foreach my $line (@lines) {
1732 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1733 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1734 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1735 my @signatures = ($line);
1736 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1737 my @types = @$types_ref;
1738 my @signers = @$signers_ref;
1740 my $type = $types[0];
1741 my $signer = $signers[0];
1743 $signer = deduplicate_email($signer);
1745 my $exists = 0;
1746 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1747 if (@{$ref}[0] eq $commit &&
1748 @{$ref}[1] eq $subject &&
1749 @{$ref}[2] eq $type) {
1750 $exists = 1;
1751 last;
1754 if (!$exists) {
1755 push(@{$commit_signer_hash{$signer}},
1756 [ ($commit, $subject, $type) ]);
1762 sub vcs_assign {
1763 my ($role, $divisor, @lines) = @_;
1765 my %hash;
1766 my $count = 0;
1768 return if (@lines <= 0);
1770 if ($divisor <= 0) {
1771 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1772 $divisor = 1;
1775 @lines = mailmap(@lines);
1777 return if (@lines <= 0);
1779 @lines = sort(@lines);
1781 # uniq -c
1782 $hash{$_}++ for @lines;
1784 # sort -rn
1785 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1786 my $sign_offs = $hash{$line};
1787 my $percent = $sign_offs * 100 / $divisor;
1789 $percent = 100 if ($percent > 100);
1790 $count++;
1791 last if ($sign_offs < $email_git_min_signatures ||
1792 $count > $email_git_max_maintainers ||
1793 $percent < $email_git_min_percent);
1794 push_email_address($line, '');
1795 if ($output_rolestats) {
1796 my $fmt_percent = sprintf("%.0f", $percent);
1797 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1798 } else {
1799 add_role($line, $role);
1804 sub vcs_file_signoffs {
1805 my ($file) = @_;
1807 my @signers = ();
1808 my $commits;
1810 $vcs_used = vcs_exists();
1811 return if (!$vcs_used);
1813 my $cmd = $VCS_cmds{"find_signers_cmd"};
1814 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1816 ($commits, @signers) = vcs_find_signers($cmd);
1818 foreach my $signer (@signers) {
1819 $signer = deduplicate_email($signer);
1822 vcs_assign("commit_signer", $commits, @signers);
1825 sub vcs_file_blame {
1826 my ($file) = @_;
1828 my @signers = ();
1829 my @all_commits = ();
1830 my @commits = ();
1831 my $total_commits;
1832 my $total_lines;
1834 $vcs_used = vcs_exists();
1835 return if (!$vcs_used);
1837 @all_commits = vcs_blame($file);
1838 @commits = uniq(@all_commits);
1839 $total_commits = @commits;
1840 $total_lines = @all_commits;
1842 if ($email_git_blame_signatures) {
1843 if (vcs_is_hg()) {
1844 my $commit_count;
1845 my @commit_signers = ();
1846 my $commit = join(" -r ", @commits);
1847 my $cmd;
1849 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1850 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1852 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1854 push(@signers, @commit_signers);
1855 } else {
1856 foreach my $commit (@commits) {
1857 my $commit_count;
1858 my @commit_signers = ();
1859 my $cmd;
1861 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1862 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1864 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1866 push(@signers, @commit_signers);
1871 if ($from_filename) {
1872 if ($output_rolestats) {
1873 my @blame_signers;
1874 if (vcs_is_hg()) {{ # Double brace for last exit
1875 my $commit_count;
1876 my @commit_signers = ();
1877 @commits = uniq(@commits);
1878 @commits = sort(@commits);
1879 my $commit = join(" -r ", @commits);
1880 my $cmd;
1882 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1883 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1885 my @lines = ();
1887 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1889 last if !@lines;
1891 my @authors = ();
1892 foreach my $line (@lines) {
1893 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1894 my $author = $1;
1895 $author = deduplicate_email($author);
1896 push(@authors, $author);
1900 save_commits_by_author(@lines) if ($interactive);
1901 save_commits_by_signer(@lines) if ($interactive);
1903 push(@signers, @authors);
1905 else {
1906 foreach my $commit (@commits) {
1907 my $i;
1908 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1909 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1910 my @author = vcs_find_author($cmd);
1911 next if !@author;
1913 my $formatted_author = deduplicate_email($author[0]);
1915 my $count = grep(/$commit/, @all_commits);
1916 for ($i = 0; $i < $count ; $i++) {
1917 push(@blame_signers, $formatted_author);
1921 if (@blame_signers) {
1922 vcs_assign("authored lines", $total_lines, @blame_signers);
1925 foreach my $signer (@signers) {
1926 $signer = deduplicate_email($signer);
1928 vcs_assign("commits", $total_commits, @signers);
1929 } else {
1930 foreach my $signer (@signers) {
1931 $signer = deduplicate_email($signer);
1933 vcs_assign("modified commits", $total_commits, @signers);
1937 sub uniq {
1938 my (@parms) = @_;
1940 my %saw;
1941 @parms = grep(!$saw{$_}++, @parms);
1942 return @parms;
1945 sub sort_and_uniq {
1946 my (@parms) = @_;
1948 my %saw;
1949 @parms = sort @parms;
1950 @parms = grep(!$saw{$_}++, @parms);
1951 return @parms;
1954 sub clean_file_emails {
1955 my (@file_emails) = @_;
1956 my @fmt_emails = ();
1958 foreach my $email (@file_emails) {
1959 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1960 my ($name, $address) = parse_email($email);
1961 if ($name eq '"[,\.]"') {
1962 $name = "";
1965 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1966 if (@nw > 2) {
1967 my $first = $nw[@nw - 3];
1968 my $middle = $nw[@nw - 2];
1969 my $last = $nw[@nw - 1];
1971 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1972 (length($first) == 2 && substr($first, -1) eq ".")) ||
1973 (length($middle) == 1 ||
1974 (length($middle) == 2 && substr($middle, -1) eq "."))) {
1975 $name = "$first $middle $last";
1976 } else {
1977 $name = "$middle $last";
1981 if (substr($name, -1) =~ /[,\.]/) {
1982 $name = substr($name, 0, length($name) - 1);
1983 } elsif (substr($name, -2) =~ /[,\.]"/) {
1984 $name = substr($name, 0, length($name) - 2) . '"';
1987 if (substr($name, 0, 1) =~ /[,\.]/) {
1988 $name = substr($name, 1, length($name) - 1);
1989 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
1990 $name = '"' . substr($name, 2, length($name) - 2);
1993 my $fmt_email = format_email($name, $address, $email_usename);
1994 push(@fmt_emails, $fmt_email);
1996 return @fmt_emails;
1999 sub merge_email {
2000 my @lines;
2001 my %saw;
2003 for (@_) {
2004 my ($address, $role) = @$_;
2005 if (!$saw{$address}) {
2006 if ($output_roles) {
2007 push(@lines, "$address ($role)");
2008 } else {
2009 push(@lines, $address);
2011 $saw{$address} = 1;
2015 return @lines;
2018 sub output {
2019 my (@parms) = @_;
2021 if ($output_multiline) {
2022 foreach my $line (@parms) {
2023 print("${line}\n");
2025 } else {
2026 print(join($output_separator, @parms));
2027 print("\n");
2031 my $rfc822re;
2033 sub make_rfc822re {
2034 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2035 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2036 # This regexp will only work on addresses which have had comments stripped
2037 # and replaced with rfc822_lwsp.
2039 my $specials = '()<>@,;:\\\\".\\[\\]';
2040 my $controls = '\\000-\\037\\177';
2042 my $dtext = "[^\\[\\]\\r\\\\]";
2043 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2045 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2047 # Use zero-width assertion to spot the limit of an atom. A simple
2048 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2049 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2050 my $word = "(?:$atom|$quoted_string)";
2051 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2053 my $sub_domain = "(?:$atom|$domain_literal)";
2054 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2056 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2058 my $phrase = "$word*";
2059 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2060 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2061 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2063 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2064 my $address = "(?:$mailbox|$group)";
2066 return "$rfc822_lwsp*$address";
2069 sub rfc822_strip_comments {
2070 my $s = shift;
2071 # Recursively remove comments, and replace with a single space. The simpler
2072 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2073 # chars in atoms, for example.
2075 while ($s =~ s/^((?:[^"\\]|\\.)*
2076 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2077 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2078 return $s;
2081 # valid: returns true if the parameter is an RFC822 valid address
2083 sub rfc822_valid {
2084 my $s = rfc822_strip_comments(shift);
2086 if (!$rfc822re) {
2087 $rfc822re = make_rfc822re();
2090 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2093 # validlist: In scalar context, returns true if the parameter is an RFC822
2094 # valid list of addresses.
2096 # In list context, returns an empty list on failure (an invalid
2097 # address was found); otherwise a list whose first element is the
2098 # number of addresses found and whose remaining elements are the
2099 # addresses. This is needed to disambiguate failure (invalid)
2100 # from success with no addresses found, because an empty string is
2101 # a valid list.
2103 sub rfc822_validlist {
2104 my $s = rfc822_strip_comments(shift);
2106 if (!$rfc822re) {
2107 $rfc822re = make_rfc822re();
2109 # * null list items are valid according to the RFC
2110 # * the '1' business is to aid in distinguishing failure from no results
2112 my @r;
2113 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2114 $s =~ m/^$rfc822_char*$/) {
2115 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2116 push(@r, $1);
2118 return wantarray ? (scalar(@r), @r) : 1;
2120 return wantarray ? () : 0;