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

Archive Download this file



interactive