scripts/get_maintainer.pl: improve --git-chief-penquins (Linus Torvalds) filtering
[safe/jmp/linux-2.6] / 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_maintainers.pl [OPTIONS] <patch>
9 #        perl scripts/get_maintainers.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.16';
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 = 1;
27 my $email_git_penguin_chiefs = 0;
28 my $email_git_min_signatures = 1;
29 my $email_git_max_maintainers = 5;
30 my $email_git_since = "1-year-ago";
31 my $output_multiline = 1;
32 my $output_separator = ", ";
33 my $scm = 0;
34 my $web = 0;
35 my $subsystem = 0;
36 my $status = 0;
37 my $from_filename = 0;
38 my $version = 0;
39 my $help = 0;
40
41 my $exit = 0;
42
43 my @penguin_chief = ();
44 push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
45 #Andrew wants in on most everything - 2009/01/14
46 #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
47
48 my @penguin_chief_names = ();
49 foreach my $chief (@penguin_chief) {
50     if ($chief =~ m/^(.*):(.*)/) {
51         my $chief_name = $1;
52         my $chief_addr = $2;
53         push(@penguin_chief_names, $chief_name);
54     }
55 }
56 my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
57
58 if (!GetOptions(
59                 'email!' => \$email,
60                 'git!' => \$email_git,
61                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
62                 'git-min-signatures=i' => \$email_git_min_signatures,
63                 'git-max-maintainers=i' => \$email_git_max_maintainers,
64                 'git-since=s' => \$email_git_since,
65                 'm!' => \$email_maintainer,
66                 'n!' => \$email_usename,
67                 'l!' => \$email_list,
68                 's!' => \$email_subscriber_list,
69                 'multiline!' => \$output_multiline,
70                 'separator=s' => \$output_separator,
71                 'subsystem!' => \$subsystem,
72                 'status!' => \$status,
73                 'scm!' => \$scm,
74                 'web!' => \$web,
75                 'f|file' => \$from_filename,
76                 'v|version' => \$version,
77                 'h|help' => \$help,
78                 )) {
79     usage();
80     die "$P: invalid argument\n";
81 }
82
83 if ($help != 0) {
84     usage();
85     exit 0;
86 }
87
88 if ($version != 0) {
89     print("${P} ${V}\n");
90     exit 0;
91 }
92
93 if ($#ARGV < 0) {
94     usage();
95     die "$P: argument missing: patchfile or -f file please\n";
96 }
97
98 my $selections = $email + $scm + $status + $subsystem + $web;
99 if ($selections == 0) {
100     usage();
101     die "$P:  Missing required option: email, scm, status, subsystem or web\n";
102 }
103
104 if ($email && ($email_maintainer + $email_list + $email_subscriber_list
105                + $email_git + $email_git_penguin_chiefs) == 0) {
106     usage();
107     die "$P: Please select at least 1 email option\n";
108 }
109
110 if (!top_of_kernel_tree($lk_path)) {
111     die "$P: The current directory does not appear to be "
112         . "a linux kernel source tree.\n";
113 }
114
115 ## Read MAINTAINERS for type/value pairs
116
117 my @typevalue = ();
118 open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
119 while (<MAINT>) {
120     my $line = $_;
121
122     if ($line =~ m/^(\C):\s*(.*)/) {
123         my $type = $1;
124         my $value = $2;
125
126         ##Filename pattern matching
127         if ($type eq "F" || $type eq "X") {
128             $value =~ s@\.@\\\.@g;       ##Convert . to \.
129             $value =~ s/\*/\.\*/g;       ##Convert * to .*
130             $value =~ s/\?/\./g;         ##Convert ? to .
131         }
132         push(@typevalue, "$type:$value");
133     } elsif (!/^(\s)*$/) {
134         $line =~ s/\n$//g;
135         push(@typevalue, $line);
136     }
137 }
138 close(MAINT);
139
140 ## use the filenames on the command line or find the filenames in the patchfiles
141
142 my @files = ();
143
144 foreach my $file (@ARGV) {
145     next if ((-d $file));
146     if (!(-f $file)) {
147         die "$P: file '${file}' not found\n";
148     }
149     if ($from_filename) {
150         push(@files, $file);
151     } else {
152         my $file_cnt = @files;
153         open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
154         while (<PATCH>) {
155             if (m/^\+\+\+\s+(\S+)/) {
156                 my $filename = $1;
157                 $filename =~ s@^[^/]*/@@;
158                 $filename =~ s@\n@@;
159                 push(@files, $filename);
160             }
161         }
162         close(PATCH);
163         if ($file_cnt == @files) {
164             die "$P: file '${file}' doesn't appear to be a patch.  "
165                 . "Add -f to options?\n";
166         }
167         @files = sort_and_uniq(@files);
168     }
169 }
170
171 my @email_to = ();
172 my @list_to = ();
173 my @scm = ();
174 my @web = ();
175 my @subsystem = ();
176 my @status = ();
177
178 # Find responsible parties
179
180 foreach my $file (@files) {
181
182 #Do not match excluded file patterns
183
184     my $exclude = 0;
185     foreach my $line (@typevalue) {
186         if ($line =~ m/^(\C):\s*(.*)/) {
187             my $type = $1;
188             my $value = $2;
189             if ($type eq 'X') {
190                 if (file_match_pattern($file, $value)) {
191                     $exclude = 1;
192                 }
193             }
194         }
195     }
196
197     if (!$exclude) {
198         my $tvi = 0;
199         foreach my $line (@typevalue) {
200             if ($line =~ m/^(\C):\s*(.*)/) {
201                 my $type = $1;
202                 my $value = $2;
203                 if ($type eq 'F') {
204                     if (file_match_pattern($file, $value)) {
205                         add_categories($tvi);
206                     }
207                 }
208             }
209             $tvi++;
210         }
211     }
212
213     if ($email && $email_git) {
214         recent_git_signoffs($file);
215     }
216
217 }
218
219 if ($email) {
220     foreach my $chief (@penguin_chief) {
221         if ($chief =~ m/^(.*):(.*)/) {
222             my $email_address;
223             if ($email_usename) {
224                 $email_address = format_email($1, $2);
225             } else {
226                 $email_address = $2;
227             }
228             if ($email_git_penguin_chiefs) {
229                 push(@email_to, $email_address);
230             } else {
231                 @email_to = grep(!/${email_address}/, @email_to);
232             }
233         }
234     }
235 }
236
237 if ($email || $email_list) {
238     my @to = ();
239     if ($email) {
240         @to = (@to, @email_to);
241     }
242     if ($email_list) {
243         @to = (@to, @list_to);
244     }
245     output(uniq(@to));
246 }
247
248 if ($scm) {
249     @scm = sort_and_uniq(@scm);
250     output(@scm);
251 }
252
253 if ($status) {
254     @status = sort_and_uniq(@status);
255     output(@status);
256 }
257
258 if ($subsystem) {
259     @subsystem = sort_and_uniq(@subsystem);
260     output(@subsystem);
261 }
262
263 if ($web) {
264     @web = sort_and_uniq(@web);
265     output(@web);
266 }
267
268 exit($exit);
269
270 sub file_match_pattern {
271     my ($file, $pattern) = @_;
272     if (substr($pattern, -1) eq "/") {
273         if ($file =~ m@^$pattern@) {
274             return 1;
275         }
276     } else {
277         if ($file =~ m@^$pattern@) {
278             my $s1 = ($file =~ tr@/@@);
279             my $s2 = ($pattern =~ tr@/@@);
280             if ($s1 == $s2) {
281                 return 1;
282             }
283         }
284     }
285     return 0;
286 }
287
288 sub usage {
289     print <<EOT;
290 usage: $P [options] patchfile
291        $P [options] -f file
292 version: $V
293
294 MAINTAINER field selection options:
295   --email => print email address(es) if any
296     --git => include recent git \*-by: signers
297     --git-chief-penguins => include ${penguin_chiefs}
298     --git-min-signatures => number of signatures required (default: 1)
299     --git-max-maintainers => maximum maintainers to add (default: 5)
300     --git-since => git history to use (default: 1-year-ago)
301     --m => include maintainer(s) if any
302     --n => include name 'Full Name <addr\@domain.tld>'
303     --l => include list(s) if any
304     --s => include subscriber only list(s) if any
305   --scm => print SCM tree(s) if any
306   --status => print status if any
307   --subsystem => print subsystem name if any
308   --web => print website(s) if any
309
310 Output type options:
311   --separator [, ] => separator for multiple entries on 1 line
312   --multiline => print 1 entry per line
313
314 Default options:
315   [--email --git --m --n --l --multiline]
316
317 Other options:
318   --version => show version
319   --help => show this help information
320
321 EOT
322 }
323
324 sub top_of_kernel_tree {
325         my ($lk_path) = @_;
326
327         if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
328             $lk_path .= "/";
329         }
330         if (   (-f "${lk_path}COPYING")
331             && (-f "${lk_path}CREDITS")
332             && (-f "${lk_path}Kbuild")
333             && (-f "${lk_path}MAINTAINERS")
334             && (-f "${lk_path}Makefile")
335             && (-f "${lk_path}README")
336             && (-d "${lk_path}Documentation")
337             && (-d "${lk_path}arch")
338             && (-d "${lk_path}include")
339             && (-d "${lk_path}drivers")
340             && (-d "${lk_path}fs")
341             && (-d "${lk_path}init")
342             && (-d "${lk_path}ipc")
343             && (-d "${lk_path}kernel")
344             && (-d "${lk_path}lib")
345             && (-d "${lk_path}scripts")) {
346                 return 1;
347         }
348         return 0;
349 }
350
351 sub format_email {
352     my ($name, $email) = @_;
353
354     $name =~ s/^\s+|\s+$//g;
355     $email =~ s/^\s+|\s+$//g;
356
357     my $formatted_email = "";
358
359     if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
360         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
361         $formatted_email = "\"${name}\"\ \<${email}\>";
362     } else {
363         $formatted_email = "${name} \<${email}\>";
364     }
365     return $formatted_email;
366 }
367
368 sub add_categories {
369     my ($index) = @_;
370
371     $index = $index - 1;
372     while ($index >= 0) {
373         my $tv = $typevalue[$index];
374         if ($tv =~ m/^(\C):\s*(.*)/) {
375             my $ptype = $1;
376             my $pvalue = $2;
377             if ($ptype eq "L") {
378                 my $list_address = $pvalue;
379                 my $list_additional = "";
380                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
381                     $list_address = $1;
382                     $list_additional = $2;
383                 }
384                 if ($list_additional =~ m/subscribers-only/) {
385                     if ($email_subscriber_list) {
386                         push(@list_to, $list_address);
387                     }
388                 } else {
389                     if ($email_list) {
390                         push(@list_to, $list_address);
391                     }
392                 }
393             } elsif ($ptype eq "M") {
394                 if ($email_maintainer) {
395                     if ($index >= 0) {
396                         my $tv = $typevalue[$index - 1];
397                         if ($tv =~ m/^(\C):\s*(.*)/) {
398                             if ($1 eq "P" && $email_usename) {
399                                 push(@email_to, format_email($2, $pvalue));
400                             } else {
401                                 push(@email_to, $pvalue);
402                             }
403                         }
404                     } else {
405                         push(@email_to, $pvalue);
406                     }
407                 }
408             } elsif ($ptype eq "T") {
409                 push(@scm, $pvalue);
410             } elsif ($ptype eq "W") {
411                 push(@web, $pvalue);
412             } elsif ($ptype eq "S") {
413                 push(@status, $pvalue);
414             }
415
416             $index--;
417         } else {
418             push(@subsystem,$tv);
419             $index = -1;
420         }
421     }
422 }
423
424 sub which {
425     my ($bin) = @_;
426
427     foreach my $path (split(/:/, $ENV{PATH})) {
428         if (-e "$path/$bin") {
429             return "$path/$bin";
430         }
431     }
432
433     return "";
434 }
435
436 sub recent_git_signoffs {
437     my ($file) = @_;
438
439     my $sign_offs = "";
440     my $cmd = "";
441     my $output = "";
442     my $count = 0;
443     my @lines = ();
444
445     if (which("git") eq "") {
446         die("$P: git not found.  Add --nogit to options?\n");
447     }
448
449     $cmd = "git log --since=${email_git_since} -- ${file}";
450     $cmd .= " | grep -Pi \"^[-_         a-z]+by:.*\\\@.*\$\"";
451     $cmd .= " | cut -f2- -d\":\"";
452     $cmd .= " | sort | uniq -c | sort -rn";
453
454     $output = `${cmd}`;
455     $output =~ s/^\s*//gm;
456
457     @lines = split("\n", $output);
458     foreach my $line (@lines) {
459         if ($line =~ m/([0-9]+)\s+(.*)/) {
460             my $sign_offs = $1;
461             $line = $2;
462             $count++;
463             if ($sign_offs < $email_git_min_signatures ||
464                 $count > $email_git_max_maintainers) {
465                 last;
466             }
467         } else {
468             die("$P: Unexpected git output: ${line}\n");
469         }
470         if ($line =~ m/(.+)<(.+)>/) {
471             my $git_name = $1;
472             my $git_addr = $2;
473             $git_name =~ tr/^\"//;
474             $git_name =~ tr/^\\s*//;
475             $git_name =~ tr/\"$//;
476             $git_name =~ tr/\\s*$//;
477             if ($email_usename) {
478                 push(@email_to, format_email($git_name, $git_addr));
479             } else {
480                 push(@email_to, $git_addr);
481             }
482         } elsif ($line =~ m/<(.+)>/) {
483             my $git_addr = $1;
484             push(@email_to, $git_addr);
485         } else {
486             push(@email_to, $line);
487         }
488     }
489     return $output;
490 }
491
492 sub uniq {
493     my @parms = @_;
494
495     my %saw;
496     @parms = grep(!$saw{$_}++, @parms);
497     return @parms;
498 }
499
500 sub sort_and_uniq {
501     my @parms = @_;
502
503     my %saw;
504     @parms = sort @parms;
505     @parms = grep(!$saw{$_}++, @parms);
506     return @parms;
507 }
508
509 sub output {
510     my @parms = @_;
511
512     if ($output_multiline) {
513         foreach my $line (@parms) {
514             print("${line}\n");
515         }
516     } else {
517         print(join($output_separator, @parms));
518         print("\n");
519     }
520 }