Merge remote-tracking branch 'remotes/palmer/tags/riscv-for-master-5.0-sf1' into...
[qemu.git] / scripts / get_maintainer.pl
1 #!/usr/bin/env perl
2 # (c) 2007, Joe Perches <joe@perches.com>
3 # created from checkpatch.pl
4 #
5 # Print selected MAINTAINERS information for
6 # the files modified in a patch or for a file
7 #
8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
9 # perl scripts/get_maintainer.pl [OPTIONS] -f <file>
10 #
11 # Licensed under the terms of the GNU GPL License version 2
12
13 use strict;
14 use warnings;
15
16 my $P = $0;
17 my $V = '0.26';
18
19 use Getopt::Long qw(:config no_auto_abbrev);
20
21 my $lk_path = "./";
22 my $email = 1;
23 my $email_usename = 1;
24 my $email_maintainer = 1;
25 my $email_reviewer = 1;
26 my $email_list = 1;
27 my $email_subscriber_list = 0;
28 my $email_git = 0;
29 my $email_git_all_signature_types = 0;
30 my $email_git_blame = 0;
31 my $email_git_blame_signatures = 1;
32 my $email_git_fallback = 1;
33 my $email_git_min_signatures = 1;
34 my $email_git_max_maintainers = 5;
35 my $email_git_min_percent = 5;
36 my $email_git_since = "1-year-ago";
37 my $email_hg_since = "-365";
38 my $interactive = 0;
39 my $email_remove_duplicates = 1;
40 my $email_use_mailmap = 1;
41 my $output_multiline = 1;
42 my $output_separator = ", ";
43 my $output_roles = 0;
44 my $output_rolestats = 1;
45 my $scm = 0;
46 my $web = 0;
47 my $subsystem = 0;
48 my $status = 0;
49 my $keywords = 1;
50 my $sections = 0;
51 my $file_emails = 0;
52 my $from_filename = 0;
53 my $pattern_depth = 0;
54 my $version = 0;
55 my $help = 0;
56
57 my $vcs_used = 0;
58
59 my $exit = 0;
60
61 my %commit_author_hash;
62 my %commit_signer_hash;
63
64 # Signature types of people who are either
65 # a) responsible for the code in question, or
66 # b) familiar enough with it to give relevant feedback
67 my @signature_tags = ();
68 push(@signature_tags, "Signed-off-by:");
69 push(@signature_tags, "Reviewed-by:");
70 push(@signature_tags, "Acked-by:");
71
72 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
73
74 # rfc822 email address - preloaded methods go here.
75 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
76 my $rfc822_char = '[\\000-\\377]';
77
78 # VCS command support: class-like functions and strings
79
80 my %VCS_cmds;
81
82 my %VCS_cmds_git = (
83 "execute_cmd" => \&git_execute_cmd,
84 "available" => '(which("git") ne "") && (-e ".git")',
85 "find_signers_cmd" =>
86 "git log --no-color --follow --since=\$email_git_since " .
87 '--format="GitCommit: %H%n' .
88 'GitAuthor: %an <%ae>%n' .
89 'GitDate: %aD%n' .
90 'GitSubject: %s%n' .
91 '%b%n"' .
92 " -- \$file",
93 "find_commit_signers_cmd" =>
94 "git log --no-color " .
95 '--format="GitCommit: %H%n' .
96 'GitAuthor: %an <%ae>%n' .
97 'GitDate: %aD%n' .
98 'GitSubject: %s%n' .
99 '%b%n"' .
100 " -1 \$commit",
101 "find_commit_author_cmd" =>
102 "git log --no-color " .
103 '--format="GitCommit: %H%n' .
104 'GitAuthor: %an <%ae>%n' .
105 'GitDate: %aD%n' .
106 'GitSubject: %s%n"' .
107 " -1 \$commit",
108 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
109 "blame_file_cmd" => "git blame -l \$file",
110 "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
111 "blame_commit_pattern" => "^([0-9a-f]+) ",
112 "author_pattern" => "^GitAuthor: (.*)",
113 "subject_pattern" => "^GitSubject: (.*)",
114 );
115
116 my %VCS_cmds_hg = (
117 "execute_cmd" => \&hg_execute_cmd,
118 "available" => '(which("hg") ne "") && (-d ".hg")',
119 "find_signers_cmd" =>
120 "hg log --date=\$email_hg_since " .
121 "--template='HgCommit: {node}\\n" .
122 "HgAuthor: {author}\\n" .
123 "HgSubject: {desc}\\n'" .
124 " -- \$file",
125 "find_commit_signers_cmd" =>
126 "hg log " .
127 "--template='HgSubject: {desc}\\n'" .
128 " -r \$commit",
129 "find_commit_author_cmd" =>
130 "hg log " .
131 "--template='HgCommit: {node}\\n" .
132 "HgAuthor: {author}\\n" .
133 "HgSubject: {desc|firstline}\\n'" .
134 " -r \$commit",
135 "blame_range_cmd" => "", # not supported
136 "blame_file_cmd" => "hg blame -n \$file",
137 "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
138 "blame_commit_pattern" => "^([ 0-9a-f]+):",
139 "author_pattern" => "^HgAuthor: (.*)",
140 "subject_pattern" => "^HgSubject: (.*)",
141 );
142
143 my $conf = which_conf(".get_maintainer.conf");
144 if (-f $conf) {
145 my @conf_args;
146 open(my $conffile, '<', "$conf")
147 or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
148
149 while (<$conffile>) {
150 my $line = $_;
151
152 $line =~ s/\s*\n?$//g;
153 $line =~ s/^\s*//g;
154 $line =~ s/\s+/ /g;
155
156 next if ($line =~ m/^\s*#/);
157 next if ($line =~ m/^\s*$/);
158
159 my @words = split(" ", $line);
160 foreach my $word (@words) {
161 last if ($word =~ m/^#/);
162 push (@conf_args, $word);
163 }
164 }
165 close($conffile);
166 unshift(@ARGV, @conf_args) if @conf_args;
167 }
168
169 if (!GetOptions(
170 'email!' => \$email,
171 'git!' => \$email_git,
172 'git-all-signature-types!' => \$email_git_all_signature_types,
173 'git-blame!' => \$email_git_blame,
174 'git-blame-signatures!' => \$email_git_blame_signatures,
175 'git-fallback!' => \$email_git_fallback,
176 'git-min-signatures=i' => \$email_git_min_signatures,
177 'git-max-maintainers=i' => \$email_git_max_maintainers,
178 'git-min-percent=i' => \$email_git_min_percent,
179 'git-since=s' => \$email_git_since,
180 'hg-since=s' => \$email_hg_since,
181 'i|interactive!' => \$interactive,
182 'remove-duplicates!' => \$email_remove_duplicates,
183 'mailmap!' => \$email_use_mailmap,
184 'm!' => \$email_maintainer,
185 'r!' => \$email_reviewer,
186 'n!' => \$email_usename,
187 'l!' => \$email_list,
188 's!' => \$email_subscriber_list,
189 'multiline!' => \$output_multiline,
190 'roles!' => \$output_roles,
191 'rolestats!' => \$output_rolestats,
192 'separator=s' => \$output_separator,
193 'subsystem!' => \$subsystem,
194 'status!' => \$status,
195 'scm!' => \$scm,
196 'web!' => \$web,
197 'pattern-depth=i' => \$pattern_depth,
198 'k|keywords!' => \$keywords,
199 'sections!' => \$sections,
200 'fe|file-emails!' => \$file_emails,
201 'f|file' => \$from_filename,
202 'v|version' => \$version,
203 'h|help|usage' => \$help,
204 )) {
205 die "$P: invalid argument - use --help if necessary\n";
206 }
207
208 if ($help != 0) {
209 usage();
210 exit 0;
211 }
212
213 if ($version != 0) {
214 print("${P} ${V}\n");
215 exit 0;
216 }
217
218 if (-t STDIN && !@ARGV) {
219 # We're talking to a terminal, but have no command line arguments.
220 die "$P: missing patchfile or -f file - use --help if necessary\n";
221 }
222
223 $output_multiline = 0 if ($output_separator ne ", ");
224 $output_rolestats = 1 if ($interactive);
225 $output_roles = 1 if ($output_rolestats);
226
227 if ($sections) {
228 $email = 0;
229 $email_list = 0;
230 $scm = 0;
231 $status = 0;
232 $subsystem = 0;
233 $web = 0;
234 $keywords = 0;
235 $interactive = 0;
236 } else {
237 my $selections = $email + $scm + $status + $subsystem + $web;
238 if ($selections == 0) {
239 die "$P: Missing required option: email, scm, status, subsystem or web\n";
240 }
241 }
242
243 if ($email &&
244 ($email_maintainer + $email_reviewer +
245 $email_list + $email_subscriber_list +
246 $email_git + $email_git_blame) == 0) {
247 die "$P: Please select at least 1 email option\n";
248 }
249
250 if (!top_of_tree($lk_path)) {
251 die "$P: The current directory does not appear to be "
252 . "a QEMU source tree.\n";
253 }
254
255 ## Read MAINTAINERS for type/value pairs
256
257 my @typevalue = ();
258 my %keyword_hash;
259
260 open (my $maint, '<', "${lk_path}MAINTAINERS")
261 or die "$P: Can't open MAINTAINERS: $!\n";
262 while (<$maint>) {
263 my $line = $_;
264
265 if ($line =~ m/^(.):\s*(.*)/) {
266 my $type = $1;
267 my $value = $2;
268
269 ##Filename pattern matching
270 if ($type eq "F" || $type eq "X") {
271 $value =~ s@\.@\\\.@g; ##Convert . to \.
272 $value =~ s/\*/\.\*/g; ##Convert * to .*
273 $value =~ s/\?/\./g; ##Convert ? to .
274 ##if pattern is a directory and it lacks a trailing slash, add one
275 if ((-d $value)) {
276 $value =~ s@([^/])$@$1/@;
277 }
278 } elsif ($type eq "K") {
279 $keyword_hash{@typevalue} = $value;
280 }
281 push(@typevalue, "$type:$value");
282 } elsif (!/^(\s)*$/) {
283 $line =~ s/\n$//g;
284 push(@typevalue, $line);
285 }
286 }
287 close($maint);
288
289
290 #
291 # Read mail address map
292 #
293
294 my $mailmap;
295
296 read_mailmap();
297
298 sub read_mailmap {
299 $mailmap = {
300 names => {},
301 addresses => {}
302 };
303
304 return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
305
306 open(my $mailmap_file, '<', "${lk_path}.mailmap")
307 or warn "$P: Can't open .mailmap: $!\n";
308
309 while (<$mailmap_file>) {
310 s/#.*$//; #strip comments
311 s/^\s+|\s+$//g; #trim
312
313 next if (/^\s*$/); #skip empty lines
314 #entries have one of the following formats:
315 # name1 <mail1>
316 # <mail1> <mail2>
317 # name1 <mail1> <mail2>
318 # name1 <mail1> name2 <mail2>
319 # (see man git-shortlog)
320
321 if (/^([^<]+)<([^>]+)>$/) {
322 my $real_name = $1;
323 my $address = $2;
324
325 $real_name =~ s/\s+$//;
326 ($real_name, $address) = parse_email("$real_name <$address>");
327 $mailmap->{names}->{$address} = $real_name;
328
329 } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
330 my $real_address = $1;
331 my $wrong_address = $2;
332
333 $mailmap->{addresses}->{$wrong_address} = $real_address;
334
335 } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
336 my $real_name = $1;
337 my $real_address = $2;
338 my $wrong_address = $3;
339
340 $real_name =~ s/\s+$//;
341 ($real_name, $real_address) =
342 parse_email("$real_name <$real_address>");
343 $mailmap->{names}->{$wrong_address} = $real_name;
344 $mailmap->{addresses}->{$wrong_address} = $real_address;
345
346 } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
347 my $real_name = $1;
348 my $real_address = $2;
349 my $wrong_name = $3;
350 my $wrong_address = $4;
351
352 $real_name =~ s/\s+$//;
353 ($real_name, $real_address) =
354 parse_email("$real_name <$real_address>");
355
356 $wrong_name =~ s/\s+$//;
357 ($wrong_name, $wrong_address) =
358 parse_email("$wrong_name <$wrong_address>");
359
360 my $wrong_email = format_email($wrong_name, $wrong_address, 1);
361 $mailmap->{names}->{$wrong_email} = $real_name;
362 $mailmap->{addresses}->{$wrong_email} = $real_address;
363 }
364 }
365 close($mailmap_file);
366 }
367
368 ## use the filenames on the command line or find the filenames in the patchfiles
369
370 my @files = ();
371 my @range = ();
372 my @keyword_tvi = ();
373 my @file_emails = ();
374
375 if (!@ARGV) {
376 push(@ARGV, "&STDIN");
377 }
378
379 foreach my $file (@ARGV) {
380 if ($file ne "&STDIN") {
381 ##if $file is a directory and it lacks a trailing slash, add one
382 if ((-d $file)) {
383 $file =~ s@([^/])$@$1/@;
384 } elsif (!(stat $file)) {
385 die "$P: file '${file}' not found: $!\n";
386 }
387 }
388 if ($from_filename) {
389 push(@files, $file);
390 if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
391 open(my $f, '<', $file)
392 or die "$P: Can't open $file: $!\n";
393 my $text = do { local($/) ; <$f> };
394 close($f);
395 if ($keywords) {
396 foreach my $line (keys %keyword_hash) {
397 if ($text =~ m/$keyword_hash{$line}/x) {
398 push(@keyword_tvi, $line);
399 }
400 }
401 }
402 if ($file_emails) {
403 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;
404 push(@file_emails, clean_file_emails(@poss_addr));
405 }
406 }
407 } else {
408 my $file_cnt = @files;
409 my $lastfile;
410
411 open(my $patch, "< $file")
412 or die "$P: Can't open $file: $!\n";
413
414 # We can check arbitrary information before the patch
415 # like the commit message, mail headers, etc...
416 # This allows us to match arbitrary keywords against any part
417 # of a git format-patch generated file (subject tags, etc...)
418
419 my $patch_prefix = ""; #Parsing the intro
420
421 while (<$patch>) {
422 my $patch_line = $_;
423 if (m/^\+\+\+\s+(\S+)/) {
424 my $filename = $1;
425 $filename =~ s@^[^/]*/@@;
426 $filename =~ s@\n@@;
427 $lastfile = $filename;
428 push(@files, $filename);
429 $patch_prefix = "^[+-].*"; #Now parsing the actual patch
430 } elsif (m/^\@\@ -(\d+),(\d+)/) {
431 if ($email_git_blame) {
432 push(@range, "$lastfile:$1:$2");
433 }
434 } elsif ($keywords) {
435 foreach my $line (keys %keyword_hash) {
436 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
437 push(@keyword_tvi, $line);
438 }
439 }
440 }
441 }
442 close($patch);
443
444 if ($file_cnt == @files) {
445 warn "$P: file '${file}' doesn't appear to be a patch. "
446 . "Add -f to options?\n";
447 }
448 @files = sort_and_uniq(@files);
449 }
450 }
451
452 @file_emails = uniq(@file_emails);
453
454 my %email_hash_name;
455 my %email_hash_address;
456 my @email_to = ();
457 my %hash_list_to;
458 my @list_to = ();
459 my @scm = ();
460 my @web = ();
461 my @subsystem = ();
462 my @status = ();
463 my %deduplicate_name_hash = ();
464 my %deduplicate_address_hash = ();
465
466 my @maintainers = get_maintainers();
467
468 if (@maintainers) {
469 @maintainers = merge_email(@maintainers);
470 output(@maintainers);
471 }
472
473 if ($scm) {
474 @scm = uniq(@scm);
475 output(@scm);
476 }
477
478 if ($status) {
479 @status = uniq(@status);
480 output(@status);
481 }
482
483 if ($subsystem) {
484 @subsystem = uniq(@subsystem);
485 output(@subsystem);
486 }
487
488 if ($web) {
489 @web = uniq(@web);
490 output(@web);
491 }
492
493 exit($exit);
494
495 sub range_is_maintained {
496 my ($start, $end) = @_;
497
498 for (my $i = $start; $i < $end; $i++) {
499 my $line = $typevalue[$i];
500 if ($line =~ m/^(.):\s*(.*)/) {
501 my $type = $1;
502 my $value = $2;
503 if ($type eq 'S') {
504 if ($value =~ /(maintain|support)/i) {
505 return 1;
506 }
507 }
508 }
509 }
510 return 0;
511 }
512
513 sub range_has_maintainer {
514 my ($start, $end) = @_;
515
516 for (my $i = $start; $i < $end; $i++) {
517 my $line = $typevalue[$i];
518 if ($line =~ m/^(.):\s*(.*)/) {
519 my $type = $1;
520 my $value = $2;
521 if ($type eq 'M') {
522 return 1;
523 }
524 }
525 }
526 return 0;
527 }
528
529 sub get_maintainers {
530 %email_hash_name = ();
531 %email_hash_address = ();
532 %commit_author_hash = ();
533 %commit_signer_hash = ();
534 @email_to = ();
535 %hash_list_to = ();
536 @list_to = ();
537 @scm = ();
538 @web = ();
539 @subsystem = ();
540 @status = ();
541 %deduplicate_name_hash = ();
542 %deduplicate_address_hash = ();
543 if ($email_git_all_signature_types) {
544 $signature_pattern = "(.+?)[Bb][Yy]:";
545 } else {
546 $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
547 }
548
549 # Find responsible parties
550
551 my %exact_pattern_match_hash = ();
552
553 foreach my $file (@files) {
554
555 my %hash;
556 my $tvi = find_first_section();
557 while ($tvi < @typevalue) {
558 my $start = find_starting_index($tvi);
559 my $end = find_ending_index($tvi);
560 my $exclude = 0;
561 my $i;
562
563 #Do not match excluded file patterns
564
565 for ($i = $start; $i < $end; $i++) {
566 my $line = $typevalue[$i];
567 if ($line =~ m/^(.):\s*(.*)/) {
568 my $type = $1;
569 my $value = $2;
570 if ($type eq 'X') {
571 if (file_match_pattern($file, $value)) {
572 $exclude = 1;
573 last;
574 }
575 }
576 }
577 }
578
579 if (!$exclude) {
580 for ($i = $start; $i < $end; $i++) {
581 my $line = $typevalue[$i];
582 if ($line =~ m/^(.):\s*(.*)/) {
583 my $type = $1;
584 my $value = $2;
585 if ($type eq 'F') {
586 if (file_match_pattern($file, $value)) {
587 my $value_pd = ($value =~ tr@/@@);
588 my $file_pd = ($file =~ tr@/@@);
589 $value_pd++ if (substr($value,-1,1) ne "/");
590 $value_pd = -1 if ($value =~ /^\.\*/);
591 if ($value_pd >= $file_pd &&
592 range_is_maintained($start, $end) &&
593 range_has_maintainer($start, $end)) {
594 $exact_pattern_match_hash{$file} = 1;
595 }
596 if ($pattern_depth == 0 ||
597 (($file_pd - $value_pd) < $pattern_depth)) {
598 $hash{$tvi} = $value_pd;
599 }
600 }
601 }
602 }
603 }
604 }
605 $tvi = $end + 1;
606 }
607
608 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
609 add_categories($line);
610 if ($sections) {
611 my $i;
612 my $start = find_starting_index($line);
613 my $end = find_ending_index($line);
614 for ($i = $start; $i < $end; $i++) {
615 my $line = $typevalue[$i];
616 if ($line =~ /^[FX]:/) { ##Restore file patterns
617 $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
618 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
619 $line =~ s/\\\./\./g; ##Convert \. to .
620 $line =~ s/\.\*/\*/g; ##Convert .* to *
621 }
622 $line =~ s/^([A-Z]):/$1:\t/g;
623 print("$line\n");
624 }
625 print("\n");
626 }
627 }
628 }
629
630 if ($keywords) {
631 @keyword_tvi = sort_and_uniq(@keyword_tvi);
632 foreach my $line (@keyword_tvi) {
633 add_categories($line);
634 }
635 }
636
637 foreach my $email (@email_to, @list_to) {
638 $email->[0] = deduplicate_email($email->[0]);
639 }
640
641 if ($email) {
642 if (! $interactive) {
643 $email_git_fallback = 0 if @email_to > 0 || $email_git || $email_git_blame;
644 if ($email_git_fallback) {
645 print STDERR "get_maintainer.pl: No maintainers found, printing recent contributors.\n";
646 print STDERR "get_maintainer.pl: Do not blindly cc: them on patches! Use common sense.\n";
647 print STDERR "\n";
648 }
649 }
650
651 foreach my $file (@files) {
652 if ($email_git || ($email_git_fallback &&
653 !$exact_pattern_match_hash{$file})) {
654 vcs_file_signoffs($file);
655 }
656 if ($email_git_blame) {
657 vcs_file_blame($file);
658 }
659 }
660
661 foreach my $email (@file_emails) {
662 my ($name, $address) = parse_email($email);
663
664 my $tmp_email = format_email($name, $address, $email_usename);
665 push_email_address($tmp_email, '');
666 add_role($tmp_email, 'in file');
667 }
668 }
669
670 my @to = ();
671 if ($email || $email_list) {
672 if ($email) {
673 @to = (@to, @email_to);
674 }
675 if ($email_list) {
676 @to = (@to, @list_to);
677 }
678 }
679
680 if ($interactive) {
681 @to = interactive_get_maintainers(\@to);
682 }
683
684 return @to;
685 }
686
687 sub file_match_pattern {
688 my ($file, $pattern) = @_;
689 if (substr($pattern, -1) eq "/") {
690 if ($file =~ m@^$pattern@) {
691 return 1;
692 }
693 } else {
694 if ($file =~ m@^$pattern@) {
695 my $s1 = ($file =~ tr@/@@);
696 my $s2 = ($pattern =~ tr@/@@);
697 if ($s1 == $s2) {
698 return 1;
699 }
700 }
701 }
702 return 0;
703 }
704
705 sub usage {
706 print <<EOT;
707 usage: $P [options] patchfile
708 $P [options] -f file|directory
709 version: $V
710
711 MAINTAINER field selection options:
712 --email => print email address(es) if any
713 --git => include recent git \*-by: signers
714 --git-all-signature-types => include signers regardless of signature type
715 or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
716 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
717 --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
718 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
719 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
720 --git-blame => use git blame to find modified commits for patch or file
721 --git-since => git history to use (default: $email_git_since)
722 --hg-since => hg history to use (default: $email_hg_since)
723 --interactive => display a menu (mostly useful if used with the --git option)
724 --m => include maintainer(s) if any
725 --r => include reviewer(s) if any
726 --n => include name 'Full Name <addr\@domain.tld>'
727 --l => include list(s) if any
728 --s => include subscriber only list(s) if any
729 --remove-duplicates => minimize duplicate email names/addresses
730 --roles => show roles (status:subsystem, git-signer, list, etc...)
731 --rolestats => show roles and statistics (commits/total_commits, %)
732 --file-emails => add email addresses found in -f file (default: 0 (off))
733 --scm => print SCM tree(s) if any
734 --status => print status if any
735 --subsystem => print subsystem name if any
736 --web => print website(s) if any
737
738 Output type options:
739 --separator [, ] => separator for multiple entries on 1 line
740 using --separator also sets --nomultiline if --separator is not [, ]
741 --multiline => print 1 entry per line
742
743 Other options:
744 --pattern-depth => Number of pattern directory traversals (default: 0 (all))
745 --keywords => scan patch for keywords (default: $keywords)
746 --sections => print all of the subsystem sections with pattern matches
747 --mailmap => use .mailmap file (default: $email_use_mailmap)
748 --version => show version
749 --help => show this help information
750
751 Default options:
752 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
753 --remove-duplicates --rolestats]
754
755 Notes:
756 Using "-f directory" may give unexpected results:
757 Used with "--git", git signators for _all_ files in and below
758 directory are examined as git recurses directories.
759 Any specified X: (exclude) pattern matches are _not_ ignored.
760 Used with "--nogit", directory is used as a pattern match,
761 no individual file within the directory or subdirectory
762 is matched.
763 Used with "--git-blame", does not iterate all files in directory
764 Using "--git-blame" is slow and may add old committers and authors
765 that are no longer active maintainers to the output.
766 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
767 other automated tools that expect only ["name"] <email address>
768 may not work because of additional output after <email address>.
769 Using "--rolestats" and "--git-blame" shows the #/total=% commits,
770 not the percentage of the entire file authored. # of commits is
771 not a good measure of amount of code authored. 1 major commit may
772 contain a thousand lines, 5 trivial commits may modify a single line.
773 If git is not installed, but mercurial (hg) is installed and an .hg
774 repository exists, the following options apply to mercurial:
775 --git,
776 --git-min-signatures, --git-max-maintainers, --git-min-percent, and
777 --git-blame
778 Use --hg-since not --git-since to control date selection
779 File ".get_maintainer.conf", if it exists in the QEMU source root
780 directory, can change whatever get_maintainer defaults are desired.
781 Entries in this file can be any command line argument.
782 This file is prepended to any additional command line arguments.
783 Multiple lines and # comments are allowed.
784 EOT
785 }
786
787 sub top_of_tree {
788 my ($lk_path) = @_;
789
790 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
791 $lk_path .= "/";
792 }
793 if ( (-f "${lk_path}COPYING")
794 && (-f "${lk_path}MAINTAINERS")
795 && (-f "${lk_path}Makefile")
796 && (-d "${lk_path}docs")
797 && (-f "${lk_path}VERSION")
798 && (-f "${lk_path}vl.c")) {
799 return 1;
800 }
801 return 0;
802 }
803
804 sub parse_email {
805 my ($formatted_email) = @_;
806
807 my $name = "";
808 my $address = "";
809
810 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
811 $name = $1;
812 $address = $2;
813 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
814 $address = $1;
815 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
816 $address = $1;
817 }
818
819 $name =~ s/^\s+|\s+$//g;
820 $name =~ s/^\"|\"$//g;
821 $address =~ s/^\s+|\s+$//g;
822
823 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
824 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
825 $name = "\"$name\"";
826 }
827
828 return ($name, $address);
829 }
830
831 sub format_email {
832 my ($name, $address, $usename) = @_;
833
834 my $formatted_email;
835
836 $name =~ s/^\s+|\s+$//g;
837 $name =~ s/^\"|\"$//g;
838 $address =~ s/^\s+|\s+$//g;
839
840 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
841 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
842 $name = "\"$name\"";
843 }
844
845 if ($usename) {
846 if ("$name" eq "") {
847 $formatted_email = "$address";
848 } else {
849 $formatted_email = "$name <$address>";
850 }
851 } else {
852 $formatted_email = $address;
853 }
854
855 return $formatted_email;
856 }
857
858 sub find_first_section {
859 my $index = 0;
860
861 while ($index < @typevalue) {
862 my $tv = $typevalue[$index];
863 if (($tv =~ m/^(.):\s*(.*)/)) {
864 last;
865 }
866 $index++;
867 }
868
869 return $index;
870 }
871
872 sub find_starting_index {
873 my ($index) = @_;
874
875 while ($index > 0) {
876 my $tv = $typevalue[$index];
877 if (!($tv =~ m/^(.):\s*(.*)/)) {
878 last;
879 }
880 $index--;
881 }
882
883 return $index;
884 }
885
886 sub find_ending_index {
887 my ($index) = @_;
888
889 while ($index < @typevalue) {
890 my $tv = $typevalue[$index];
891 if (!($tv =~ m/^(.):\s*(.*)/)) {
892 last;
893 }
894 $index++;
895 }
896
897 return $index;
898 }
899
900 sub get_subsystem_name {
901 my ($index) = @_;
902
903 my $start = find_starting_index($index);
904
905 my $subsystem = $typevalue[$start];
906 if (length($subsystem) > 20) {
907 $subsystem = substr($subsystem, 0, 17);
908 $subsystem =~ s/\s*$//;
909 $subsystem = $subsystem . "...";
910 }
911 return $subsystem;
912 }
913
914 sub get_maintainer_role {
915 my ($index) = @_;
916
917 my $i;
918 my $start = find_starting_index($index);
919 my $end = find_ending_index($index);
920
921 my $role = "unknown";
922 my $subsystem = get_subsystem_name($index);
923
924 for ($i = $start + 1; $i < $end; $i++) {
925 my $tv = $typevalue[$i];
926 if ($tv =~ m/^(.):\s*(.*)/) {
927 my $ptype = $1;
928 my $pvalue = $2;
929 if ($ptype eq "S") {
930 $role = $pvalue;
931 }
932 }
933 }
934
935 $role = lc($role);
936 if ($role eq "supported") {
937 $role = "supporter";
938 } elsif ($role eq "maintained") {
939 $role = "maintainer";
940 } elsif ($role eq "odd fixes") {
941 $role = "odd fixer";
942 } elsif ($role eq "orphan") {
943 $role = "orphan minder";
944 } elsif ($role eq "obsolete") {
945 $role = "obsolete minder";
946 } elsif ($role eq "buried alive in reporters") {
947 $role = "chief penguin";
948 }
949
950 return $role . ":" . $subsystem;
951 }
952
953 sub get_list_role {
954 my ($index) = @_;
955
956 my $subsystem = get_subsystem_name($index);
957
958 if ($subsystem eq "THE REST") {
959 $subsystem = "";
960 }
961
962 return $subsystem;
963 }
964
965 sub add_categories {
966 my ($index) = @_;
967
968 my $i;
969 my $start = find_starting_index($index);
970 my $end = find_ending_index($index);
971
972 push(@subsystem, $typevalue[$start]);
973
974 for ($i = $start + 1; $i < $end; $i++) {
975 my $tv = $typevalue[$i];
976 if ($tv =~ m/^(.):\s*(.*)/) {
977 my $ptype = $1;
978 my $pvalue = $2;
979 if ($ptype eq "L") {
980 my $list_address = $pvalue;
981 my $list_additional = "";
982 my $list_role = get_list_role($i);
983
984 if ($list_role ne "") {
985 $list_role = ":" . $list_role;
986 }
987 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
988 $list_address = $1;
989 $list_additional = $2;
990 }
991 if ($list_additional =~ m/subscribers-only/) {
992 if ($email_subscriber_list) {
993 if (!$hash_list_to{lc($list_address)}) {
994 $hash_list_to{lc($list_address)} = 1;
995 push(@list_to, [$list_address,
996 "subscriber list${list_role}"]);
997 }
998 }
999 } else {
1000 if ($email_list) {
1001 if (!$hash_list_to{lc($list_address)}) {
1002 $hash_list_to{lc($list_address)} = 1;
1003 if ($list_additional =~ m/moderated/) {
1004 push(@list_to, [$list_address,
1005 "moderated list${list_role}"]);
1006 } else {
1007 push(@list_to, [$list_address,
1008 "open list${list_role}"]);
1009 }
1010 }
1011 }
1012 }
1013 } elsif ($ptype eq "M") {
1014 my ($name, $address) = parse_email($pvalue);
1015 if ($name eq "") {
1016 if ($i > 0) {
1017 my $tv = $typevalue[$i - 1];
1018 if ($tv =~ m/^(.):\s*(.*)/) {
1019 if ($1 eq "P") {
1020 $name = $2;
1021 $pvalue = format_email($name, $address, $email_usename);
1022 }
1023 }
1024 }
1025 }
1026 if ($email_maintainer) {
1027 my $role = get_maintainer_role($i);
1028 push_email_addresses($pvalue, $role);
1029 }
1030 } elsif ($ptype eq "R") {
1031 my ($name, $address) = parse_email($pvalue);
1032 if ($name eq "") {
1033 if ($i > 0) {
1034 my $tv = $typevalue[$i - 1];
1035 if ($tv =~ m/^(.):\s*(.*)/) {
1036 if ($1 eq "P") {
1037 $name = $2;
1038 $pvalue = format_email($name, $address, $email_usename);
1039 }
1040 }
1041 }
1042 }
1043 if ($email_reviewer) {
1044 my $subsystem = get_subsystem_name($i);
1045 push_email_addresses($pvalue, "reviewer:$subsystem");
1046 }
1047 } elsif ($ptype eq "T") {
1048 push(@scm, $pvalue);
1049 } elsif ($ptype eq "W") {
1050 push(@web, $pvalue);
1051 } elsif ($ptype eq "S") {
1052 push(@status, $pvalue);
1053 }
1054 }
1055 }
1056 }
1057
1058 sub email_inuse {
1059 my ($name, $address) = @_;
1060
1061 return 1 if (($name eq "") && ($address eq ""));
1062 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1063 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1064
1065 return 0;
1066 }
1067
1068 sub push_email_address {
1069 my ($line, $role) = @_;
1070
1071 my ($name, $address) = parse_email($line);
1072
1073 if ($address eq "") {
1074 return 0;
1075 }
1076
1077 if (!$email_remove_duplicates) {
1078 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1079 } elsif (!email_inuse($name, $address)) {
1080 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1081 $email_hash_name{lc($name)}++ if ($name ne "");
1082 $email_hash_address{lc($address)}++;
1083 }
1084
1085 return 1;
1086 }
1087
1088 sub push_email_addresses {
1089 my ($address, $role) = @_;
1090
1091 my @address_list = ();
1092
1093 if (rfc822_valid($address)) {
1094 push_email_address($address, $role);
1095 } elsif (@address_list = rfc822_validlist($address)) {
1096 my $array_count = shift(@address_list);
1097 while (my $entry = shift(@address_list)) {
1098 push_email_address($entry, $role);
1099 }
1100 } else {
1101 if (!push_email_address($address, $role)) {
1102 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1103 }
1104 }
1105 }
1106
1107 sub add_role {
1108 my ($line, $role) = @_;
1109
1110 my ($name, $address) = parse_email($line);
1111 my $email = format_email($name, $address, $email_usename);
1112
1113 foreach my $entry (@email_to) {
1114 if ($email_remove_duplicates) {
1115 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1116 if (($name eq $entry_name || $address eq $entry_address)
1117 && ($role eq "" || !($entry->[1] =~ m/$role/))
1118 ) {
1119 if ($entry->[1] eq "") {
1120 $entry->[1] = "$role";
1121 } else {
1122 $entry->[1] = "$entry->[1],$role";
1123 }
1124 }
1125 } else {
1126 if ($email eq $entry->[0]
1127 && ($role eq "" || !($entry->[1] =~ m/$role/))
1128 ) {
1129 if ($entry->[1] eq "") {
1130 $entry->[1] = "$role";
1131 } else {
1132 $entry->[1] = "$entry->[1],$role";
1133 }
1134 }
1135 }
1136 }
1137 }
1138
1139 sub which {
1140 my ($bin) = @_;
1141
1142 foreach my $path (split(/:/, $ENV{PATH})) {
1143 if (-e "$path/$bin") {
1144 return "$path/$bin";
1145 }
1146 }
1147
1148 return "";
1149 }
1150
1151 sub which_conf {
1152 my ($conf) = @_;
1153
1154 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1155 if (-e "$path/$conf") {
1156 return "$path/$conf";
1157 }
1158 }
1159
1160 return "";
1161 }
1162
1163 sub mailmap_email {
1164 my ($line) = @_;
1165
1166 my ($name, $address) = parse_email($line);
1167 my $email = format_email($name, $address, 1);
1168 my $real_name = $name;
1169 my $real_address = $address;
1170
1171 if (exists $mailmap->{names}->{$email} ||
1172 exists $mailmap->{addresses}->{$email}) {
1173 if (exists $mailmap->{names}->{$email}) {
1174 $real_name = $mailmap->{names}->{$email};
1175 }
1176 if (exists $mailmap->{addresses}->{$email}) {
1177 $real_address = $mailmap->{addresses}->{$email};
1178 }
1179 } else {
1180 if (exists $mailmap->{names}->{$address}) {
1181 $real_name = $mailmap->{names}->{$address};
1182 }
1183 if (exists $mailmap->{addresses}->{$address}) {
1184 $real_address = $mailmap->{addresses}->{$address};
1185 }
1186 }
1187 return format_email($real_name, $real_address, 1);
1188 }
1189
1190 sub mailmap {
1191 my (@addresses) = @_;
1192
1193 my @mapped_emails = ();
1194 foreach my $line (@addresses) {
1195 push(@mapped_emails, mailmap_email($line));
1196 }
1197 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1198 return @mapped_emails;
1199 }
1200
1201 sub merge_by_realname {
1202 my %address_map;
1203 my (@emails) = @_;
1204
1205 foreach my $email (@emails) {
1206 my ($name, $address) = parse_email($email);
1207 if (exists $address_map{$name}) {
1208 $address = $address_map{$name};
1209 $email = format_email($name, $address, 1);
1210 } else {
1211 $address_map{$name} = $address;
1212 }
1213 }
1214 }
1215
1216 sub git_execute_cmd {
1217 my ($cmd) = @_;
1218 my @lines = ();
1219
1220 my $output = `$cmd`;
1221 $output =~ s/^\s*//gm;
1222 @lines = split("\n", $output);
1223
1224 return @lines;
1225 }
1226
1227 sub hg_execute_cmd {
1228 my ($cmd) = @_;
1229 my @lines = ();
1230
1231 my $output = `$cmd`;
1232 @lines = split("\n", $output);
1233
1234 return @lines;
1235 }
1236
1237 sub extract_formatted_signatures {
1238 my (@signature_lines) = @_;
1239
1240 my @type = @signature_lines;
1241
1242 s/\s*(.*):.*/$1/ for (@type);
1243
1244 # cut -f2- -d":"
1245 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1246
1247 ## Reformat email addresses (with names) to avoid badly written signatures
1248
1249 foreach my $signer (@signature_lines) {
1250 $signer = deduplicate_email($signer);
1251 }
1252
1253 return (\@type, \@signature_lines);
1254 }
1255
1256 sub vcs_find_signers {
1257 my ($cmd) = @_;
1258 my $commits;
1259 my @lines = ();
1260 my @signatures = ();
1261
1262 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1263
1264 my $pattern = $VCS_cmds{"commit_pattern"};
1265
1266 $commits = grep(/$pattern/, @lines); # of commits
1267
1268 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1269
1270 return (0, @signatures) if !@signatures;
1271
1272 save_commits_by_author(@lines) if ($interactive);
1273 save_commits_by_signer(@lines) if ($interactive);
1274
1275 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1276
1277 return ($commits, @$signers_ref);
1278 }
1279
1280 sub vcs_find_author {
1281 my ($cmd) = @_;
1282 my @lines = ();
1283
1284 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1285
1286 return @lines if !@lines;
1287
1288 my @authors = ();
1289 foreach my $line (@lines) {
1290 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1291 my $author = $1;
1292 my ($name, $address) = parse_email($author);
1293 $author = format_email($name, $address, 1);
1294 push(@authors, $author);
1295 }
1296 }
1297
1298 save_commits_by_author(@lines) if ($interactive);
1299 save_commits_by_signer(@lines) if ($interactive);
1300
1301 return @authors;
1302 }
1303
1304 sub vcs_save_commits {
1305 my ($cmd) = @_;
1306 my @lines = ();
1307 my @commits = ();
1308
1309 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1310
1311 foreach my $line (@lines) {
1312 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1313 push(@commits, $1);
1314 }
1315 }
1316
1317 return @commits;
1318 }
1319
1320 sub vcs_blame {
1321 my ($file) = @_;
1322 my $cmd;
1323 my @commits = ();
1324
1325 return @commits if (!(-f $file));
1326
1327 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1328 my @all_commits = ();
1329
1330 $cmd = $VCS_cmds{"blame_file_cmd"};
1331 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1332 @all_commits = vcs_save_commits($cmd);
1333
1334 foreach my $file_range_diff (@range) {
1335 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1336 my $diff_file = $1;
1337 my $diff_start = $2;
1338 my $diff_length = $3;
1339 next if ("$file" ne "$diff_file");
1340 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1341 push(@commits, $all_commits[$i]);
1342 }
1343 }
1344 } elsif (@range) {
1345 foreach my $file_range_diff (@range) {
1346 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1347 my $diff_file = $1;
1348 my $diff_start = $2;
1349 my $diff_length = $3;
1350 next if ("$file" ne "$diff_file");
1351 $cmd = $VCS_cmds{"blame_range_cmd"};
1352 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1353 push(@commits, vcs_save_commits($cmd));
1354 }
1355 } else {
1356 $cmd = $VCS_cmds{"blame_file_cmd"};
1357 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1358 @commits = vcs_save_commits($cmd);
1359 }
1360
1361 foreach my $commit (@commits) {
1362 $commit =~ s/^\^//g;
1363 }
1364
1365 return @commits;
1366 }
1367
1368 my $printed_novcs = 0;
1369 sub vcs_exists {
1370 %VCS_cmds = %VCS_cmds_git;
1371 return 1 if eval $VCS_cmds{"available"};
1372 %VCS_cmds = %VCS_cmds_hg;
1373 return 2 if eval $VCS_cmds{"available"};
1374 %VCS_cmds = ();
1375 if (!$printed_novcs) {
1376 warn("$P: No supported VCS found. Add --nogit to options?\n");
1377 warn("Using a git repository produces better results.\n");
1378 warn("Try latest git repository using:\n");
1379 warn("git clone https://git.qemu.org/git/qemu.git\n");
1380 $printed_novcs = 1;
1381 }
1382 return 0;
1383 }
1384
1385 sub vcs_is_git {
1386 vcs_exists();
1387 return $vcs_used == 1;
1388 }
1389
1390 sub vcs_is_hg {
1391 return $vcs_used == 2;
1392 }
1393
1394 sub interactive_get_maintainers {
1395 my ($list_ref) = @_;
1396 my @list = @$list_ref;
1397
1398 vcs_exists();
1399
1400 my %selected;
1401 my %authored;
1402 my %signed;
1403 my $count = 0;
1404 my $maintained = 0;
1405 foreach my $entry (@list) {
1406 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1407 $selected{$count} = 1;
1408 $authored{$count} = 0;
1409 $signed{$count} = 0;
1410 $count++;
1411 }
1412
1413 #menu loop
1414 my $done = 0;
1415 my $print_options = 0;
1416 my $redraw = 1;
1417 while (!$done) {
1418 $count = 0;
1419 if ($redraw) {
1420 printf STDERR "\n%1s %2s %-65s",
1421 "*", "#", "email/list and role:stats";
1422 if ($email_git ||
1423 ($email_git_fallback && !$maintained) ||
1424 $email_git_blame) {
1425 print STDERR "auth sign";
1426 }
1427 print STDERR "\n";
1428 foreach my $entry (@list) {
1429 my $email = $entry->[0];
1430 my $role = $entry->[1];
1431 my $sel = "";
1432 $sel = "*" if ($selected{$count});
1433 my $commit_author = $commit_author_hash{$email};
1434 my $commit_signer = $commit_signer_hash{$email};
1435 my $authored = 0;
1436 my $signed = 0;
1437 $authored++ for (@{$commit_author});
1438 $signed++ for (@{$commit_signer});
1439 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1440 printf STDERR "%4d %4d", $authored, $signed
1441 if ($authored > 0 || $signed > 0);
1442 printf STDERR "\n %s\n", $role;
1443 if ($authored{$count}) {
1444 my $commit_author = $commit_author_hash{$email};
1445 foreach my $ref (@{$commit_author}) {
1446 print STDERR " Author: @{$ref}[1]\n";
1447 }
1448 }
1449 if ($signed{$count}) {
1450 my $commit_signer = $commit_signer_hash{$email};
1451 foreach my $ref (@{$commit_signer}) {
1452 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1453 }
1454 }
1455
1456 $count++;
1457 }
1458 }
1459 my $date_ref = \$email_git_since;
1460 $date_ref = \$email_hg_since if (vcs_is_hg());
1461 if ($print_options) {
1462 $print_options = 0;
1463 if (vcs_exists()) {
1464 print STDERR <<EOT
1465
1466 Version Control options:
1467 g use git history [$email_git]
1468 gf use git-fallback [$email_git_fallback]
1469 b use git blame [$email_git_blame]
1470 bs use blame signatures [$email_git_blame_signatures]
1471 c# minimum commits [$email_git_min_signatures]
1472 %# min percent [$email_git_min_percent]
1473 d# history to use [$$date_ref]
1474 x# max maintainers [$email_git_max_maintainers]
1475 t all signature types [$email_git_all_signature_types]
1476 m use .mailmap [$email_use_mailmap]
1477 EOT
1478 }
1479 print STDERR <<EOT
1480
1481 Additional options:
1482 0 toggle all
1483 tm toggle maintainers
1484 tg toggle git entries
1485 tl toggle open list entries
1486 ts toggle subscriber list entries
1487 f emails in file [$file_emails]
1488 k keywords in file [$keywords]
1489 r remove duplicates [$email_remove_duplicates]
1490 p# pattern match depth [$pattern_depth]
1491 EOT
1492 }
1493 print STDERR
1494 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1495
1496 my $input = <STDIN>;
1497 chomp($input);
1498
1499 $redraw = 1;
1500 my $rerun = 0;
1501 my @wish = split(/[, ]+/, $input);
1502 foreach my $nr (@wish) {
1503 $nr = lc($nr);
1504 my $sel = substr($nr, 0, 1);
1505 my $str = substr($nr, 1);
1506 my $val = 0;
1507 $val = $1 if $str =~ /^(\d+)$/;
1508
1509 if ($sel eq "y") {
1510 $interactive = 0;
1511 $done = 1;
1512 $output_rolestats = 0;
1513 $output_roles = 0;
1514 last;
1515 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1516 $selected{$nr - 1} = !$selected{$nr - 1};
1517 } elsif ($sel eq "*" || $sel eq '^') {
1518 my $toggle = 0;
1519 $toggle = 1 if ($sel eq '*');
1520 for (my $i = 0; $i < $count; $i++) {
1521 $selected{$i} = $toggle;
1522 }
1523 } elsif ($sel eq "0") {
1524 for (my $i = 0; $i < $count; $i++) {
1525 $selected{$i} = !$selected{$i};
1526 }
1527 } elsif ($sel eq "t") {
1528 if (lc($str) eq "m") {
1529 for (my $i = 0; $i < $count; $i++) {
1530 $selected{$i} = !$selected{$i}
1531 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1532 }
1533 } elsif (lc($str) eq "g") {
1534 for (my $i = 0; $i < $count; $i++) {
1535 $selected{$i} = !$selected{$i}
1536 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1537 }
1538 } elsif (lc($str) eq "l") {
1539 for (my $i = 0; $i < $count; $i++) {
1540 $selected{$i} = !$selected{$i}
1541 if ($list[$i]->[1] =~ /^(open list)/i);
1542 }
1543 } elsif (lc($str) eq "s") {
1544 for (my $i = 0; $i < $count; $i++) {
1545 $selected{$i} = !$selected{$i}
1546 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1547 }
1548 }
1549 } elsif ($sel eq "a") {
1550 if ($val > 0 && $val <= $count) {
1551 $authored{$val - 1} = !$authored{$val - 1};
1552 } elsif ($str eq '*' || $str eq '^') {
1553 my $toggle = 0;
1554 $toggle = 1 if ($str eq '*');
1555 for (my $i = 0; $i < $count; $i++) {
1556 $authored{$i} = $toggle;
1557 }
1558 }
1559 } elsif ($sel eq "s") {
1560 if ($val > 0 && $val <= $count) {
1561 $signed{$val - 1} = !$signed{$val - 1};
1562 } elsif ($str eq '*' || $str eq '^') {
1563 my $toggle = 0;
1564 $toggle = 1 if ($str eq '*');
1565 for (my $i = 0; $i < $count; $i++) {
1566 $signed{$i} = $toggle;
1567 }
1568 }
1569 } elsif ($sel eq "o") {
1570 $print_options = 1;
1571 $redraw = 1;
1572 } elsif ($sel eq "g") {
1573 if ($str eq "f") {
1574 bool_invert(\$email_git_fallback);
1575 } else {
1576 bool_invert(\$email_git);
1577 }
1578 $rerun = 1;
1579 } elsif ($sel eq "b") {
1580 if ($str eq "s") {
1581 bool_invert(\$email_git_blame_signatures);
1582 } else {
1583 bool_invert(\$email_git_blame);
1584 }
1585 $rerun = 1;
1586 } elsif ($sel eq "c") {
1587 if ($val > 0) {
1588 $email_git_min_signatures = $val;
1589 $rerun = 1;
1590 }
1591 } elsif ($sel eq "x") {
1592 if ($val > 0) {
1593 $email_git_max_maintainers = $val;
1594 $rerun = 1;
1595 }
1596 } elsif ($sel eq "%") {
1597 if ($str ne "" && $val >= 0) {
1598 $email_git_min_percent = $val;
1599 $rerun = 1;
1600 }
1601 } elsif ($sel eq "d") {
1602 if (vcs_is_git()) {
1603 $email_git_since = $str;
1604 } elsif (vcs_is_hg()) {
1605 $email_hg_since = $str;
1606 }
1607 $rerun = 1;
1608 } elsif ($sel eq "t") {
1609 bool_invert(\$email_git_all_signature_types);
1610 $rerun = 1;
1611 } elsif ($sel eq "f") {
1612 bool_invert(\$file_emails);
1613 $rerun = 1;
1614 } elsif ($sel eq "r") {
1615 bool_invert(\$email_remove_duplicates);
1616 $rerun = 1;
1617 } elsif ($sel eq "m") {
1618 bool_invert(\$email_use_mailmap);
1619 read_mailmap();
1620 $rerun = 1;
1621 } elsif ($sel eq "k") {
1622 bool_invert(\$keywords);
1623 $rerun = 1;
1624 } elsif ($sel eq "p") {
1625 if ($str ne "" && $val >= 0) {
1626 $pattern_depth = $val;
1627 $rerun = 1;
1628 }
1629 } elsif ($sel eq "h" || $sel eq "?") {
1630 print STDERR <<EOT
1631
1632 Interactive mode allows you to select the various maintainers, submitters,
1633 commit signers and mailing lists that could be CC'd on a patch.
1634
1635 Any *'d entry is selected.
1636
1637 If you have git or hg installed, you can choose to summarize the commit
1638 history of files in the patch. Also, each line of the current file can
1639 be matched to its commit author and that commits signers with blame.
1640
1641 Various knobs exist to control the length of time for active commit
1642 tracking, the maximum number of commit authors and signers to add,
1643 and such.
1644
1645 Enter selections at the prompt until you are satisfied that the selected
1646 maintainers are appropriate. You may enter multiple selections separated
1647 by either commas or spaces.
1648
1649 EOT
1650 } else {
1651 print STDERR "invalid option: '$nr'\n";
1652 $redraw = 0;
1653 }
1654 }
1655 if ($rerun) {
1656 print STDERR "git-blame can be very slow, please have patience..."
1657 if ($email_git_blame);
1658 goto &get_maintainers;
1659 }
1660 }
1661
1662 #drop not selected entries
1663 $count = 0;
1664 my @new_emailto = ();
1665 foreach my $entry (@list) {
1666 if ($selected{$count}) {
1667 push(@new_emailto, $list[$count]);
1668 }
1669 $count++;
1670 }
1671 return @new_emailto;
1672 }
1673
1674 sub bool_invert {
1675 my ($bool_ref) = @_;
1676
1677 if ($$bool_ref) {
1678 $$bool_ref = 0;
1679 } else {
1680 $$bool_ref = 1;
1681 }
1682 }
1683
1684 sub deduplicate_email {
1685 my ($email) = @_;
1686
1687 my $matched = 0;
1688 my ($name, $address) = parse_email($email);
1689 $email = format_email($name, $address, 1);
1690 $email = mailmap_email($email);
1691
1692 return $email if (!$email_remove_duplicates);
1693
1694 ($name, $address) = parse_email($email);
1695
1696 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1697 $name = $deduplicate_name_hash{lc($name)}->[0];
1698 $address = $deduplicate_name_hash{lc($name)}->[1];
1699 $matched = 1;
1700 } elsif ($deduplicate_address_hash{lc($address)}) {
1701 $name = $deduplicate_address_hash{lc($address)}->[0];
1702 $address = $deduplicate_address_hash{lc($address)}->[1];
1703 $matched = 1;
1704 }
1705 if (!$matched) {
1706 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1707 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1708 }
1709 $email = format_email($name, $address, 1);
1710 $email = mailmap_email($email);
1711 return $email;
1712 }
1713
1714 sub save_commits_by_author {
1715 my (@lines) = @_;
1716
1717 my @authors = ();
1718 my @commits = ();
1719 my @subjects = ();
1720
1721 foreach my $line (@lines) {
1722 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1723 my $author = $1;
1724 $author = deduplicate_email($author);
1725 push(@authors, $author);
1726 }
1727 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1728 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1729 }
1730
1731 for (my $i = 0; $i < @authors; $i++) {
1732 my $exists = 0;
1733 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1734 if (@{$ref}[0] eq $commits[$i] &&
1735 @{$ref}[1] eq $subjects[$i]) {
1736 $exists = 1;
1737 last;
1738 }
1739 }
1740 if (!$exists) {
1741 push(@{$commit_author_hash{$authors[$i]}},
1742 [ ($commits[$i], $subjects[$i]) ]);
1743 }
1744 }
1745 }
1746
1747 sub save_commits_by_signer {
1748 my (@lines) = @_;
1749
1750 my $commit = "";
1751 my $subject = "";
1752
1753 foreach my $line (@lines) {
1754 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1755 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1756 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1757 my @signatures = ($line);
1758 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1759 my @types = @$types_ref;
1760 my @signers = @$signers_ref;
1761
1762 my $type = $types[0];
1763 my $signer = $signers[0];
1764
1765 $signer = deduplicate_email($signer);
1766
1767 my $exists = 0;
1768 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1769 if (@{$ref}[0] eq $commit &&
1770 @{$ref}[1] eq $subject &&
1771 @{$ref}[2] eq $type) {
1772 $exists = 1;
1773 last;
1774 }
1775 }
1776 if (!$exists) {
1777 push(@{$commit_signer_hash{$signer}},
1778 [ ($commit, $subject, $type) ]);
1779 }
1780 }
1781 }
1782 }
1783
1784 sub vcs_assign {
1785 my ($role, $divisor, @lines) = @_;
1786
1787 my %hash;
1788 my $count = 0;
1789
1790 return if (@lines <= 0);
1791
1792 if ($divisor <= 0) {
1793 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1794 $divisor = 1;
1795 }
1796
1797 @lines = mailmap(@lines);
1798
1799 return if (@lines <= 0);
1800
1801 @lines = sort(@lines);
1802
1803 # uniq -c
1804 $hash{$_}++ for @lines;
1805
1806 # sort -rn
1807 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1808 my $sign_offs = $hash{$line};
1809 my $percent = $sign_offs * 100 / $divisor;
1810
1811 $percent = 100 if ($percent > 100);
1812 $count++;
1813 last if ($sign_offs < $email_git_min_signatures ||
1814 $count > $email_git_max_maintainers ||
1815 $percent < $email_git_min_percent);
1816 push_email_address($line, '');
1817 if ($output_rolestats) {
1818 my $fmt_percent = sprintf("%.0f", $percent);
1819 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1820 } else {
1821 add_role($line, $role);
1822 }
1823 }
1824 }
1825
1826 sub vcs_file_signoffs {
1827 my ($file) = @_;
1828
1829 my @signers = ();
1830 my $commits;
1831
1832 $vcs_used = vcs_exists();
1833 return if (!$vcs_used);
1834
1835 my $cmd = $VCS_cmds{"find_signers_cmd"};
1836 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1837
1838 ($commits, @signers) = vcs_find_signers($cmd);
1839
1840 foreach my $signer (@signers) {
1841 $signer = deduplicate_email($signer);
1842 }
1843
1844 vcs_assign("commit_signer", $commits, @signers);
1845 }
1846
1847 sub vcs_file_blame {
1848 my ($file) = @_;
1849
1850 my @signers = ();
1851 my @all_commits = ();
1852 my @commits = ();
1853 my $total_commits;
1854 my $total_lines;
1855
1856 $vcs_used = vcs_exists();
1857 return if (!$vcs_used);
1858
1859 @all_commits = vcs_blame($file);
1860 @commits = uniq(@all_commits);
1861 $total_commits = @commits;
1862 $total_lines = @all_commits;
1863
1864 if ($email_git_blame_signatures) {
1865 if (vcs_is_hg()) {
1866 my $commit_count;
1867 my @commit_signers = ();
1868 my $commit = join(" -r ", @commits);
1869 my $cmd;
1870
1871 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1872 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1873
1874 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1875
1876 push(@signers, @commit_signers);
1877 } else {
1878 foreach my $commit (@commits) {
1879 my $commit_count;
1880 my @commit_signers = ();
1881 my $cmd;
1882
1883 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1884 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1885
1886 ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1887
1888 push(@signers, @commit_signers);
1889 }
1890 }
1891 }
1892
1893 if ($from_filename) {
1894 if ($output_rolestats) {
1895 my @blame_signers;
1896 if (vcs_is_hg()) {{ # Double brace for last exit
1897 my $commit_count;
1898 my @commit_signers = ();
1899 @commits = uniq(@commits);
1900 @commits = sort(@commits);
1901 my $commit = join(" -r ", @commits);
1902 my $cmd;
1903
1904 $cmd = $VCS_cmds{"find_commit_author_cmd"};
1905 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1906
1907 my @lines = ();
1908
1909 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1910
1911 last if !@lines;
1912
1913 my @authors = ();
1914 foreach my $line (@lines) {
1915 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1916 my $author = $1;
1917 $author = deduplicate_email($author);
1918 push(@authors, $author);
1919 }
1920 }
1921
1922 save_commits_by_author(@lines) if ($interactive);
1923 save_commits_by_signer(@lines) if ($interactive);
1924
1925 push(@signers, @authors);
1926 }}
1927 else {
1928 foreach my $commit (@commits) {
1929 my $i;
1930 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1931 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1932 my @author = vcs_find_author($cmd);
1933 next if !@author;
1934
1935 my $formatted_author = deduplicate_email($author[0]);
1936
1937 my $count = grep(/$commit/, @all_commits);
1938 for ($i = 0; $i < $count ; $i++) {
1939 push(@blame_signers, $formatted_author);
1940 }
1941 }
1942 }
1943 if (@blame_signers) {
1944 vcs_assign("authored lines", $total_lines, @blame_signers);
1945 }
1946 }
1947 foreach my $signer (@signers) {
1948 $signer = deduplicate_email($signer);
1949 }
1950 vcs_assign("commits", $total_commits, @signers);
1951 } else {
1952 foreach my $signer (@signers) {
1953 $signer = deduplicate_email($signer);
1954 }
1955 vcs_assign("modified commits", $total_commits, @signers);
1956 }
1957 }
1958
1959 sub uniq {
1960 my (@parms) = @_;
1961
1962 my %saw;
1963 @parms = grep(!$saw{$_}++, @parms);
1964 return @parms;
1965 }
1966
1967 sub sort_and_uniq {
1968 my (@parms) = @_;
1969
1970 my %saw;
1971 @parms = sort @parms;
1972 @parms = grep(!$saw{$_}++, @parms);
1973 return @parms;
1974 }
1975
1976 sub clean_file_emails {
1977 my (@file_emails) = @_;
1978 my @fmt_emails = ();
1979
1980 foreach my $email (@file_emails) {
1981 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1982 my ($name, $address) = parse_email($email);
1983 if ($name eq '"[,\.]"') {
1984 $name = "";
1985 }
1986
1987 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1988 if (@nw > 2) {
1989 my $first = $nw[@nw - 3];
1990 my $middle = $nw[@nw - 2];
1991 my $last = $nw[@nw - 1];
1992
1993 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1994 (length($first) == 2 && substr($first, -1) eq ".")) ||
1995 (length($middle) == 1 ||
1996 (length($middle) == 2 && substr($middle, -1) eq "."))) {
1997 $name = "$first $middle $last";
1998 } else {
1999 $name = "$middle $last";
2000 }
2001 }
2002
2003 if (substr($name, -1) =~ /[,\.]/) {
2004 $name = substr($name, 0, length($name) - 1);
2005 } elsif (substr($name, -2) =~ /[,\.]"/) {
2006 $name = substr($name, 0, length($name) - 2) . '"';
2007 }
2008
2009 if (substr($name, 0, 1) =~ /[,\.]/) {
2010 $name = substr($name, 1, length($name) - 1);
2011 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2012 $name = '"' . substr($name, 2, length($name) - 2);
2013 }
2014
2015 my $fmt_email = format_email($name, $address, $email_usename);
2016 push(@fmt_emails, $fmt_email);
2017 }
2018 return @fmt_emails;
2019 }
2020
2021 sub merge_email {
2022 my @lines;
2023 my %saw;
2024
2025 for (@_) {
2026 my ($address, $role) = @$_;
2027 if (!$saw{$address}) {
2028 if ($output_roles) {
2029 push(@lines, "$address ($role)");
2030 } else {
2031 push(@lines, $address);
2032 }
2033 $saw{$address} = 1;
2034 }
2035 }
2036
2037 return @lines;
2038 }
2039
2040 sub output {
2041 my (@parms) = @_;
2042
2043 if ($output_multiline) {
2044 foreach my $line (@parms) {
2045 print("${line}\n");
2046 }
2047 } else {
2048 print(join($output_separator, @parms));
2049 print("\n");
2050 }
2051 }
2052
2053 my $rfc822re;
2054
2055 sub make_rfc822re {
2056 # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2057 # comment. We must allow for rfc822_lwsp (or comments) after each of these.
2058 # This regexp will only work on addresses which have had comments stripped
2059 # and replaced with rfc822_lwsp.
2060
2061 my $specials = '()<>@,;:\\\\".\\[\\]';
2062 my $controls = '\\000-\\037\\177';
2063
2064 my $dtext = "[^\\[\\]\\r\\\\]";
2065 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2066
2067 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2068
2069 # Use zero-width assertion to spot the limit of an atom. A simple
2070 # $rfc822_lwsp* causes the regexp engine to hang occasionally.
2071 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2072 my $word = "(?:$atom|$quoted_string)";
2073 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2074
2075 my $sub_domain = "(?:$atom|$domain_literal)";
2076 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2077
2078 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2079
2080 my $phrase = "$word*";
2081 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2082 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2083 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2084
2085 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2086 my $address = "(?:$mailbox|$group)";
2087
2088 return "$rfc822_lwsp*$address";
2089 }
2090
2091 sub rfc822_strip_comments {
2092 my $s = shift;
2093 # Recursively remove comments, and replace with a single space. The simpler
2094 # regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2095 # chars in atoms, for example.
2096
2097 while ($s =~ s/^((?:[^"\\]|\\.)*
2098 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2099 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2100 return $s;
2101 }
2102
2103 # valid: returns true if the parameter is an RFC822 valid address
2104 #
2105 sub rfc822_valid {
2106 my $s = rfc822_strip_comments(shift);
2107
2108 if (!$rfc822re) {
2109 $rfc822re = make_rfc822re();
2110 }
2111
2112 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2113 }
2114
2115 # validlist: In scalar context, returns true if the parameter is an RFC822
2116 # valid list of addresses.
2117 #
2118 # In list context, returns an empty list on failure (an invalid
2119 # address was found); otherwise a list whose first element is the
2120 # number of addresses found and whose remaining elements are the
2121 # addresses. This is needed to disambiguate failure (invalid)
2122 # from success with no addresses found, because an empty string is
2123 # a valid list.
2124
2125 sub rfc822_validlist {
2126 my $s = rfc822_strip_comments(shift);
2127
2128 if (!$rfc822re) {
2129 $rfc822re = make_rfc822re();
2130 }
2131 # * null list items are valid according to the RFC
2132 # * the '1' business is to aid in distinguishing failure from no results
2133
2134 my @r;
2135 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2136 $s =~ m/^$rfc822_char*$/) {
2137 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2138 push(@r, $1);
2139 }
2140 return wantarray ? (scalar(@r), @r) : 1;
2141 }
2142 return wantarray ? () : 0;
2143 }