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