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