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