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