scripts/get_maintainer.pl: add --sections, print entire matched subsystem
[linux-3.10.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.23';
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 = 1;
28 my $email_git_blame = 0;
29 my $email_git_min_signatures = 1;
30 my $email_git_max_maintainers = 5;
31 my $email_git_min_percent = 5;
32 my $email_git_since = "1-year-ago";
33 my $email_hg_since = "-365";
34 my $email_remove_duplicates = 1;
35 my $output_multiline = 1;
36 my $output_separator = ", ";
37 my $output_roles = 0;
38 my $output_rolestats = 0;
39 my $scm = 0;
40 my $web = 0;
41 my $subsystem = 0;
42 my $status = 0;
43 my $keywords = 1;
44 my $sections = 0;
45 my $file_emails = 0;
46 my $from_filename = 0;
47 my $pattern_depth = 0;
48 my $version = 0;
49 my $help = 0;
50
51 my $exit = 0;
52
53 my @penguin_chief = ();
54 push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
55 #Andrew wants in on most everything - 2009/01/14
56 #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
57
58 my @penguin_chief_names = ();
59 foreach my $chief (@penguin_chief) {
60     if ($chief =~ m/^(.*):(.*)/) {
61         my $chief_name = $1;
62         my $chief_addr = $2;
63         push(@penguin_chief_names, $chief_name);
64     }
65 }
66 my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
67
68 # rfc822 email address - preloaded methods go here.
69 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
70 my $rfc822_char = '[\\000-\\377]';
71
72 # VCS command support: class-like functions and strings
73
74 my %VCS_cmds;
75
76 my %VCS_cmds_git = (
77     "execute_cmd" => \&git_execute_cmd,
78     "available" => '(which("git") ne "") && (-d ".git")',
79     "find_signers_cmd" => "git log --no-color --since=\$email_git_since -- \$file",
80     "find_commit_signers_cmd" => "git log --no-color -1 \$commit",
81     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
82     "blame_file_cmd" => "git blame -l \$file",
83     "commit_pattern" => "^commit [0-9a-f]{40,40}",
84     "blame_commit_pattern" => "^([0-9a-f]+) "
85 );
86
87 my %VCS_cmds_hg = (
88     "execute_cmd" => \&hg_execute_cmd,
89     "available" => '(which("hg") ne "") && (-d ".hg")',
90     "find_signers_cmd" =>
91         "hg log --date=\$email_hg_since" .
92                 " --template='commit {node}\\n{desc}\\n' -- \$file",
93     "find_commit_signers_cmd" => "hg log --template='{desc}\\n' -r \$commit",
94     "blame_range_cmd" => "",            # not supported
95     "blame_file_cmd" => "hg blame -c \$file",
96     "commit_pattern" => "^commit [0-9a-f]{40,40}",
97     "blame_commit_pattern" => "^([0-9a-f]+):"
98 );
99
100 if (!GetOptions(
101                 'email!' => \$email,
102                 'git!' => \$email_git,
103                 'git-blame!' => \$email_git_blame,
104                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
105                 'git-min-signatures=i' => \$email_git_min_signatures,
106                 'git-max-maintainers=i' => \$email_git_max_maintainers,
107                 'git-min-percent=i' => \$email_git_min_percent,
108                 'git-since=s' => \$email_git_since,
109                 'hg-since=s' => \$email_hg_since,
110                 'remove-duplicates!' => \$email_remove_duplicates,
111                 'm!' => \$email_maintainer,
112                 'n!' => \$email_usename,
113                 'l!' => \$email_list,
114                 's!' => \$email_subscriber_list,
115                 'multiline!' => \$output_multiline,
116                 'roles!' => \$output_roles,
117                 'rolestats!' => \$output_rolestats,
118                 'separator=s' => \$output_separator,
119                 'subsystem!' => \$subsystem,
120                 'status!' => \$status,
121                 'scm!' => \$scm,
122                 'web!' => \$web,
123                 'pattern-depth=i' => \$pattern_depth,
124                 'k|keywords!' => \$keywords,
125                 'sections!' => \$sections,
126                 'fe|file-emails!' => \$file_emails,
127                 'f|file' => \$from_filename,
128                 'v|version' => \$version,
129                 'h|help' => \$help,
130                 )) {
131     die "$P: invalid argument - use --help if necessary\n";
132 }
133
134 if ($help != 0) {
135     usage();
136     exit 0;
137 }
138
139 if ($version != 0) {
140     print("${P} ${V}\n");
141     exit 0;
142 }
143
144 if ($#ARGV < 0) {
145     usage();
146     die "$P: argument missing: patchfile or -f file please\n";
147 }
148
149 if ($output_separator ne ", ") {
150     $output_multiline = 0;
151 }
152
153 if ($output_rolestats) {
154     $output_roles = 1;
155 }
156
157 if ($sections) {
158     $email = 0;
159     $email_list = 0;
160     $scm = 0;
161     $status = 0;
162     $subsystem = 0;
163     $web = 0;
164     $keywords = 0;
165 } else {
166     my $selections = $email + $scm + $status + $subsystem + $web;
167     if ($selections == 0) {
168         usage();
169         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
170     }
171 }
172
173 if ($email &&
174     ($email_maintainer + $email_list + $email_subscriber_list +
175      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
176     usage();
177     die "$P: Please select at least 1 email option\n";
178 }
179
180 if (!top_of_kernel_tree($lk_path)) {
181     die "$P: The current directory does not appear to be "
182         . "a linux kernel source tree.\n";
183 }
184
185 ## Read MAINTAINERS for type/value pairs
186
187 my @typevalue = ();
188 my %keyword_hash;
189
190 open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
191 while (<MAINT>) {
192     my $line = $_;
193
194     if ($line =~ m/^(\C):\s*(.*)/) {
195         my $type = $1;
196         my $value = $2;
197
198         ##Filename pattern matching
199         if ($type eq "F" || $type eq "X") {
200             $value =~ s@\.@\\\.@g;       ##Convert . to \.
201             $value =~ s/\*/\.\*/g;       ##Convert * to .*
202             $value =~ s/\?/\./g;         ##Convert ? to .
203             ##if pattern is a directory and it lacks a trailing slash, add one
204             if ((-d $value)) {
205                 $value =~ s@([^/])$@$1/@;
206             }
207         } elsif ($type eq "K") {
208             $keyword_hash{@typevalue} = $value;
209         }
210         push(@typevalue, "$type:$value");
211     } elsif (!/^(\s)*$/) {
212         $line =~ s/\n$//g;
213         push(@typevalue, $line);
214     }
215 }
216 close(MAINT);
217
218 my %mailmap;
219
220 if ($email_remove_duplicates) {
221     open(MAILMAP, "<${lk_path}.mailmap") || warn "$P: Can't open .mailmap\n";
222     while (<MAILMAP>) {
223         my $line = $_;
224
225         next if ($line =~ m/^\s*#/);
226         next if ($line =~ m/^\s*$/);
227
228         my ($name, $address) = parse_email($line);
229         $line = format_email($name, $address, $email_usename);
230
231         next if ($line =~ m/^\s*$/);
232
233         if (exists($mailmap{$name})) {
234             my $obj = $mailmap{$name};
235             push(@$obj, $address);
236         } else {
237             my @arr = ($address);
238             $mailmap{$name} = \@arr;
239         }
240     }
241     close(MAILMAP);
242 }
243
244 ## use the filenames on the command line or find the filenames in the patchfiles
245
246 my @files = ();
247 my @range = ();
248 my @keyword_tvi = ();
249 my @file_emails = ();
250
251 foreach my $file (@ARGV) {
252     ##if $file is a directory and it lacks a trailing slash, add one
253     if ((-d $file)) {
254         $file =~ s@([^/])$@$1/@;
255     } elsif (!(-f $file)) {
256         die "$P: file '${file}' not found\n";
257     }
258     if ($from_filename) {
259         push(@files, $file);
260         if (-f $file && ($keywords || $file_emails)) {
261             open(FILE, "<$file") or die "$P: Can't open ${file}\n";
262             my $text = do { local($/) ; <FILE> };
263             close(FILE);
264             if ($keywords) {
265                 foreach my $line (keys %keyword_hash) {
266                     if ($text =~ m/$keyword_hash{$line}/x) {
267                         push(@keyword_tvi, $line);
268                     }
269                 }
270             }
271             if ($file_emails) {
272                 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;
273                 push(@file_emails, clean_file_emails(@poss_addr));
274             }
275         }
276     } else {
277         my $file_cnt = @files;
278         my $lastfile;
279         open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
280         while (<PATCH>) {
281             my $patch_line = $_;
282             if (m/^\+\+\+\s+(\S+)/) {
283                 my $filename = $1;
284                 $filename =~ s@^[^/]*/@@;
285                 $filename =~ s@\n@@;
286                 $lastfile = $filename;
287                 push(@files, $filename);
288             } elsif (m/^\@\@ -(\d+),(\d+)/) {
289                 if ($email_git_blame) {
290                     push(@range, "$lastfile:$1:$2");
291                 }
292             } elsif ($keywords) {
293                 foreach my $line (keys %keyword_hash) {
294                     if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
295                         push(@keyword_tvi, $line);
296                     }
297                 }
298             }
299         }
300         close(PATCH);
301         if ($file_cnt == @files) {
302             warn "$P: file '${file}' doesn't appear to be a patch.  "
303                 . "Add -f to options?\n";
304         }
305         @files = sort_and_uniq(@files);
306     }
307 }
308
309 @file_emails = uniq(@file_emails);
310
311 my @email_to = ();
312 my @list_to = ();
313 my @scm = ();
314 my @web = ();
315 my @subsystem = ();
316 my @status = ();
317
318 # Find responsible parties
319
320 foreach my $file (@files) {
321
322     my %hash;
323     my $tvi = find_first_section();
324     while ($tvi < @typevalue) {
325         my $start = find_starting_index($tvi);
326         my $end = find_ending_index($tvi);
327         my $exclude = 0;
328         my $i;
329
330         #Do not match excluded file patterns
331
332         for ($i = $start; $i < $end; $i++) {
333             my $line = $typevalue[$i];
334             if ($line =~ m/^(\C):\s*(.*)/) {
335                 my $type = $1;
336                 my $value = $2;
337                 if ($type eq 'X') {
338                     if (file_match_pattern($file, $value)) {
339                         $exclude = 1;
340                     }
341                 }
342             }
343         }
344
345         if (!$exclude) {
346             for ($i = $start; $i < $end; $i++) {
347                 my $line = $typevalue[$i];
348                 if ($line =~ m/^(\C):\s*(.*)/) {
349                     my $type = $1;
350                     my $value = $2;
351                     if ($type eq 'F') {
352                         if (file_match_pattern($file, $value)) {
353                             my $value_pd = ($value =~ tr@/@@);
354                             my $file_pd = ($file  =~ tr@/@@);
355                             $value_pd++ if (substr($value,-1,1) ne "/");
356                             if ($pattern_depth == 0 ||
357                                 (($file_pd - $value_pd) < $pattern_depth)) {
358                                 $hash{$tvi} = $value_pd;
359                             }
360                         }
361                     }
362                 }
363             }
364         }
365
366         $tvi += ($end - $start);
367
368     }
369
370     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
371         add_categories($line);
372             if ($sections) {
373                 my $i;
374                 my $start = find_starting_index($line);
375                 my $end = find_ending_index($line);
376                 for ($i = $start; $i < $end; $i++) {
377                     my $line = $typevalue[$i];
378                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
379                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
380                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
381                         $line =~ s/\\\./\./g;           ##Convert \. to .
382                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
383                     }
384                     print("$line\n");
385                 }
386             }
387     }
388
389     if ($email && $email_git) {
390         vcs_file_signoffs($file);
391     }
392
393     if ($email && $email_git_blame) {
394         vcs_file_blame($file);
395     }
396 }
397
398 if ($keywords) {
399     @keyword_tvi = sort_and_uniq(@keyword_tvi);
400     foreach my $line (@keyword_tvi) {
401         add_categories($line);
402     }
403 }
404
405 if ($email) {
406     foreach my $chief (@penguin_chief) {
407         if ($chief =~ m/^(.*):(.*)/) {
408             my $email_address;
409
410             $email_address = format_email($1, $2, $email_usename);
411             if ($email_git_penguin_chiefs) {
412                 push(@email_to, [$email_address, 'chief penguin']);
413             } else {
414                 @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
415             }
416         }
417     }
418
419     foreach my $email (@file_emails) {
420         my ($name, $address) = parse_email($email);
421
422         my $tmp_email = format_email($name, $address, $email_usename);
423         push_email_address($tmp_email, '');
424         add_role($tmp_email, 'in file');
425     }
426 }
427
428 if ($email || $email_list) {
429     my @to = ();
430     if ($email) {
431         @to = (@to, @email_to);
432     }
433     if ($email_list) {
434         @to = (@to, @list_to);
435     }
436     output(merge_email(@to));
437 }
438
439 if ($scm) {
440     @scm = uniq(@scm);
441     output(@scm);
442 }
443
444 if ($status) {
445     @status = uniq(@status);
446     output(@status);
447 }
448
449 if ($subsystem) {
450     @subsystem = uniq(@subsystem);
451     output(@subsystem);
452 }
453
454 if ($web) {
455     @web = uniq(@web);
456     output(@web);
457 }
458
459 exit($exit);
460
461 sub file_match_pattern {
462     my ($file, $pattern) = @_;
463     if (substr($pattern, -1) eq "/") {
464         if ($file =~ m@^$pattern@) {
465             return 1;
466         }
467     } else {
468         if ($file =~ m@^$pattern@) {
469             my $s1 = ($file =~ tr@/@@);
470             my $s2 = ($pattern =~ tr@/@@);
471             if ($s1 == $s2) {
472                 return 1;
473             }
474         }
475     }
476     return 0;
477 }
478
479 sub usage {
480     print <<EOT;
481 usage: $P [options] patchfile
482        $P [options] -f file|directory
483 version: $V
484
485 MAINTAINER field selection options:
486   --email => print email address(es) if any
487     --git => include recent git \*-by: signers
488     --git-chief-penguins => include ${penguin_chiefs}
489     --git-min-signatures => number of signatures required (default: 1)
490     --git-max-maintainers => maximum maintainers to add (default: 5)
491     --git-min-percent => minimum percentage of commits required (default: 5)
492     --git-blame => use git blame to find modified commits for patch or file
493     --git-since => git history to use (default: 1-year-ago)
494     --hg-since => hg history to use (default: -365)
495     --m => include maintainer(s) if any
496     --n => include name 'Full Name <addr\@domain.tld>'
497     --l => include list(s) if any
498     --s => include subscriber only list(s) if any
499     --remove-duplicates => minimize duplicate email names/addresses
500     --roles => show roles (status:subsystem, git-signer, list, etc...)
501     --rolestats => show roles and statistics (commits/total_commits, %)
502     --file-emails => add email addresses found in -f file (default: 0 (off))
503   --scm => print SCM tree(s) if any
504   --status => print status if any
505   --subsystem => print subsystem name if any
506   --web => print website(s) if any
507
508 Output type options:
509   --separator [, ] => separator for multiple entries on 1 line
510     using --separator also sets --nomultiline if --separator is not [, ]
511   --multiline => print 1 entry per line
512
513 Other options:
514   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
515   --keywords => scan patch for keywords (default: 1 (on))
516   --sections => print the entire subsystem sections with pattern matches
517   --version => show version
518   --help => show this help information
519
520 Default options:
521   [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
522
523 Notes:
524   Using "-f directory" may give unexpected results:
525       Used with "--git", git signators for _all_ files in and below
526           directory are examined as git recurses directories.
527           Any specified X: (exclude) pattern matches are _not_ ignored.
528       Used with "--nogit", directory is used as a pattern match,
529           no individual file within the directory or subdirectory
530           is matched.
531       Used with "--git-blame", does not iterate all files in directory
532   Using "--git-blame" is slow and may add old committers and authors
533       that are no longer active maintainers to the output.
534   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
535       other automated tools that expect only ["name"] <email address>
536       may not work because of additional output after <email address>.
537   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
538       not the percentage of the entire file authored.  # of commits is
539       not a good measure of amount of code authored.  1 major commit may
540       contain a thousand lines, 5 trivial commits may modify a single line.
541   If git is not installed, but mercurial (hg) is installed and an .hg
542       repository exists, the following options apply to mercurial:
543           --git,
544           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
545           --git-blame
546       Use --hg-since not --git-since to control date selection
547 EOT
548 }
549
550 sub top_of_kernel_tree {
551         my ($lk_path) = @_;
552
553         if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
554             $lk_path .= "/";
555         }
556         if (   (-f "${lk_path}COPYING")
557             && (-f "${lk_path}CREDITS")
558             && (-f "${lk_path}Kbuild")
559             && (-f "${lk_path}MAINTAINERS")
560             && (-f "${lk_path}Makefile")
561             && (-f "${lk_path}README")
562             && (-d "${lk_path}Documentation")
563             && (-d "${lk_path}arch")
564             && (-d "${lk_path}include")
565             && (-d "${lk_path}drivers")
566             && (-d "${lk_path}fs")
567             && (-d "${lk_path}init")
568             && (-d "${lk_path}ipc")
569             && (-d "${lk_path}kernel")
570             && (-d "${lk_path}lib")
571             && (-d "${lk_path}scripts")) {
572                 return 1;
573         }
574         return 0;
575 }
576
577 sub parse_email {
578     my ($formatted_email) = @_;
579
580     my $name = "";
581     my $address = "";
582
583     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
584         $name = $1;
585         $address = $2;
586     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
587         $address = $1;
588     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
589         $address = $1;
590     }
591
592     $name =~ s/^\s+|\s+$//g;
593     $name =~ s/^\"|\"$//g;
594     $address =~ s/^\s+|\s+$//g;
595
596     if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
597         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
598         $name = "\"$name\"";
599     }
600
601     return ($name, $address);
602 }
603
604 sub format_email {
605     my ($name, $address, $usename) = @_;
606
607     my $formatted_email;
608
609     $name =~ s/^\s+|\s+$//g;
610     $name =~ s/^\"|\"$//g;
611     $address =~ s/^\s+|\s+$//g;
612
613     if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
614         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
615         $name = "\"$name\"";
616     }
617
618     if ($usename) {
619         if ("$name" eq "") {
620             $formatted_email = "$address";
621         } else {
622             $formatted_email = "$name <$address>";
623         }
624     } else {
625         $formatted_email = $address;
626     }
627
628     return $formatted_email;
629 }
630
631 sub find_first_section {
632     my $index = 0;
633
634     while ($index < @typevalue) {
635         my $tv = $typevalue[$index];
636         if (($tv =~ m/^(\C):\s*(.*)/)) {
637             last;
638         }
639         $index++;
640     }
641
642     return $index;
643 }
644
645 sub find_starting_index {
646     my ($index) = @_;
647
648     while ($index > 0) {
649         my $tv = $typevalue[$index];
650         if (!($tv =~ m/^(\C):\s*(.*)/)) {
651             last;
652         }
653         $index--;
654     }
655
656     return $index;
657 }
658
659 sub find_ending_index {
660     my ($index) = @_;
661
662     while ($index < @typevalue) {
663         my $tv = $typevalue[$index];
664         if (!($tv =~ m/^(\C):\s*(.*)/)) {
665             last;
666         }
667         $index++;
668     }
669
670     return $index;
671 }
672
673 sub get_maintainer_role {
674     my ($index) = @_;
675
676     my $i;
677     my $start = find_starting_index($index);
678     my $end = find_ending_index($index);
679
680     my $role;
681     my $subsystem = $typevalue[$start];
682     if (length($subsystem) > 20) {
683         $subsystem = substr($subsystem, 0, 17);
684         $subsystem =~ s/\s*$//;
685         $subsystem = $subsystem . "...";
686     }
687
688     for ($i = $start + 1; $i < $end; $i++) {
689         my $tv = $typevalue[$i];
690         if ($tv =~ m/^(\C):\s*(.*)/) {
691             my $ptype = $1;
692             my $pvalue = $2;
693             if ($ptype eq "S") {
694                 $role = $pvalue;
695             }
696         }
697     }
698
699     $role = lc($role);
700     if      ($role eq "supported") {
701         $role = "supporter";
702     } elsif ($role eq "maintained") {
703         $role = "maintainer";
704     } elsif ($role eq "odd fixes") {
705         $role = "odd fixer";
706     } elsif ($role eq "orphan") {
707         $role = "orphan minder";
708     } elsif ($role eq "obsolete") {
709         $role = "obsolete minder";
710     } elsif ($role eq "buried alive in reporters") {
711         $role = "chief penguin";
712     }
713
714     return $role . ":" . $subsystem;
715 }
716
717 sub get_list_role {
718     my ($index) = @_;
719
720     my $i;
721     my $start = find_starting_index($index);
722     my $end = find_ending_index($index);
723
724     my $subsystem = $typevalue[$start];
725     if (length($subsystem) > 20) {
726         $subsystem = substr($subsystem, 0, 17);
727         $subsystem =~ s/\s*$//;
728         $subsystem = $subsystem . "...";
729     }
730
731     if ($subsystem eq "THE REST") {
732         $subsystem = "";
733     }
734
735     return $subsystem;
736 }
737
738 sub add_categories {
739     my ($index) = @_;
740
741     my $i;
742     my $start = find_starting_index($index);
743     my $end = find_ending_index($index);
744
745     push(@subsystem, $typevalue[$start]);
746
747     for ($i = $start + 1; $i < $end; $i++) {
748         my $tv = $typevalue[$i];
749         if ($tv =~ m/^(\C):\s*(.*)/) {
750             my $ptype = $1;
751             my $pvalue = $2;
752             if ($ptype eq "L") {
753                 my $list_address = $pvalue;
754                 my $list_additional = "";
755                 my $list_role = get_list_role($i);
756
757                 if ($list_role ne "") {
758                     $list_role = ":" . $list_role;
759                 }
760                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
761                     $list_address = $1;
762                     $list_additional = $2;
763                 }
764                 if ($list_additional =~ m/subscribers-only/) {
765                     if ($email_subscriber_list) {
766                         push(@list_to, [$list_address, "subscriber list${list_role}"]);
767                     }
768                 } else {
769                     if ($email_list) {
770                         push(@list_to, [$list_address, "open list${list_role}"]);
771                     }
772                 }
773             } elsif ($ptype eq "M") {
774                 my ($name, $address) = parse_email($pvalue);
775                 if ($name eq "") {
776                     if ($i > 0) {
777                         my $tv = $typevalue[$i - 1];
778                         if ($tv =~ m/^(\C):\s*(.*)/) {
779                             if ($1 eq "P") {
780                                 $name = $2;
781                                 $pvalue = format_email($name, $address, $email_usename);
782                             }
783                         }
784                     }
785                 }
786                 if ($email_maintainer) {
787                     my $role = get_maintainer_role($i);
788                     push_email_addresses($pvalue, $role);
789                 }
790             } elsif ($ptype eq "T") {
791                 push(@scm, $pvalue);
792             } elsif ($ptype eq "W") {
793                 push(@web, $pvalue);
794             } elsif ($ptype eq "S") {
795                 push(@status, $pvalue);
796             }
797         }
798     }
799 }
800
801 my %email_hash_name;
802 my %email_hash_address;
803
804 sub email_inuse {
805     my ($name, $address) = @_;
806
807     return 1 if (($name eq "") && ($address eq ""));
808     return 1 if (($name ne "") && exists($email_hash_name{$name}));
809     return 1 if (($address ne "") && exists($email_hash_address{$address}));
810
811     return 0;
812 }
813
814 sub push_email_address {
815     my ($line, $role) = @_;
816
817     my ($name, $address) = parse_email($line);
818
819     if ($address eq "") {
820         return 0;
821     }
822
823     if (!$email_remove_duplicates) {
824         push(@email_to, [format_email($name, $address, $email_usename), $role]);
825     } elsif (!email_inuse($name, $address)) {
826         push(@email_to, [format_email($name, $address, $email_usename), $role]);
827         $email_hash_name{$name}++;
828         $email_hash_address{$address}++;
829     }
830
831     return 1;
832 }
833
834 sub push_email_addresses {
835     my ($address, $role) = @_;
836
837     my @address_list = ();
838
839     if (rfc822_valid($address)) {
840         push_email_address($address, $role);
841     } elsif (@address_list = rfc822_validlist($address)) {
842         my $array_count = shift(@address_list);
843         while (my $entry = shift(@address_list)) {
844             push_email_address($entry, $role);
845         }
846     } else {
847         if (!push_email_address($address, $role)) {
848             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
849         }
850     }
851 }
852
853 sub add_role {
854     my ($line, $role) = @_;
855
856     my ($name, $address) = parse_email($line);
857     my $email = format_email($name, $address, $email_usename);
858
859     foreach my $entry (@email_to) {
860         if ($email_remove_duplicates) {
861             my ($entry_name, $entry_address) = parse_email($entry->[0]);
862             if (($name eq $entry_name || $address eq $entry_address)
863                 && ($role eq "" || !($entry->[1] =~ m/$role/))
864             ) {
865                 if ($entry->[1] eq "") {
866                     $entry->[1] = "$role";
867                 } else {
868                     $entry->[1] = "$entry->[1],$role";
869                 }
870             }
871         } else {
872             if ($email eq $entry->[0]
873                 && ($role eq "" || !($entry->[1] =~ m/$role/))
874             ) {
875                 if ($entry->[1] eq "") {
876                     $entry->[1] = "$role";
877                 } else {
878                     $entry->[1] = "$entry->[1],$role";
879                 }
880             }
881         }
882     }
883 }
884
885 sub which {
886     my ($bin) = @_;
887
888     foreach my $path (split(/:/, $ENV{PATH})) {
889         if (-e "$path/$bin") {
890             return "$path/$bin";
891         }
892     }
893
894     return "";
895 }
896
897 sub mailmap {
898     my (@lines) = @_;
899     my %hash;
900
901     foreach my $line (@lines) {
902         my ($name, $address) = parse_email($line);
903         if (!exists($hash{$name})) {
904             $hash{$name} = $address;
905         } elsif ($address ne $hash{$name}) {
906             $address = $hash{$name};
907             $line = format_email($name, $address, $email_usename);
908         }
909         if (exists($mailmap{$name})) {
910             my $obj = $mailmap{$name};
911             foreach my $map_address (@$obj) {
912                 if (($map_address eq $address) &&
913                     ($map_address ne $hash{$name})) {
914                     $line = format_email($name, $hash{$name}, $email_usename);
915                 }
916             }
917         }
918     }
919
920     return @lines;
921 }
922
923 sub git_execute_cmd {
924     my ($cmd) = @_;
925     my @lines = ();
926
927     my $output = `$cmd`;
928     $output =~ s/^\s*//gm;
929     @lines = split("\n", $output);
930
931     return @lines;
932 }
933
934 sub hg_execute_cmd {
935     my ($cmd) = @_;
936     my @lines = ();
937
938     my $output = `$cmd`;
939     @lines = split("\n", $output);
940
941     return @lines;
942 }
943
944 sub vcs_find_signers {
945     my ($cmd) = @_;
946     my @lines = ();
947     my $commits;
948
949     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
950
951     my $pattern = $VCS_cmds{"commit_pattern"};
952
953     $commits = grep(/$pattern/, @lines);        # of commits
954
955     @lines = grep(/^[-_         a-z]+by:.*\@.*$/i, @lines);
956     if (!$email_git_penguin_chiefs) {
957         @lines = grep(!/${penguin_chiefs}/i, @lines);
958     }
959     # cut -f2- -d":"
960     s/.*:\s*(.+)\s*/$1/ for (@lines);
961
962 ## Reformat email addresses (with names) to avoid badly written signatures
963
964     foreach my $line (@lines) {
965         my ($name, $address) = parse_email($line);
966         $line = format_email($name, $address, 1);
967     }
968
969     return ($commits, @lines);
970 }
971
972 sub vcs_save_commits {
973     my ($cmd) = @_;
974     my @lines = ();
975     my @commits = ();
976
977     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
978
979     foreach my $line (@lines) {
980         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
981             push(@commits, $1);
982         }
983     }
984
985     return @commits;
986 }
987
988 sub vcs_blame {
989     my ($file) = @_;
990     my $cmd;
991     my @commits = ();
992
993     return @commits if (!(-f $file));
994
995     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
996         my @all_commits = ();
997
998         $cmd = $VCS_cmds{"blame_file_cmd"};
999         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1000         @all_commits = vcs_save_commits($cmd);
1001
1002         foreach my $file_range_diff (@range) {
1003             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1004             my $diff_file = $1;
1005             my $diff_start = $2;
1006             my $diff_length = $3;
1007             next if ("$file" ne "$diff_file");
1008             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1009                 push(@commits, $all_commits[$i]);
1010             }
1011         }
1012     } elsif (@range) {
1013         foreach my $file_range_diff (@range) {
1014             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1015             my $diff_file = $1;
1016             my $diff_start = $2;
1017             my $diff_length = $3;
1018             next if ("$file" ne "$diff_file");
1019             $cmd = $VCS_cmds{"blame_range_cmd"};
1020             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1021             push(@commits, vcs_save_commits($cmd));
1022         }
1023     } else {
1024         $cmd = $VCS_cmds{"blame_file_cmd"};
1025         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1026         @commits = vcs_save_commits($cmd);
1027     }
1028
1029     return @commits;
1030 }
1031
1032 my $printed_novcs = 0;
1033 sub vcs_exists {
1034     %VCS_cmds = %VCS_cmds_git;
1035     return 1 if eval $VCS_cmds{"available"};
1036     %VCS_cmds = %VCS_cmds_hg;
1037     return 1 if eval $VCS_cmds{"available"};
1038     %VCS_cmds = ();
1039     if (!$printed_novcs) {
1040         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1041         warn("Using a git repository produces better results.\n");
1042         warn("Try Linus Torvalds' latest git repository using:\n");
1043         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n");
1044         $printed_novcs = 1;
1045     }
1046     return 0;
1047 }
1048
1049 sub vcs_assign {
1050     my ($role, $divisor, @lines) = @_;
1051
1052     my %hash;
1053     my $count = 0;
1054
1055     return if (@lines <= 0);
1056
1057     if ($divisor <= 0) {
1058         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1059         $divisor = 1;
1060     }
1061
1062     if ($email_remove_duplicates) {
1063         @lines = mailmap(@lines);
1064     }
1065
1066     @lines = sort(@lines);
1067
1068     # uniq -c
1069     $hash{$_}++ for @lines;
1070
1071     # sort -rn
1072     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1073         my $sign_offs = $hash{$line};
1074         my $percent = $sign_offs * 100 / $divisor;
1075
1076         $percent = 100 if ($percent > 100);
1077         $count++;
1078         last if ($sign_offs < $email_git_min_signatures ||
1079                  $count > $email_git_max_maintainers ||
1080                  $percent < $email_git_min_percent);
1081         push_email_address($line, '');
1082         if ($output_rolestats) {
1083             my $fmt_percent = sprintf("%.0f", $percent);
1084             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1085         } else {
1086             add_role($line, $role);
1087         }
1088     }
1089 }
1090
1091 sub vcs_file_signoffs {
1092     my ($file) = @_;
1093
1094     my @signers = ();
1095     my $commits;
1096
1097     return if (!vcs_exists());
1098
1099     my $cmd = $VCS_cmds{"find_signers_cmd"};
1100     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
1101
1102     ($commits, @signers) = vcs_find_signers($cmd);
1103     vcs_assign("commit_signer", $commits, @signers);
1104 }
1105
1106 sub vcs_file_blame {
1107     my ($file) = @_;
1108
1109     my @signers = ();
1110     my @commits = ();
1111     my $total_commits;
1112
1113     return if (!vcs_exists());
1114
1115     @commits = vcs_blame($file);
1116     @commits = uniq(@commits);
1117     $total_commits = @commits;
1118
1119     foreach my $commit (@commits) {
1120         my $commit_count;
1121         my @commit_signers = ();
1122
1123         my $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1124         $cmd =~ s/(\$\w+)/$1/eeg;       #interpolate $cmd
1125
1126         ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1127         push(@signers, @commit_signers);
1128     }
1129
1130     if ($from_filename) {
1131         vcs_assign("commits", $total_commits, @signers);
1132     } else {
1133         vcs_assign("modified commits", $total_commits, @signers);
1134     }
1135 }
1136
1137 sub uniq {
1138     my (@parms) = @_;
1139
1140     my %saw;
1141     @parms = grep(!$saw{$_}++, @parms);
1142     return @parms;
1143 }
1144
1145 sub sort_and_uniq {
1146     my (@parms) = @_;
1147
1148     my %saw;
1149     @parms = sort @parms;
1150     @parms = grep(!$saw{$_}++, @parms);
1151     return @parms;
1152 }
1153
1154 sub clean_file_emails {
1155     my (@file_emails) = @_;
1156     my @fmt_emails = ();
1157
1158     foreach my $email (@file_emails) {
1159         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
1160         my ($name, $address) = parse_email($email);
1161         if ($name eq '"[,\.]"') {
1162             $name = "";
1163         }
1164
1165         my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
1166         if (@nw > 2) {
1167             my $first = $nw[@nw - 3];
1168             my $middle = $nw[@nw - 2];
1169             my $last = $nw[@nw - 1];
1170
1171             if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
1172                  (length($first) == 2 && substr($first, -1) eq ".")) ||
1173                 (length($middle) == 1 ||
1174                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
1175                 $name = "$first $middle $last";
1176             } else {
1177                 $name = "$middle $last";
1178             }
1179         }
1180
1181         if (substr($name, -1) =~ /[,\.]/) {
1182             $name = substr($name, 0, length($name) - 1);
1183         } elsif (substr($name, -2) =~ /[,\.]"/) {
1184             $name = substr($name, 0, length($name) - 2) . '"';
1185         }
1186
1187         if (substr($name, 0, 1) =~ /[,\.]/) {
1188             $name = substr($name, 1, length($name) - 1);
1189         } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
1190             $name = '"' . substr($name, 2, length($name) - 2);
1191         }
1192
1193         my $fmt_email = format_email($name, $address, $email_usename);
1194         push(@fmt_emails, $fmt_email);
1195     }
1196     return @fmt_emails;
1197 }
1198
1199 sub merge_email {
1200     my @lines;
1201     my %saw;
1202
1203     for (@_) {
1204         my ($address, $role) = @$_;
1205         if (!$saw{$address}) {
1206             if ($output_roles) {
1207                 push(@lines, "$address ($role)");
1208             } else {
1209                 push(@lines, $address);
1210             }
1211             $saw{$address} = 1;
1212         }
1213     }
1214
1215     return @lines;
1216 }
1217
1218 sub output {
1219     my (@parms) = @_;
1220
1221     if ($output_multiline) {
1222         foreach my $line (@parms) {
1223             print("${line}\n");
1224         }
1225     } else {
1226         print(join($output_separator, @parms));
1227         print("\n");
1228     }
1229 }
1230
1231 my $rfc822re;
1232
1233 sub make_rfc822re {
1234 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
1235 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
1236 #   This regexp will only work on addresses which have had comments stripped
1237 #   and replaced with rfc822_lwsp.
1238
1239     my $specials = '()<>@,;:\\\\".\\[\\]';
1240     my $controls = '\\000-\\037\\177';
1241
1242     my $dtext = "[^\\[\\]\\r\\\\]";
1243     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
1244
1245     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
1246
1247 #   Use zero-width assertion to spot the limit of an atom.  A simple
1248 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
1249     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
1250     my $word = "(?:$atom|$quoted_string)";
1251     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
1252
1253     my $sub_domain = "(?:$atom|$domain_literal)";
1254     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
1255
1256     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
1257
1258     my $phrase = "$word*";
1259     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
1260     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
1261     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
1262
1263     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
1264     my $address = "(?:$mailbox|$group)";
1265
1266     return "$rfc822_lwsp*$address";
1267 }
1268
1269 sub rfc822_strip_comments {
1270     my $s = shift;
1271 #   Recursively remove comments, and replace with a single space.  The simpler
1272 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
1273 #   chars in atoms, for example.
1274
1275     while ($s =~ s/^((?:[^"\\]|\\.)*
1276                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
1277                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
1278     return $s;
1279 }
1280
1281 #   valid: returns true if the parameter is an RFC822 valid address
1282 #
1283 sub rfc822_valid ($) {
1284     my $s = rfc822_strip_comments(shift);
1285
1286     if (!$rfc822re) {
1287         $rfc822re = make_rfc822re();
1288     }
1289
1290     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
1291 }
1292
1293 #   validlist: In scalar context, returns true if the parameter is an RFC822
1294 #              valid list of addresses.
1295 #
1296 #              In list context, returns an empty list on failure (an invalid
1297 #              address was found); otherwise a list whose first element is the
1298 #              number of addresses found and whose remaining elements are the
1299 #              addresses.  This is needed to disambiguate failure (invalid)
1300 #              from success with no addresses found, because an empty string is
1301 #              a valid list.
1302
1303 sub rfc822_validlist ($) {
1304     my $s = rfc822_strip_comments(shift);
1305
1306     if (!$rfc822re) {
1307         $rfc822re = make_rfc822re();
1308     }
1309     # * null list items are valid according to the RFC
1310     # * the '1' business is to aid in distinguishing failure from no results
1311
1312     my @r;
1313     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
1314         $s =~ m/^$rfc822_char*$/) {
1315         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
1316             push(@r, $1);
1317         }
1318         return wantarray ? (scalar(@r), @r) : 1;
1319     }
1320     return wantarray ? () : 0;
1321 }