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