]> Git Repo - J-u-boot.git/blame - scripts/get_maintainer.pl
projects / J-u-boot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Kbuild: introduce Makefile in arch/$ARCH/
[J-u-boot.git] / scripts / get_maintainer.pl
CommitLineData
92bca398
DS		 1#!/usr/bin/perl -w
2# (c) 2007, Joe Perches <[email protected]>
3# created from checkpatch.pl
4#
5# Print selected MAINTAINERS information for
6# the files modified in a patch or for a file
7#
8# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
9# perl scripts/get_maintainer.pl [OPTIONS] -f <file>
10#
11# Licensed under the terms of the GNU GPL License version 2
12
13use strict;
14
15my $P = $0;
16my $V = '0.26';
17
18use Getopt::Long qw(:config no_auto_abbrev);
68dc8769 19use File::Find;
92bca398
DS		 20
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 = ();
ee360cd2 65push(@penguin_chief, "Tom Rini:trini\@ti.com");
92bca398
DS		 66
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
68dc8769
DS		 277my @maint_files = ();
278push(@maint_files, "${lk_path}MAINTAINERS");
279
280sub maint_wanted {
281 return unless $_ =~ /^MAINTAINERS/;
282 push(@maint_files, "$File::Find::name");
283}
284
285File::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;
92bca398 316 }
68dc8769
DS		 317 push(@typevalue, "$type:$value");
318 } elsif (!/^(\s)*$/) {
319 $line =~ s/\n$//g;
320 push(@typevalue, $line);
92bca398 321 }
92bca398
DS		 322 }
323}
92bca398
DS		 324
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 }
27e77183 838 if ( (-f "${lk_path}Kbuild")
92bca398
DS		 839 && (-f "${lk_path}MAINTAINERS")
840 && (-f "${lk_path}Makefile")
841 && (-f "${lk_path}README")
92bca398 842 && (-d "${lk_path}arch")
ee360cd2
DS		 843 && (-d "${lk_path}board")
844 && (-d "${lk_path}common")
845 && (-d "${lk_path}doc")
92bca398 846 && (-d "${lk_path}drivers")
ee360cd2 847 && (-d "${lk_path}dts")
92bca398 848 && (-d "${lk_path}fs")
92bca398 849 && (-d "${lk_path}lib")
ee360cd2
DS		 850 && (-d "${lk_path}include")
851 && (-d "${lk_path}net")
852 && (-d "${lk_path}post")
853 && (-d "${lk_path}scripts")
854 && (-d "${lk_path}test")
855 && (-d "${lk_path}tools")) {
92bca398
DS		 856 return 1;
857 }
858 return 0;
859}
860
861sub parse_email {
862 my ($formatted_email) = @_;
863
864 my $name = "";
865 my $address = "";
866
867 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
868 $name = $1;
869 $address = $2;
870 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
871 $address = $1;
872 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
873 $address = $1;
874 }
875
876 $name =~ s/^\s+|\s+$//g;
877 $name =~ s/^\"|\"$//g;
878 $address =~ s/^\s+|\s+$//g;
879
880 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
881 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
882 $name = "\"$name\"";
883 }
884
885 return ($name, $address);
886}
887
888sub format_email {
889 my ($name, $address, $usename) = @_;
890
891 my $formatted_email;
892
893 $name =~ s/^\s+|\s+$//g;
894 $name =~ s/^\"|\"$//g;
895 $address =~ s/^\s+|\s+$//g;
896
897 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
898 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
899 $name = "\"$name\"";
900 }
901
902 if ($usename) {
903 if ("$name" eq "") {
904 $formatted_email = "$address";
905 } else {
906 $formatted_email = "$name <$address>";
907 }
908 } else {
909 $formatted_email = $address;
910 }
911
912 return $formatted_email;
913}
914
915sub find_first_section {
916 my $index = 0;
917
918 while ($index < @typevalue) {
919 my $tv = $typevalue[$index];
920 if (($tv =~ m/^(\C):\s*(.*)/)) {
921 last;
922 }
923 $index++;
924 }
925
926 return $index;
927}
928
929sub find_starting_index {
930 my ($index) = @_;
931
932 while ($index > 0) {
933 my $tv = $typevalue[$index];
934 if (!($tv =~ m/^(\C):\s*(.*)/)) {
935 last;
936 }
937 $index--;
938 }
939
940 return $index;
941}
942
943sub find_ending_index {
944 my ($index) = @_;
945
946 while ($index < @typevalue) {
947 my $tv = $typevalue[$index];
948 if (!($tv =~ m/^(\C):\s*(.*)/)) {
949 last;
950 }
951 $index++;
952 }
953
954 return $index;
955}
956
957sub get_maintainer_role {
958 my ($index) = @_;
959
960 my $i;
961 my $start = find_starting_index($index);
962 my $end = find_ending_index($index);
963
964 my $role = "unknown";
965 my $subsystem = $typevalue[$start];
966 if (length($subsystem) > 20) {
967 $subsystem = substr($subsystem, 0, 17);
968 $subsystem =~ s/\s*$//;
969 $subsystem = $subsystem . "...";
970 }
971
972 for ($i = $start + 1; $i < $end; $i++) {
973 my $tv = $typevalue[$i];
974 if ($tv =~ m/^(\C):\s*(.*)/) {
975 my $ptype = $1;
976 my $pvalue = $2;
977 if ($ptype eq "S") {
978 $role = $pvalue;
979 }
980 }
981 }
982
983 $role = lc($role);
984 if ($role eq "supported") {
985 $role = "supporter";
986 } elsif ($role eq "maintained") {
987 $role = "maintainer";
988 } elsif ($role eq "odd fixes") {
989 $role = "odd fixer";
990 } elsif ($role eq "orphan") {
991 $role = "orphan minder";
992 } elsif ($role eq "obsolete") {
993 $role = "obsolete minder";
994 } elsif ($role eq "buried alive in reporters") {
995 $role = "chief penguin";
996 }
997
998 return $role . ":" . $subsystem;
999}
1000
1001sub get_list_role {
1002 my ($index) = @_;
1003
1004 my $i;
1005 my $start = find_starting_index($index);
1006 my $end = find_ending_index($index);
1007
1008 my $subsystem = $typevalue[$start];
1009 if (length($subsystem) > 20) {
1010 $subsystem = substr($subsystem, 0, 17);
1011 $subsystem =~ s/\s*$//;
1012 $subsystem = $subsystem . "...";
1013 }
1014
1015 if ($subsystem eq "THE REST") {
1016 $subsystem = "";
1017 }
1018
1019 return $subsystem;
1020}
1021
1022sub add_categories {
1023 my ($index) = @_;
1024
1025 my $i;
1026 my $start = find_starting_index($index);
1027 my $end = find_ending_index($index);
1028
1029 push(@subsystem, $typevalue[$start]);
1030
1031 for ($i = $start + 1; $i < $end; $i++) {
1032 my $tv = $typevalue[$i];
1033 if ($tv =~ m/^(\C):\s*(.*)/) {
1034 my $ptype = $1;
1035 my $pvalue = $2;
1036 if ($ptype eq "L") {
1037 my $list_address = $pvalue;
1038 my $list_additional = "";
1039 my $list_role = get_list_role($i);
1040
1041 if ($list_role ne "") {
1042 $list_role = ":" . $list_role;
1043 }
1044 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1045 $list_address = $1;
1046 $list_additional = $2;
1047 }
1048 if ($list_additional =~ m/subscribers-only/) {
1049 if ($email_subscriber_list) {
1050 if (!$hash_list_to{lc($list_address)}) {
1051 $hash_list_to{lc($list_address)} = 1;
1052 push(@list_to, [$list_address,
1053 "subscriber list${list_role}"]);
1054 }
1055 }
1056 } else {
1057 if ($email_list) {
1058 if (!$hash_list_to{lc($list_address)}) {
1059 $hash_list_to{lc($list_address)} = 1;
1060 if ($list_additional =~ m/moderated/) {
1061 push(@list_to, [$list_address,
1062 "moderated list${list_role}"]);
1063 } else {
1064 push(@list_to, [$list_address,
1065 "open list${list_role}"]);
1066 }
1067 }
1068 }
1069 }
1070 } elsif ($ptype eq "M") {
1071 my ($name, $address) = parse_email($pvalue);
1072 if ($name eq "") {
1073 if ($i > 0) {
1074 my $tv = $typevalue[$i - 1];
1075 if ($tv =~ m/^(\C):\s*(.*)/) {
1076 if ($1 eq "P") {
1077 $name = $2;
1078 $pvalue = format_email($name, $address, $email_usename);
1079 }
1080 }
1081 }
1082 }
1083 if ($email_maintainer) {
1084 my $role = get_maintainer_role($i);
1085 push_email_addresses($pvalue, $role);
1086 }
1087 } elsif ($ptype eq "T") {
1088 push(@scm, $pvalue);
1089 } elsif ($ptype eq "W") {
1090 push(@web, $pvalue);
1091 } elsif ($ptype eq "S") {
1092 push(@status, $pvalue);
1093 }
1094 }
1095 }
1096}
1097
1098sub email_inuse {
1099 my ($name, $address) = @_;
1100
1101 return 1 if (($name eq "") && ($address eq ""));
1102 return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1103 return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1104
1105 return 0;
1106}
1107
1108sub push_email_address {
1109 my ($line, $role) = @_;
1110
1111 my ($name, $address) = parse_email($line);
1112
1113 if ($address eq "") {
1114 return 0;
1115 }
1116
1117 if (!$email_remove_duplicates) {
1118 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1119 } elsif (!email_inuse($name, $address)) {
1120 push(@email_to, [format_email($name, $address, $email_usename), $role]);
1121 $email_hash_name{lc($name)}++ if ($name ne "");
1122 $email_hash_address{lc($address)}++;
1123 }
1124
1125 return 1;
1126}
1127
1128sub push_email_addresses {
1129 my ($address, $role) = @_;
1130
1131 my @address_list = ();
1132
1133 if (rfc822_valid($address)) {
1134 push_email_address($address, $role);
1135 } elsif (@address_list = rfc822_validlist($address)) {
1136 my $array_count = shift(@address_list);
1137 while (my $entry = shift(@address_list)) {
1138 push_email_address($entry, $role);
1139 }
1140 } else {
1141 if (!push_email_address($address, $role)) {
1142 warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1143 }
1144 }
1145}
1146
1147sub add_role {
1148 my ($line, $role) = @_;
1149
1150 my ($name, $address) = parse_email($line);
1151 my $email = format_email($name, $address, $email_usename);
1152
1153 foreach my $entry (@email_to) {
1154 if ($email_remove_duplicates) {
1155 my ($entry_name, $entry_address) = parse_email($entry->[0]);
1156 if (($name eq $entry_name || $address eq $entry_address)
1157 && ($role eq "" || !($entry->[1] =~ m/$role/))
1158 ) {
1159 if ($entry->[1] eq "") {
1160 $entry->[1] = "$role";
1161 } else {
1162 $entry->[1] = "$entry->[1],$role";
1163 }
1164 }
1165 } else {
1166 if ($email eq $entry->[0]
1167 && ($role eq "" || !($entry->[1] =~ m/$role/))
1168 ) {
1169 if ($entry->[1] eq "") {
1170 $entry->[1] = "$role";
1171 } else {
1172 $entry->[1] = "$entry->[1],$role";
1173 }
1174 }
1175 }
1176 }
1177}
1178
1179sub which {
1180 my ($bin) = @_;
1181
1182 foreach my $path (split(/:/, $ENV{PATH})) {
1183 if (-e "$path/$bin") {
1184 return "$path/$bin";
1185 }
1186 }
1187
1188 return "";
1189}
1190
1191sub which_conf {
1192 my ($conf) = @_;
1193
1194 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1195 if (-e "$path/$conf") {
1196 return "$path/$conf";
1197 }
1198 }
1199
1200 return "";
1201}
1202
1203sub mailmap_email {
1204 my ($line) = @_;
1205
1206 my ($name, $address) = parse_email($line);
1207 my $email = format_email($name, $address, 1);
1208 my $real_name = $name;
1209 my $real_address = $address;
1210
1211 if (exists $mailmap->{names}->{$email} ||
1212 exists $mailmap->{addresses}->{$email}) {
1213 if (exists $mailmap->{names}->{$email}) {
1214 $real_name = $mailmap->{names}->{$email};
1215 }
1216 if (exists $mailmap->{addresses}->{$email}) {
1217 $real_address = $mailmap->{addresses}->{$email};
1218 }
1219 } else {
1220 if (exists $mailmap->{names}->{$address}) {
1221 $real_name = $mailmap->{names}->{$address};
1222 }
1223 if (exists $mailmap->{addresses}->{$address}) {
1224 $real_address = $mailmap->{addresses}->{$address};
1225 }
1226 }
1227 return format_email($real_name, $real_address, 1);
1228}
1229
1230sub mailmap {
1231 my (@addresses) = @_;
1232
1233 my @mapped_emails = ();
1234 foreach my $line (@addresses) {
1235 push(@mapped_emails, mailmap_email($line));
1236 }
1237 merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1238 return @mapped_emails;
1239}
1240
1241sub merge_by_realname {
1242 my %address_map;
1243 my (@emails) = @_;
1244
1245 foreach my $email (@emails) {
1246 my ($name, $address) = parse_email($email);
1247 if (exists $address_map{$name}) {
1248 $address = $address_map{$name};
1249 $email = format_email($name, $address, 1);
1250 } else {
1251 $address_map{$name} = $address;
1252 }
1253 }
1254}
1255
1256sub git_execute_cmd {
1257 my ($cmd) = @_;
1258 my @lines = ();
1259
1260 my $output = `$cmd`;
1261 $output =~ s/^\s*//gm;
1262 @lines = split("\n", $output);
1263
1264 return @lines;
1265}
1266
1267sub hg_execute_cmd {
1268 my ($cmd) = @_;
1269 my @lines = ();
1270
1271 my $output = `$cmd`;
1272 @lines = split("\n", $output);
1273
1274 return @lines;
1275}
1276
1277sub extract_formatted_signatures {
1278 my (@signature_lines) = @_;
1279
1280 my @type = @signature_lines;
1281
1282 s/\s*(.*):.*/$1/ for (@type);
1283
1284 # cut -f2- -d":"
1285 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1286
1287## Reformat email addresses (with names) to avoid badly written signatures
1288
1289 foreach my $signer (@signature_lines) {
1290 $signer = deduplicate_email($signer);
1291 }
1292
1293 return (\@type, \@signature_lines);
1294}
1295
1296sub vcs_find_signers {
1297 my ($cmd, $file) = @_;
1298 my $commits;
1299 my @lines = ();
1300 my @signatures = ();
1301 my @authors = ();
1302 my @stats = ();
1303
1304 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1305
1306 my $pattern = $VCS_cmds{"commit_pattern"};
1307 my $author_pattern = $VCS_cmds{"author_pattern"};
1308 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1309
1310 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1311
1312 $commits = grep(/$pattern/, @lines); # of commits
1313
1314 @authors = grep(/$author_pattern/, @lines);
1315 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1316 @stats = grep(/$stat_pattern/, @lines);
1317
1318# print("stats: <@stats>\n");
1319
1320 return (0, \@signatures, \@authors, \@stats) if !@signatures;
1321
1322 save_commits_by_author(@lines) if ($interactive);
1323 save_commits_by_signer(@lines) if ($interactive);
1324
1325 if (!$email_git_penguin_chiefs) {
1326 @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1327 }
1328
1329 my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1330 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1331
1332 return ($commits, $signers_ref, $authors_ref, \@stats);
1333}
1334
1335sub vcs_find_author {
1336 my ($cmd) = @_;
1337 my @lines = ();
1338
1339 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1340
1341 if (!$email_git_penguin_chiefs) {
1342 @lines = grep(!/${penguin_chiefs}/i, @lines);
1343 }
1344
1345 return @lines if !@lines;
1346
1347 my @authors = ();
1348 foreach my $line (@lines) {
1349 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1350 my $author = $1;
1351 my ($name, $address) = parse_email($author);
1352 $author = format_email($name, $address, 1);
1353 push(@authors, $author);
1354 }
1355 }
1356
1357 save_commits_by_author(@lines) if ($interactive);
1358 save_commits_by_signer(@lines) if ($interactive);
1359
1360 return @authors;
1361}
1362
1363sub vcs_save_commits {
1364 my ($cmd) = @_;
1365 my @lines = ();
1366 my @commits = ();
1367
1368 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1369
1370 foreach my $line (@lines) {
1371 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1372 push(@commits, $1);
1373 }
1374 }
1375
1376 return @commits;
1377}
1378
1379sub vcs_blame {
1380 my ($file) = @_;
1381 my $cmd;
1382 my @commits = ();
1383
1384 return @commits if (!(-f $file));
1385
1386 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1387 my @all_commits = ();
1388
1389 $cmd = $VCS_cmds{"blame_file_cmd"};
1390 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1391 @all_commits = vcs_save_commits($cmd);
1392
1393 foreach my $file_range_diff (@range) {
1394 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1395 my $diff_file = $1;
1396 my $diff_start = $2;
1397 my $diff_length = $3;
1398 next if ("$file" ne "$diff_file");
1399 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1400 push(@commits, $all_commits[$i]);
1401 }
1402 }
1403 } elsif (@range) {
1404 foreach my $file_range_diff (@range) {
1405 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1406 my $diff_file = $1;
1407 my $diff_start = $2;
1408 my $diff_length = $3;
1409 next if ("$file" ne "$diff_file");
1410 $cmd = $VCS_cmds{"blame_range_cmd"};
1411 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1412 push(@commits, vcs_save_commits($cmd));
1413 }
1414 } else {
1415 $cmd = $VCS_cmds{"blame_file_cmd"};
1416 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1417 @commits = vcs_save_commits($cmd);
1418 }
1419
1420 foreach my $commit (@commits) {
1421 $commit =~ s/^\^//g;
1422 }
1423
1424 return @commits;
1425}
1426
1427my $printed_novcs = 0;
1428sub vcs_exists {
1429 %VCS_cmds = %VCS_cmds_git;
1430 return 1 if eval $VCS_cmds{"available"};
1431 %VCS_cmds = %VCS_cmds_hg;
1432 return 2 if eval $VCS_cmds{"available"};
1433 %VCS_cmds = ();
1434 if (!$printed_novcs) {
1435 warn("$P: No supported VCS found. Add --nogit to options?\n");
1436 warn("Using a git repository produces better results.\n");
1437 warn("Try Linus Torvalds' latest git repository using:\n");
1438 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1439 $printed_novcs = 1;
1440 }
1441 return 0;
1442}
1443
1444sub vcs_is_git {
1445 vcs_exists();
1446 return $vcs_used == 1;
1447}
1448
1449sub vcs_is_hg {
1450 return $vcs_used == 2;
1451}
1452
1453sub interactive_get_maintainers {
1454 my ($list_ref) = @_;
1455 my @list = @$list_ref;
1456
1457 vcs_exists();
1458
1459 my %selected;
1460 my %authored;
1461 my %signed;
1462 my $count = 0;
1463 my $maintained = 0;
1464 foreach my $entry (@list) {
1465 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1466 $selected{$count} = 1;
1467 $authored{$count} = 0;
1468 $signed{$count} = 0;
1469 $count++;
1470 }
1471
1472 #menu loop
1473 my $done = 0;
1474 my $print_options = 0;
1475 my $redraw = 1;
1476 while (!$done) {
1477 $count = 0;
1478 if ($redraw) {
1479 printf STDERR "\n%1s %2s %-65s",
1480 "*", "#", "email/list and role:stats";
1481 if ($email_git ||
1482 ($email_git_fallback && !$maintained) ||
1483 $email_git_blame) {
1484 print STDERR "auth sign";
1485 }
1486 print STDERR "\n";
1487 foreach my $entry (@list) {
1488 my $email = $entry->[0];
1489 my $role = $entry->[1];
1490 my $sel = "";
1491 $sel = "*" if ($selected{$count});
1492 my $commit_author = $commit_author_hash{$email};
1493 my $commit_signer = $commit_signer_hash{$email};
1494 my $authored = 0;
1495 my $signed = 0;
1496 $authored++ for (@{$commit_author});
1497 $signed++ for (@{$commit_signer});
1498 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1499 printf STDERR "%4d %4d", $authored, $signed
1500 if ($authored > 0 || $signed > 0);
1501 printf STDERR "\n %s\n", $role;
1502 if ($authored{$count}) {
1503 my $commit_author = $commit_author_hash{$email};
1504 foreach my $ref (@{$commit_author}) {
1505 print STDERR " Author: @{$ref}[1]\n";
1506 }
1507 }
1508 if ($signed{$count}) {
1509 my $commit_signer = $commit_signer_hash{$email};
1510 foreach my $ref (@{$commit_signer}) {
1511 print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1512 }
1513 }
1514
1515 $count++;
1516 }
1517 }
1518 my $date_ref = \$email_git_since;
1519 $date_ref = \$email_hg_since if (vcs_is_hg());
1520 if ($print_options) {
1521 $print_options = 0;
1522 if (vcs_exists()) {
1523 print STDERR <<EOT
1524
1525Version Control options:
1526g use git history [$email_git]
1527gf use git-fallback [$email_git_fallback]
1528b use git blame [$email_git_blame]
1529bs use blame signatures [$email_git_blame_signatures]
1530c# minimum commits [$email_git_min_signatures]
1531%# min percent [$email_git_min_percent]
1532d# history to use [$$date_ref]
1533x# max maintainers [$email_git_max_maintainers]
1534t all signature types [$email_git_all_signature_types]
1535m use .mailmap [$email_use_mailmap]
1536EOT
1537 }
1538 print STDERR <<EOT
1539
1540Additional options:
15410 toggle all
1542tm toggle maintainers
1543tg toggle git entries
1544tl toggle open list entries
1545ts toggle subscriber list entries
1546f emails in file [$file_emails]
1547k keywords in file [$keywords]
1548r remove duplicates [$email_remove_duplicates]
1549p# pattern match depth [$pattern_depth]
1550EOT
1551 }
1552 print STDERR
1553"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1554
1555 my $input = <STDIN>;
1556 chomp($input);
1557
1558 $redraw = 1;
1559 my $rerun = 0;
1560 my @wish = split(/[, ]+/, $input);
1561 foreach my $nr (@wish) {
1562 $nr = lc($nr);
1563 my $sel = substr($nr, 0, 1);
1564 my $str = substr($nr, 1);
1565 my $val = 0;
1566 $val = $1 if $str =~ /^(\d+)$/;
1567
1568 if ($sel eq "y") {
1569 $interactive = 0;
1570 $done = 1;
1571 $output_rolestats = 0;
1572 $output_roles = 0;
1573 last;
1574 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1575 $selected{$nr - 1} = !$selected{$nr - 1};
1576 } elsif ($sel eq "*" || $sel eq '^') {
1577 my $toggle = 0;
1578 $toggle = 1 if ($sel eq '*');
1579 for (my $i = 0; $i < $count; $i++) {
1580 $selected{$i} = $toggle;
1581 }
1582 } elsif ($sel eq "0") {
1583 for (my $i = 0; $i < $count; $i++) {
1584 $selected{$i} = !$selected{$i};
1585 }
1586 } elsif ($sel eq "t") {
1587 if (lc($str) eq "m") {
1588 for (my $i = 0; $i < $count; $i++) {
1589 $selected{$i} = !$selected{$i}
1590 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1591 }
1592 } elsif (lc($str) eq "g") {
1593 for (my $i = 0; $i < $count; $i++) {
1594 $selected{$i} = !$selected{$i}
1595 if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1596 }
1597 } elsif (lc($str) eq "l") {
1598 for (my $i = 0; $i < $count; $i++) {
1599 $selected{$i} = !$selected{$i}
1600 if ($list[$i]->[1] =~ /^(open list)/i);
1601 }
1602 } elsif (lc($str) eq "s") {
1603 for (my $i = 0; $i < $count; $i++) {
1604 $selected{$i} = !$selected{$i}
1605 if ($list[$i]->[1] =~ /^(subscriber list)/i);
1606 }
1607 }
1608 } elsif ($sel eq "a") {
1609 if ($val > 0 && $val <= $count) {
1610 $authored{$val - 1} = !$authored{$val - 1};
1611 } elsif ($str eq '*' || $str eq '^') {
1612 my $toggle = 0;
1613 $toggle = 1 if ($str eq '*');
1614 for (my $i = 0; $i < $count; $i++) {
1615 $authored{$i} = $toggle;
1616 }
1617 }
1618 } elsif ($sel eq "s") {
1619 if ($val > 0 && $val <= $count) {
1620 $signed{$val - 1} = !$signed{$val - 1};
1621 } elsif ($str eq '*' || $str eq '^') {
1622 my $toggle = 0;
1623 $toggle = 1 if ($str eq '*');
1624 for (my $i = 0; $i < $count; $i++) {
1625 $signed{$i} = $toggle;
1626 }
1627 }
1628 } elsif ($sel eq "o") {
1629 $print_options = 1;
1630 $redraw = 1;
1631 } elsif ($sel eq "g") {
1632 if ($str eq "f") {
1633 bool_invert(\$email_git_fallback);
1634 } else {
1635 bool_invert(\$email_git);
1636 }
1637 $rerun = 1;
1638 } elsif ($sel eq "b") {
1639 if ($str eq "s") {
1640 bool_invert(\$email_git_blame_signatures);
1641 } else {
1642 bool_invert(\$email_git_blame);
1643 }
1644 $rerun = 1;
1645 } elsif ($sel eq "c") {
1646 if ($val > 0) {
1647 $email_git_min_signatures = $val;
1648 $rerun = 1;
1649 }
1650 } elsif ($sel eq "x") {
1651 if ($val > 0) {
1652 $email_git_max_maintainers = $val;
1653 $rerun = 1;
1654 }
1655 } elsif ($sel eq "%") {
1656 if ($str ne "" && $val >= 0) {
1657 $email_git_min_percent = $val;
1658 $rerun = 1;
1659 }
1660 } elsif ($sel eq "d") {
1661 if (vcs_is_git()) {
1662 $email_git_since = $str;
1663 } elsif (vcs_is_hg()) {
1664 $email_hg_since = $str;
1665 }
1666 $rerun = 1;
1667 } elsif ($sel eq "t") {
1668 bool_invert(\$email_git_all_signature_types);
1669 $rerun = 1;
1670 } elsif ($sel eq "f") {
1671 bool_invert(\$file_emails);
1672 $rerun = 1;
1673 } elsif ($sel eq "r") {
1674 bool_invert(\$email_remove_duplicates);
1675 $rerun = 1;
1676 } elsif ($sel eq "m") {
1677 bool_invert(\$email_use_mailmap);
1678 read_mailmap();
1679 $rerun = 1;
1680 } elsif ($sel eq "k") {
1681 bool_invert(\$keywords);
1682 $rerun = 1;
1683 } elsif ($sel eq "p") {
1684 if ($str ne "" && $val >= 0) {
1685 $pattern_depth = $val;
1686 $rerun = 1;
1687 }
1688 } elsif ($sel eq "h" || $sel eq "?") {
1689 print STDERR <<EOT
1690
1691Interactive mode allows you to select the various maintainers, submitters,
1692commit signers and mailing lists that could be CC'd on a patch.
1693
1694Any *'d entry is selected.
1695
1696If you have git or hg installed, you can choose to summarize the commit
1697history of files in the patch. Also, each line of the current file can
1698be matched to its commit author and that commits signers with blame.
1699
1700Various knobs exist to control the length of time for active commit
1701tracking, the maximum number of commit authors and signers to add,
1702and such.
1703
1704Enter selections at the prompt until you are satisfied that the selected
1705maintainers are appropriate. You may enter multiple selections separated
1706by either commas or spaces.
1707
1708EOT
1709 } else {
1710 print STDERR "invalid option: '$nr'\n";
1711 $redraw = 0;
1712 }
1713 }
1714 if ($rerun) {
1715 print STDERR "git-blame can be very slow, please have patience..."
1716 if ($email_git_blame);
1717 goto &get_maintainers;
1718 }
1719 }
1720
1721 #drop not selected entries
1722 $count = 0;
1723 my @new_emailto = ();
1724 foreach my $entry (@list) {
1725 if ($selected{$count}) {
1726 push(@new_emailto, $list[$count]);
1727 }
1728 $count++;
1729 }
1730 return @new_emailto;
1731}
1732
1733sub bool_invert {
1734 my ($bool_ref) = @_;
1735
1736 if ($$bool_ref) {
1737 $$bool_ref = 0;
1738 } else {
1739 $$bool_ref = 1;
1740 }
1741}
1742
1743sub deduplicate_email {
1744 my ($email) = @_;
1745
1746 my $matched = 0;
1747 my ($name, $address) = parse_email($email);
1748 $email = format_email($name, $address, 1);
1749 $email = mailmap_email($email);
1750
1751 return $email if (!$email_remove_duplicates);
1752
1753 ($name, $address) = parse_email($email);
1754
1755 if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1756 $name = $deduplicate_name_hash{lc($name)}->[0];
1757 $address = $deduplicate_name_hash{lc($name)}->[1];
1758 $matched = 1;
1759 } elsif ($deduplicate_address_hash{lc($address)}) {
1760 $name = $deduplicate_address_hash{lc($address)}->[0];
1761 $address = $deduplicate_address_hash{lc($address)}->[1];
1762 $matched = 1;
1763 }
1764 if (!$matched) {
1765 $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1766 $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1767 }
1768 $email = format_email($name, $address, 1);
1769 $email = mailmap_email($email);
1770 return $email;
1771}
1772
1773sub save_commits_by_author {
1774 my (@lines) = @_;
1775
1776 my @authors = ();
1777 my @commits = ();
1778 my @subjects = ();
1779
1780 foreach my $line (@lines) {
1781 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1782 my $author = $1;
1783 $author = deduplicate_email($author);
1784 push(@authors, $author);
1785 }
1786 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1787 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1788 }
1789
1790 for (my $i = 0; $i < @authors; $i++) {
1791 my $exists = 0;
1792 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1793 if (@{$ref}[0] eq $commits[$i] &&
1794 @{$ref}[1] eq $subjects[$i]) {
1795 $exists = 1;
1796 last;
1797 }
1798 }
1799 if (!$exists) {
1800 push(@{$commit_author_hash{$authors[$i]}},
1801 [ ($commits[$i], $subjects[$i]) ]);
1802 }
1803 }
1804}
1805
1806sub save_commits_by_signer {
1807 my (@lines) = @_;
1808
1809 my $commit = "";
1810 my $subject = "";
1811
1812 foreach my $line (@lines) {
1813 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1814 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1815 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1816 my @signatures = ($line);
1817 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1818 my @types = @$types_ref;
1819 my @signers = @$signers_ref;
1820
1821 my $type = $types[0];
1822 my $signer = $signers[0];
1823
1824 $signer = deduplicate_email($signer);
1825
1826 my $exists = 0;
1827 foreach my $ref(@{$commit_signer_hash{$signer}}) {
1828 if (@{$ref}[0] eq $commit &&
1829 @{$ref}[1] eq $subject &&
1830 @{$ref}[2] eq $type) {
1831 $exists = 1;
1832 last;
1833 }
1834 }
1835 if (!$exists) {
1836 push(@{$commit_signer_hash{$signer}},
1837 [ ($commit, $subject, $type) ]);
1838 }
1839 }
1840 }
1841}
1842
1843sub vcs_assign {
1844 my ($role, $divisor, @lines) = @_;
1845
1846 my %hash;
1847 my $count = 0;
1848
1849 return if (@lines <= 0);
1850
1851 if ($divisor <= 0) {
1852 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1853 $divisor = 1;
1854 }
1855
1856 @lines = mailmap(@lines);
1857
1858 return if (@lines <= 0);
1859
1860 @lines = sort(@lines);
1861
1862 # uniq -c
1863 $hash{$_}++ for @lines;
1864
1865 # sort -rn
1866 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1867 my $sign_offs = $hash{$line};
1868 my $percent = $sign_offs * 100 / $divisor;
1869
1870 $percent = 100 if ($percent > 100);
1871 $count++;
1872 last if ($sign_offs < $email_git_min_signatures ||
1873 $count > $email_git_max_maintainers ||
1874 $percent < $email_git_min_percent);
1875 push_email_address($line, '');
1876 if ($output_rolestats) {
1877 my $fmt_percent = sprintf("%.0f", $percent);
1878 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1879 } else {
1880 add_role($line, $role);
1881 }
1882 }
1883}
1884
1885sub vcs_file_signoffs {
1886 my ($file) = @_;
1887
1888 my $authors_ref;
1889 my $signers_ref;
1890 my $stats_ref;
1891 my @authors = ();
1892 my @signers = ();
1893 my @stats = ();
1894 my $commits;
1895
1896 $vcs_used = vcs_exists();
1897 return if (!$vcs_used);
1898
1899 my $cmd = $VCS_cmds{"find_signers_cmd"};
1900 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1901
1902 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1903
1904 @signers = @{$signers_ref} if defined $signers_ref;
1905 @authors = @{$authors_ref} if defined $authors_ref;
1906 @stats = @{$stats_ref} if defined $stats_ref;
1907
1908# print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1909
1910 foreach my $signer (@signers) {
1911 $signer = deduplicate_email($signer);
1912 }
1913
1914 vcs_assign("commit_signer", $commits, @signers);
1915 vcs_assign("authored", $commits, @authors);
1916 if ($#authors == $#stats) {
1917 my $stat_pattern = $VCS_cmds{"stat_pattern"};
1918 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern
1919
1920 my $added = 0;
1921 my $deleted = 0;
1922 for (my $i = 0; $i <= $#stats; $i++) {
1923 if ($stats[$i] =~ /$stat_pattern/) {
1924 $added += $1;
1925 $deleted += $2;
1926 }
1927 }
1928 my @tmp_authors = uniq(@authors);
1929 foreach my $author (@tmp_authors) {
1930 $author = deduplicate_email($author);
1931 }
1932 @tmp_authors = uniq(@tmp_authors);
1933 my @list_added = ();
1934 my @list_deleted = ();
1935 foreach my $author (@tmp_authors) {
1936 my $auth_added = 0;
1937 my $auth_deleted = 0;
1938 for (my $i = 0; $i <= $#stats; $i++) {
1939 if ($author eq deduplicate_email($authors[$i]) &&
1940 $stats[$i] =~ /$stat_pattern/) {
1941 $auth_added += $1;
1942 $auth_deleted += $2;
1943 }
1944 }
1945 for (my $i = 0; $i < $auth_added; $i++) {
1946 push(@list_added, $author);
1947 }
1948 for (my $i = 0; $i < $auth_deleted; $i++) {
1949 push(@list_deleted, $author);
1950 }
1951 }
1952 vcs_assign("added_lines", $added, @list_added);
1953 vcs_assign("removed_lines", $deleted, @list_deleted);
1954 }
1955}
1956
1957sub vcs_file_blame {
1958 my ($file) = @_;
1959
1960 my @signers = ();
1961 my @all_commits = ();
1962 my @commits = ();
1963 my $total_commits;
1964 my $total_lines;
1965
1966 $vcs_used = vcs_exists();
1967 return if (!$vcs_used);
1968
1969 @all_commits = vcs_blame($file);
1970 @commits = uniq(@all_commits);
1971 $total_commits = @commits;
1972 $total_lines = @all_commits;
1973
1974 if ($email_git_blame_signatures) {
1975 if (vcs_is_hg()) {
1976 my $commit_count;
1977 my $commit_authors_ref;
1978 my $commit_signers_ref;
1979 my $stats_ref;
1980 my @commit_authors = ();
1981 my @commit_signers = ();
1982 my $commit = join(" -r ", @commits);
1983 my $cmd;
1984
1985 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1986 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1987
1988 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1989 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
1990 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
1991
1992 push(@signers, @commit_signers);
1993 } else {
1994 foreach my $commit (@commits) {
1995 my $commit_count;
1996 my $commit_authors_ref;
1997 my $commit_signers_ref;
1998 my $stats_ref;
1999 my @commit_authors = ();
2000 my @commit_signers = ();
2001 my $cmd;
2002
2003 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2004 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2005
2006 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2007 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2008 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2009
2010 push(@signers, @commit_signers);
2011 }
2012 }
2013 }
2014
2015 if ($from_filename) {
2016 if ($output_rolestats) {
2017 my @blame_signers;
2018 if (vcs_is_hg()) {{ # Double brace for last exit
2019 my $commit_count;
2020 my @commit_signers = ();
2021 @commits = uniq(@commits);
2022 @commits = sort(@commits);
2023 my $commit = join(" -r ", @commits);
2024 my $cmd;
2025
2026 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2027 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
2028
2029 my @lines = ();
2030
2031 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2032
2033 if (!$email_git_penguin_chiefs) {
2034 @lines = grep(!/${penguin_chiefs}/i, @lines);
2035 }
2036
2037 last if !@lines;
2038
2039 my @authors = ();
2040 foreach my $line (@lines) {
2041 if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2042 my $author = $1;
2043 $author = deduplicate_email($author);
2044 push(@authors, $author);
2045 }
2046 }
2047
2048 save_commits_by_author(@lines) if ($interactive);
2049 save_commits_by_signer(@lines) if ($interactive);
2050
2051 push(@signers, @authors);
2052 }}
2053 else {
2054 foreach my $commit (@commits) {
2055 my $i;
2056 my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2057 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
2058 my @author = vcs_find_author($cmd);
2059 next if !@author;
2060
2061 my $formatted_author = deduplicate_email($author[0]);
2062
2063 my $count = grep(/$commit/, @all_commits);
2064 for ($i = 0; $i < $count ; $i++) {
2065 push(@blame_signers, $formatted_author);
2066 }
2067 }
2068 }
2069 if (@blame_signers) {
2070 vcs_assign("authored lines", $total_lines, @blame_signers);
2071 }
2072 }
2073 foreach my $signer (@signers) {
2074 $signer = deduplicate_email($signer);
2075 }
2076 vcs_assign("commits", $total_commits, @signers);
2077 } else {
2078 foreach my $signer (@signers) {
2079 $signer = deduplicate_email($signer);
2080 }
2081 vcs_assign("modified commits", $total_commits, @signers);
2082 }
2083}
2084
2085sub uniq {
2086 my (@parms) = @_;
2087
2088 my %saw;
2089 @parms = grep(!$saw{$_}++, @parms);
2090 return @parms;
2091}
2092
2093sub sort_and_uniq {
2094 my (@parms) = @_;
2095
2096 my %saw;
2097 @parms = sort @parms;
2098 @parms = grep(!$saw{$_}++, @parms);
2099 return @parms;
2100}
2101
2102sub clean_file_emails {
2103 my (@file_emails) = @_;
2104 my @fmt_emails = ();
2105
2106 foreach my $email (@file_emails) {
2107 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2108 my ($name, $address) = parse_email($email);
2109 if ($name eq '"[,\.]"') {
2110 $name = "";
2111 }
2112
2113 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2114 if (@nw > 2) {
2115 my $first = $nw[@nw - 3];
2116 my $middle = $nw[@nw - 2];
2117 my $last = $nw[@nw - 1];
2118
2119 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2120 (length($first) == 2 && substr($first, -1) eq ".")) ||
2121 (length($middle) == 1 ||
2122 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2123 $name = "$first $middle $last";
2124 } else {
2125 $name = "$middle $last";
2126 }
2127 }
2128
2129 if (substr($name, -1) =~ /[,\.]/) {
2130 $name = substr($name, 0, length($name) - 1);
2131 } elsif (substr($name, -2) =~ /[,\.]"/) {
2132 $name = substr($name, 0, length($name) - 2) . '"';
2133 }
2134
2135 if (substr($name, 0, 1) =~ /[,\.]/) {
2136 $name = substr($name, 1, length($name) - 1);
2137 } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2138 $name = '"' . substr($name, 2, length($name) - 2);
2139 }
2140
2141 my $fmt_email = format_email($name, $address, $email_usename);
2142 push(@fmt_emails, $fmt_email);
2143 }
2144 return @fmt_emails;
2145}
2146
2147sub merge_email {
2148 my @lines;
2149 my %saw;
2150
2151 for (@_) {
2152 my ($address, $role) = @$_;
2153 if (!$saw{$address}) {
2154 if ($output_roles) {
2155 push(@lines, "$address ($role)");
2156 } else {
2157 push(@lines, $address);
2158 }
2159 $saw{$address} = 1;
2160 }
2161 }
2162
2163 return @lines;
2164}
2165
2166sub output {
2167 my (@parms) = @_;
2168
2169 if ($output_multiline) {
2170 foreach my $line (@parms) {
2171 print("${line}\n");
2172 }
2173 } else {
2174 print(join($output_separator, @parms));
2175 print("\n");
2176 }
2177}
2178
2179my $rfc822re;
2180
2181sub make_rfc822re {
2182# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2183# comment. We must allow for rfc822_lwsp (or comments) after each of these.
2184# This regexp will only work on addresses which have had comments stripped
2185# and replaced with rfc822_lwsp.
2186
2187 my $specials = '()<>@,;:\\\\".\\[\\]';
2188 my $controls = '\\000-\\037\\177';
2189
2190 my $dtext = "[^\\[\\]\\r\\\\]";
2191 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2192
2193 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2194
2195# Use zero-width assertion to spot the limit of an atom. A simple
2196# $rfc822_lwsp* causes the regexp engine to hang occasionally.
2197 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2198 my $word = "(?:$atom|$quoted_string)";
2199 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2200
2201 my $sub_domain = "(?:$atom|$domain_literal)";
2202 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2203
2204 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2205
2206 my $phrase = "$word*";
2207 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2208 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2209 my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2210
2211 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2212 my $address = "(?:$mailbox|$group)";
2213
2214 return "$rfc822_lwsp*$address";
2215}
2216
2217sub rfc822_strip_comments {
2218 my $s = shift;
2219# Recursively remove comments, and replace with a single space. The simpler
2220# regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2221# chars in atoms, for example.
2222
2223 while ($s =~ s/^((?:[^"\\]|\\.)*
2224 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2225 \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2226 return $s;
2227}
2228
2229# valid: returns true if the parameter is an RFC822 valid address
2230#
2231sub rfc822_valid {
2232 my $s = rfc822_strip_comments(shift);
2233
2234 if (!$rfc822re) {
2235 $rfc822re = make_rfc822re();
2236 }
2237
2238 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2239}
2240
2241# validlist: In scalar context, returns true if the parameter is an RFC822
2242# valid list of addresses.
2243#
2244# In list context, returns an empty list on failure (an invalid
2245# address was found); otherwise a list whose first element is the
2246# number of addresses found and whose remaining elements are the
2247# addresses. This is needed to disambiguate failure (invalid)
2248# from success with no addresses found, because an empty string is
2249# a valid list.
2250
2251sub rfc822_validlist {
2252 my $s = rfc822_strip_comments(shift);
2253
2254 if (!$rfc822re) {
2255 $rfc822re = make_rfc822re();
2256 }
2257 # * null list items are valid according to the RFC
2258 # * the '1' business is to aid in distinguishing failure from no results
2259
2260 my @r;
2261 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2262 $s =~ m/^$rfc822_char*$/) {
2263 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2264 push(@r, $1);
2265 }
2266 return wantarray ? (scalar(@r), @r) : 1;
2267 }
2268 return wantarray ? () : 0;
2269}
Empty description
This page took 0.31415 seconds and 4 git commands to generate.