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