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