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