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