![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to get_maintainer.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / scripts|
Return to get_maintainer.pl CVS log | Up to [Qemu by Fabrice Bellard] / qemu / scripts |
1.1 root 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:
13: use strict;
14:
15: my $P = $0;
16: my $V = '0.26';
17:
18: use Getopt::Long qw(:config no_auto_abbrev);
19:
20: my $lk_path = "./";
21: my $email = 1;
22: my $email_usename = 1;
23: my $email_maintainer = 1;
24: my $email_list = 1;
25: my $email_subscriber_list = 0;
26: my $email_git_penguin_chiefs = 0;
27: my $email_git = 0;
28: my $email_git_all_signature_types = 0;
29: my $email_git_blame = 0;
30: my $email_git_blame_signatures = 1;
31: my $email_git_fallback = 1;
32: my $email_git_min_signatures = 1;
33: my $email_git_max_maintainers = 5;
34: my $email_git_min_percent = 5;
35: my $email_git_since = "1-year-ago";
36: my $email_hg_since = "-365";
37: my $interactive = 0;
38: my $email_remove_duplicates = 1;
39: my $email_use_mailmap = 1;
40: my $output_multiline = 1;
41: my $output_separator = ", ";
42: my $output_roles = 0;
43: my $output_rolestats = 1;
44: my $scm = 0;
45: my $web = 0;
46: my $subsystem = 0;
47: my $status = 0;
48: my $keywords = 1;
49: my $sections = 0;
50: my $file_emails = 0;
51: my $from_filename = 0;
52: my $pattern_depth = 0;
53: my $version = 0;
54: my $help = 0;
55:
56: my $vcs_used = 0;
57:
58: my $exit = 0;
59:
60: my %commit_author_hash;
61: my %commit_signer_hash;
62:
63: my @penguin_chief = ();
64: push(@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:
68: my @penguin_chief_names = ();
69: foreach 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: }
76: my $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
81: my @signature_tags = ();
82: push(@signature_tags, "Signed-off-by:");
83: push(@signature_tags, "Reviewed-by:");
84: push(@signature_tags, "Acked-by:");
85:
86: # rfc822 email address - preloaded methods go here.
87: my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
88: my $rfc822_char = '[\\000-\\377]';
89:
90: # VCS command support: class-like functions and strings
91:
92: my %VCS_cmds;
93:
94: my %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:
128: my %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:
155: my $conf = which_conf(".get_maintainer.conf");
156: if (-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:
181: if (!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:
220: if ($help != 0) {
221: usage();
222: exit 0;
223: }
224:
225: if ($version != 0) {
226: print("${P} ${V}\n");
227: exit 0;
228: }
229:
230: if (-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:
239: if ($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:
255: if ($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:
261: if (!top_of_tree($lk_path)) {
262: die "$P: The current directory does not appear to be "
263: . "a QEMU source tree.\n";
264: }
265:
266: ## Read MAINTAINERS for type/value pairs
267:
268: my @typevalue = ();
269: my %keyword_hash;
270:
271: open (my $maint, '<', "${lk_path}MAINTAINERS")
272: or die "$P: Can't open MAINTAINERS: $!\n";
273: while (<$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: }
298: close($maint);
299:
300:
301: #
302: # Read mail address map
303: #
304:
305: my $mailmap;
306:
307: read_mailmap();
308:
309: sub 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:
380: my @files = ();
381: my @range = ();
382: my @keyword_tvi = ();
383: my @file_emails = ();
384:
385: if (!@ARGV) {
386: push(@ARGV, "&STDIN");
387: }
388:
389: foreach 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:
464: my %email_hash_name;
465: my %email_hash_address;
466: my @email_to = ();
467: my %hash_list_to;
468: my @list_to = ();
469: my @scm = ();
470: my @web = ();
471: my @subsystem = ();
472: my @status = ();
473: my %deduplicate_name_hash = ();
474: my %deduplicate_address_hash = ();
475: my $signature_pattern;
476:
477: my @maintainers = get_maintainers();
478:
479: if (@maintainers) {
480: @maintainers = merge_email(@maintainers);
481: output(@maintainers);
482: }
483:
484: if ($scm) {
485: @scm = uniq(@scm);
486: output(@scm);
487: }
488:
489: if ($status) {
490: @status = uniq(@status);
491: output(@status);
492: }
493:
494: if ($subsystem) {
495: @subsystem = uniq(@subsystem);
496: output(@subsystem);
497: }
498:
499: if ($web) {
500: @web = uniq(@web);
501: output(@web);
502: }
503:
504: exit($exit);
505:
506: sub 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:
524: sub 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:
540: sub 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:
703: sub 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:
721: sub usage {
722: print <<EOT;
723: usage: $P [options] patchfile
724: $P [options] -f file|directory
725: version: $V
726:
727: MAINTAINER 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:
754: Output 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:
759: Other 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:
767: Default options:
768: [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
769: --remove-duplicates --rolestats]
770:
771: Notes:
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
795: File ".get_maintainer.conf", if it exists in the QEMU source root
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.
800: EOT
801: }
802:
803: sub top_of_tree {
804: my ($lk_path) = @_;
805:
806: if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
807: $lk_path .= "/";
808: }
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")) {
815: return 1;
816: }
817: return 0;
818: }
819:
820: sub 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:
847: sub 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:
874: sub 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:
888: sub 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:
902: sub 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:
916: sub 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:
960: sub 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:
981: sub 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:
1052: sub 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:
1062: sub 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:
1082: sub 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:
1101: sub 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:
1133: sub 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:
1145: sub 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:
1157: sub 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:
1184: sub 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:
1195: sub 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:
1210: sub 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:
1221: sub 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:
1231: sub 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:
1250: sub 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:
1278: sub 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:
1306: sub 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:
1322: sub 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:
1370: my $printed_novcs = 0;
1371: sub 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");
1380: warn("Try latest git repository using:\n");
1381: warn("git clone git://git.qemu.org/qemu.git\n");
1382: $printed_novcs = 1;
1383: }
1384: return 0;
1385: }
1386:
1387: sub vcs_is_git {
1388: vcs_exists();
1389: return $vcs_used == 1;
1390: }
1391:
1392: sub vcs_is_hg {
1393: return $vcs_used == 2;
1394: }
1395:
1396: sub 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:
1468: Version Control options:
1469: g use git history [$email_git]
1470: gf use git-fallback [$email_git_fallback]
1471: b use git blame [$email_git_blame]
1472: bs use blame signatures [$email_git_blame_signatures]
1473: c# minimum commits [$email_git_min_signatures]
1474: %# min percent [$email_git_min_percent]
1475: d# history to use [$$date_ref]
1476: x# max maintainers [$email_git_max_maintainers]
1477: t all signature types [$email_git_all_signature_types]
1478: m use .mailmap [$email_use_mailmap]
1479: EOT
1480: }
1481: print STDERR <<EOT
1482:
1483: Additional options:
1484: 0 toggle all
1485: tm toggle maintainers
1486: tg toggle git entries
1487: tl toggle open list entries
1488: ts toggle subscriber list entries
1489: f emails in file [$file_emails]
1490: k keywords in file [$keywords]
1491: r remove duplicates [$email_remove_duplicates]
1492: p# pattern match depth [$pattern_depth]
1493: EOT
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:
1634: Interactive mode allows you to select the various maintainers, submitters,
1635: commit signers and mailing lists that could be CC'd on a patch.
1636:
1637: Any *'d entry is selected.
1638:
1639: If you have git or hg installed, you can choose to summarize the commit
1640: history of files in the patch. Also, each line of the current file can
1641: be matched to its commit author and that commits signers with blame.
1642:
1643: Various knobs exist to control the length of time for active commit
1644: tracking, the maximum number of commit authors and signers to add,
1645: and such.
1646:
1647: Enter selections at the prompt until you are satisfied that the selected
1648: maintainers are appropriate. You may enter multiple selections separated
1649: by either commas or spaces.
1650:
1651: EOT
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:
1676: sub bool_invert {
1677: my ($bool_ref) = @_;
1678:
1679: if ($$bool_ref) {
1680: $$bool_ref = 0;
1681: } else {
1682: $$bool_ref = 1;
1683: }
1684: }
1685:
1686: sub 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:
1716: sub 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:
1749: sub 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:
1786: sub 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:
1828: sub 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:
1849: sub 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:
1965: sub uniq {
1966: my (@parms) = @_;
1967:
1968: my %saw;
1969: @parms = grep(!$saw{$_}++, @parms);
1970: return @parms;
1971: }
1972:
1973: sub sort_and_uniq {
1974: my (@parms) = @_;
1975:
1976: my %saw;
1977: @parms = sort @parms;
1978: @parms = grep(!$saw{$_}++, @parms);
1979: return @parms;
1980: }
1981:
1982: sub 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:
2027: sub 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:
2046: sub 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:
2059: my $rfc822re;
2060:
2061: sub 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:
2097: sub 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: #
2111: sub 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:
2131: sub 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.