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