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

Archive Download this file



interactive