Root/scripts/get_maintainer.pl

Source at commit cdde9cf73945d547acd3e96f9508c79e84ad0bf1 created 9 years 4 months ago.
By Maarten ter Huurne, MMC: JZ4740: Added support for CPU frequency changing
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+)/) {
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            }
615            }
616        }
617        }
618        $tvi = $end + 1;
619    }
620
621    foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
622        add_categories($line);
623        if ($sections) {
624        my $i;
625        my $start = find_starting_index($line);
626        my $end = find_ending_index($line);
627        for ($i = $start; $i < $end; $i++) {
628            my $line = $typevalue[$i];
629            if ($line =~ /^[FX]:/) { ##Restore file patterns
630            $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
631            $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
632            $line =~ s/\\\./\./g; ##Convert \. to .
633            $line =~ s/\.\*/\*/g; ##Convert .* to *
634            }
635            $line =~ s/^([A-Z]):/$1:\t/g;
636            print("$line\n");
637        }
638        print("\n");
639        }
640    }
641    }
642
643    if ($keywords) {
644    @keyword_tvi = sort_and_uniq(@keyword_tvi);
645    foreach my $line (@keyword_tvi) {
646        add_categories($line);
647    }
648    }
649
650    foreach my $email (@email_to, @list_to) {
651    $email->[0] = deduplicate_email($email->[0]);
652    }
653
654    foreach my $file (@files) {
655    if ($email &&
656        ($email_git || ($email_git_fallback &&
657                !$exact_pattern_match_hash{$file}))) {
658        vcs_file_signoffs($file);
659    }
660    if ($email && $email_git_blame) {
661        vcs_file_blame($file);
662    }
663    }
664
665    if ($email) {
666    foreach my $chief (@penguin_chief) {
667        if ($chief =~ m/^(.*):(.*)/) {
668        my $email_address;
669
670        $email_address = format_email($1, $2, $email_usename);
671        if ($email_git_penguin_chiefs) {
672            push(@email_to, [$email_address, 'chief penguin']);
673        } else {
674            @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
675        }
676        }
677    }
678
679    foreach my $email (@file_emails) {
680        my ($name, $address) = parse_email($email);
681
682        my $tmp_email = format_email($name, $address, $email_usename);
683        push_email_address($tmp_email, '');
684        add_role($tmp_email, 'in file');
685    }
686    }
687
688    my @to = ();
689    if ($email || $email_list) {
690    if ($email) {
691        @to = (@to, @email_to);
692    }
693    if ($email_list) {
694        @to = (@to, @list_to);
695    }
696    }
697
698    if ($interactive) {
699    @to = interactive_get_maintainers(\@to);
700    }
701
702    return @to;
703}
704
705sub file_match_pattern {
706    my ($file, $pattern) = @_;
707    if (substr($pattern, -1) eq "/") {
708    if ($file =~ m@^$pattern@) {
709        return 1;
710    }
711    } else {
712    if ($file =~ m@^$pattern@) {
713        my $s1 = ($file =~ tr@/@@);
714        my $s2 = ($pattern =~ tr@/@@);
715        if ($s1 == $s2) {
716        return 1;
717        }
718    }
719    }
720    return 0;
721}
722
723sub usage {
724    print <<EOT;
725usage: $P [options] patchfile
726       $P [options] -f file|directory
727version: $V
728
729MAINTAINER field selection options:
730  --email => print email address(es) if any
731    --git => include recent git \*-by: signers
732    --git-all-signature-types => include signers regardless of signature type
733        or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
734    --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
735    --git-chief-penguins => include ${penguin_chiefs}
736    --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
737    --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
738    --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
739    --git-blame => use git blame to find modified commits for patch or file
740    --git-since => git history to use (default: $email_git_since)
741    --hg-since => hg history to use (default: $email_hg_since)
742    --interactive => display a menu (mostly useful if used with the --git option)
743    --m => include maintainer(s) if any
744    --n => include name 'Full Name <addr\@domain.tld>'
745    --l => include list(s) if any
746    --s => include subscriber only list(s) if any
747    --remove-duplicates => minimize duplicate email names/addresses
748    --roles => show roles (status:subsystem, git-signer, list, etc...)
749    --rolestats => show roles and statistics (commits/total_commits, %)
750    --file-emails => add email addresses found in -f file (default: 0 (off))
751  --scm => print SCM tree(s) if any
752  --status => print status if any
753  --subsystem => print subsystem name if any
754  --web => print website(s) if any
755
756Output type options:
757  --separator [, ] => separator for multiple entries on 1 line
758    using --separator also sets --nomultiline if --separator is not [, ]
759  --multiline => print 1 entry per line
760
761Other options:
762  --pattern-depth => Number of pattern directory traversals (default: 0 (all))
763  --keywords => scan patch for keywords (default: $keywords)
764  --sections => print all of the subsystem sections with pattern matches
765  --mailmap => use .mailmap file (default: $email_use_mailmap)
766  --version => show version
767  --help => show this help information
768
769Default options:
770  [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
771   --remove-duplicates --rolestats]
772
773Notes:
774  Using "-f directory" may give unexpected results:
775      Used with "--git", git signators for _all_ files in and below
776          directory are examined as git recurses directories.
777          Any specified X: (exclude) pattern matches are _not_ ignored.
778      Used with "--nogit", directory is used as a pattern match,
779          no individual file within the directory or subdirectory
780          is matched.
781      Used with "--git-blame", does not iterate all files in directory
782  Using "--git-blame" is slow and may add old committers and authors
783      that are no longer active maintainers to the output.
784  Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
785      other automated tools that expect only ["name"] <email address>
786      may not work because of additional output after <email address>.
787  Using "--rolestats" and "--git-blame" shows the #/total=% commits,
788      not the percentage of the entire file authored. # of commits is
789      not a good measure of amount of code authored. 1 major commit may
790      contain a thousand lines, 5 trivial commits may modify a single line.
791  If git is not installed, but mercurial (hg) is installed and an .hg
792      repository exists, the following options apply to mercurial:
793          --git,
794          --git-min-signatures, --git-max-maintainers, --git-min-percent, and
795          --git-blame
796      Use --hg-since not --git-since to control date selection
797  File ".get_maintainer.conf", if it exists in the linux kernel source root
798      directory, can change whatever get_maintainer defaults are desired.
799      Entries in this file can be any command line argument.
800      This file is prepended to any additional command line arguments.
801      Multiple lines and # comments are allowed.
802EOT
803}
804
805sub top_of_kernel_tree {
806    my ($lk_path) = @_;
807
808    if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
809    $lk_path .= "/";
810    }
811    if ( (-f "${lk_path}COPYING")
812    && (-f "${lk_path}CREDITS")
813    && (-f "${lk_path}Kbuild")
814    && (-f "${lk_path}MAINTAINERS")
815    && (-f "${lk_path}Makefile")
816    && (-f "${lk_path}README")
817    && (-d "${lk_path}Documentation")
818    && (-d "${lk_path}arch")
819    && (-d "${lk_path}include")
820    && (-d "${lk_path}drivers")
821    && (-d "${lk_path}fs")
822    && (-d "${lk_path}init")
823    && (-d "${lk_path}ipc")
824    && (-d "${lk_path}kernel")
825    && (-d "${lk_path}lib")
826    && (-d "${lk_path}scripts")) {
827    return 1;
828    }
829    return 0;
830}
831
832sub parse_email {
833    my ($formatted_email) = @_;
834
835    my $name = "";
836    my $address = "";
837
838    if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
839    $name = $1;
840    $address = $2;
841    } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
842    $address = $1;
843    } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
844    $address = $1;
845    }
846
847    $name =~ s/^\s+|\s+$//g;
848    $name =~ s/^\"|\"$//g;
849    $address =~ s/^\s+|\s+$//g;
850
851    if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
852    $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
853    $name = "\"$name\"";
854    }
855
856    return ($name, $address);
857}
858
859sub format_email {
860    my ($name, $address, $usename) = @_;
861
862    my $formatted_email;
863
864    $name =~ s/^\s+|\s+$//g;
865    $name =~ s/^\"|\"$//g;
866    $address =~ s/^\s+|\s+$//g;
867
868    if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
869    $name =~ s/(?<!\\)"/\\"/g; ##escape quotes
870    $name = "\"$name\"";
871    }
872
873    if ($usename) {
874    if ("$name" eq "") {
875        $formatted_email = "$address";
876    } else {
877        $formatted_email = "$name <$address>";
878    }
879    } else {
880    $formatted_email = $address;
881    }
882
883    return $formatted_email;
884}
885
886sub find_first_section {
887    my $index = 0;
888
889    while ($index < @typevalue) {
890    my $tv = $typevalue[$index];
891    if (($tv =~ m/^(\C):\s*(.*)/)) {
892        last;
893    }
894    $index++;
895    }
896
897    return $index;
898}
899
900sub find_starting_index {
901    my ($index) = @_;
902
903    while ($index > 0) {
904    my $tv = $typevalue[$index];
905    if (!($tv =~ m/^(\C):\s*(.*)/)) {
906        last;
907    }
908    $index--;
909    }
910
911    return $index;
912}
913
914sub find_ending_index {
915    my ($index) = @_;
916
917    while ($index < @typevalue) {
918    my $tv = $typevalue[$index];
919    if (!($tv =~ m/^(\C):\s*(.*)/)) {
920        last;
921    }
922    $index++;
923    }
924
925    return $index;
926}
927
928sub get_maintainer_role {
929    my ($index) = @_;
930
931    my $i;
932    my $start = find_starting_index($index);
933    my $end = find_ending_index($index);
934
935    my $role = "unknown";
936    my $subsystem = $typevalue[$start];
937    if (length($subsystem) > 20) {
938    $subsystem = substr($subsystem, 0, 17);
939    $subsystem =~ s/\s*$//;
940    $subsystem = $subsystem . "...";
941    }
942
943    for ($i = $start + 1; $i < $end; $i++) {
944    my $tv = $typevalue[$i];
945    if ($tv =~ m/^(\C):\s*(.*)/) {
946        my $ptype = $1;
947        my $pvalue = $2;
948        if ($ptype eq "S") {
949        $role = $pvalue;
950        }
951    }
952    }
953
954    $role = lc($role);
955    if ($role eq "supported") {
956    $role = "supporter";
957    } elsif ($role eq "maintained") {
958    $role = "maintainer";
959    } elsif ($role eq "odd fixes") {
960    $role = "odd fixer";
961    } elsif ($role eq "orphan") {
962    $role = "orphan minder";
963    } elsif ($role eq "obsolete") {
964    $role = "obsolete minder";
965    } elsif ($role eq "buried alive in reporters") {
966    $role = "chief penguin";
967    }
968
969    return $role . ":" . $subsystem;
970}
971
972sub get_list_role {
973    my ($index) = @_;
974
975    my $i;
976    my $start = find_starting_index($index);
977    my $end = find_ending_index($index);
978
979    my $subsystem = $typevalue[$start];
980    if (length($subsystem) > 20) {
981    $subsystem = substr($subsystem, 0, 17);
982    $subsystem =~ s/\s*$//;
983    $subsystem = $subsystem . "...";
984    }
985
986    if ($subsystem eq "THE REST") {
987    $subsystem = "";
988    }
989
990    return $subsystem;
991}
992
993sub add_categories {
994    my ($index) = @_;
995
996    my $i;
997    my $start = find_starting_index($index);
998    my $end = find_ending_index($index);
999
1000    push(@subsystem, $typevalue[$start]);
1001
1002    for ($i = $start + 1; $i < $end; $i++) {
1003    my $tv = $typevalue[$i];
1004    if ($tv =~ m/^(\C):\s*(.*)/) {
1005        my $ptype = $1;
1006        my $pvalue = $2;
1007        if ($ptype eq "L") {
1008        my $list_address = $pvalue;
1009        my $list_additional = "";
1010        my $list_role = get_list_role($i);
1011
1012        if ($list_role ne "") {
1013            $list_role = ":" . $list_role;
1014        }
1015        if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1016            $list_address = $1;
1017            $list_additional = $2;
1018        }
1019        if ($list_additional =~ m/subscribers-only/) {
1020            if ($email_subscriber_list) {
1021            if (!$hash_list_to{lc($list_address)}) {
1022                $hash_list_to{lc($list_address)} = 1;
1023                push(@list_to, [$list_address,
1024                        "subscriber list${list_role}"]);
1025            }
1026            }
1027        } else {
1028            if ($email_list) {
1029            if (!$hash_list_to{lc($list_address)}) {
1030                $hash_list_to{lc($list_address)} = 1;
1031                if ($list_additional =~ m/moderated/) {
1032                push(@list_to, [$list_address,
1033                        "moderated list${list_role}"]);
1034                } else {
1035                push(@list_to, [$list_address,
1036                        "open list${list_role}"]);
1037                }
1038            }
1039            }
1040        }
1041        } elsif ($ptype eq "M") {
1042        my ($name, $address) = parse_email($pvalue);
1043        if ($name eq "") {
1044            if ($i > 0) {
1045            my $tv = $typevalue[$i - 1];
1046            if ($tv =~ m/^(\C):\s*(.*)/) {
1047                if ($1 eq "P") {
1048                $name = $2;
1049                $pvalue = format_email($name, $address, $email_usename);
1050                }
1051            }
1052            }
1053        }
1054        if ($email_maintainer) {
1055            my $role = get_maintainer_role($i);
1056            push_email_addresses($pvalue, $role);
1057        }
1058        } elsif ($ptype eq "T") {
1059        push(@scm, $pvalue);
1060        } elsif ($ptype eq "W") {
1061        push(@web, $pvalue);
1062        } elsif ($ptype eq "S") {
1063        push(@status, $pvalue);
1064        }
1065    }
1066    }
1067}
1068
1069sub email_inuse {
1070    my ($name, $address) = @_;
1071
1072    return 1 if (($name eq "") && ($address eq ""));
1073    return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1074    return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1075
1076    return 0;
1077}
1078
1079sub push_email_address {
1080    my ($line, $role) = @_;
1081
1082    my ($name, $address) = parse_email($line);
1083
1084    if ($address eq "") {
1085    return 0;
1086    }
1087
1088    if (!$email_remove_duplicates) {
1089    push(@email_to, [format_email($name, $address, $email_usename), $role]);
1090    } elsif (!email_inuse($name, $address)) {
1091    push(@email_to, [format_email($name, $address, $email_usename), $role]);
1092    $email_hash_name{lc($name)}++ if ($name ne "");
1093    $email_hash_address{lc($address)}++;
1094    }
1095
1096    return 1;
1097}
1098
1099sub push_email_addresses {
1100    my ($address, $role) = @_;
1101
1102    my @address_list = ();
1103
1104    if (rfc822_valid($address)) {
1105    push_email_address($address, $role);
1106    } elsif (@address_list = rfc822_validlist($address)) {
1107    my $array_count = shift(@address_list);
1108    while (my $entry = shift(@address_list)) {
1109        push_email_address($entry, $role);
1110    }
1111    } else {
1112    if (!push_email_address($address, $role)) {
1113        warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1114    }
1115    }
1116}
1117
1118sub add_role {
1119    my ($line, $role) = @_;
1120
1121    my ($name, $address) = parse_email($line);
1122    my $email = format_email($name, $address, $email_usename);
1123
1124    foreach my $entry (@email_to) {
1125    if ($email_remove_duplicates) {
1126        my ($entry_name, $entry_address) = parse_email($entry->[0]);
1127        if (($name eq $entry_name || $address eq $entry_address)
1128        && ($role eq "" || !($entry->[1] =~ m/$role/))
1129        ) {
1130        if ($entry->[1] eq "") {
1131            $entry->[1] = "$role";
1132        } else {
1133            $entry->[1] = "$entry->[1],$role";
1134        }
1135        }
1136    } else {
1137        if ($email eq $entry->[0]
1138        && ($role eq "" || !($entry->[1] =~ m/$role/))
1139        ) {
1140        if ($entry->[1] eq "") {
1141            $entry->[1] = "$role";
1142        } else {
1143            $entry->[1] = "$entry->[1],$role";
1144        }
1145        }
1146    }
1147    }
1148}
1149
1150sub which {
1151    my ($bin) = @_;
1152
1153    foreach my $path (split(/:/, $ENV{PATH})) {
1154    if (-e "$path/$bin") {
1155        return "$path/$bin";
1156    }
1157    }
1158
1159    return "";
1160}
1161
1162sub which_conf {
1163    my ($conf) = @_;
1164
1165    foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1166    if (-e "$path/$conf") {
1167        return "$path/$conf";
1168    }
1169    }
1170
1171    return "";
1172}
1173
1174sub mailmap_email {
1175    my ($line) = @_;
1176
1177    my ($name, $address) = parse_email($line);
1178    my $email = format_email($name, $address, 1);
1179    my $real_name = $name;
1180    my $real_address = $address;
1181
1182    if (exists $mailmap->{names}->{$email} ||
1183    exists $mailmap->{addresses}->{$email}) {
1184    if (exists $mailmap->{names}->{$email}) {
1185        $real_name = $mailmap->{names}->{$email};
1186    }
1187    if (exists $mailmap->{addresses}->{$email}) {
1188        $real_address = $mailmap->{addresses}->{$email};
1189    }
1190    } else {
1191    if (exists $mailmap->{names}->{$address}) {
1192        $real_name = $mailmap->{names}->{$address};
1193    }
1194    if (exists $mailmap->{addresses}->{$address}) {
1195        $real_address = $mailmap->{addresses}->{$address};
1196    }
1197    }
1198    return format_email($real_name, $real_address, 1);
1199}
1200
1201sub mailmap {
1202    my (@addresses) = @_;
1203
1204    my @mapped_emails = ();
1205    foreach my $line (@addresses) {
1206    push(@mapped_emails, mailmap_email($line));
1207    }
1208    merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1209    return @mapped_emails;
1210}
1211
1212sub merge_by_realname {
1213    my %address_map;
1214    my (@emails) = @_;
1215
1216    foreach my $email (@emails) {
1217    my ($name, $address) = parse_email($email);
1218    if (exists $address_map{$name}) {
1219        $address = $address_map{$name};
1220        $email = format_email($name, $address, 1);
1221    } else {
1222        $address_map{$name} = $address;
1223    }
1224    }
1225}
1226
1227sub git_execute_cmd {
1228    my ($cmd) = @_;
1229    my @lines = ();
1230
1231    my $output = `$cmd`;
1232    $output =~ s/^\s*//gm;
1233    @lines = split("\n", $output);
1234
1235    return @lines;
1236}
1237
1238sub hg_execute_cmd {
1239    my ($cmd) = @_;
1240    my @lines = ();
1241
1242    my $output = `$cmd`;
1243    @lines = split("\n", $output);
1244
1245    return @lines;
1246}
1247
1248sub extract_formatted_signatures {
1249    my (@signature_lines) = @_;
1250
1251    my @type = @signature_lines;
1252
1253    s/\s*(.*):.*/$1/ for (@type);
1254
1255    # cut -f2- -d":"
1256    s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1257
1258## Reformat email addresses (with names) to avoid badly written signatures
1259
1260    foreach my $signer (@signature_lines) {
1261    $signer = deduplicate_email($signer);
1262    }
1263
1264    return (\@type, \@signature_lines);
1265}
1266
1267sub vcs_find_signers {
1268    my ($cmd) = @_;
1269    my $commits;
1270    my @lines = ();
1271    my @signatures = ();
1272
1273    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1274
1275    my $pattern = $VCS_cmds{"commit_pattern"};
1276
1277    $commits = grep(/$pattern/, @lines); # of commits
1278
1279    @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1280
1281    return (0, @signatures) if !@signatures;
1282
1283    save_commits_by_author(@lines) if ($interactive);
1284    save_commits_by_signer(@lines) if ($interactive);
1285
1286    if (!$email_git_penguin_chiefs) {
1287    @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1288    }
1289
1290    my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1291
1292    return ($commits, @$signers_ref);
1293}
1294
1295sub vcs_find_author {
1296    my ($cmd) = @_;
1297    my @lines = ();
1298
1299    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1300
1301    if (!$email_git_penguin_chiefs) {
1302    @lines = grep(!/${penguin_chiefs}/i, @lines);
1303    }
1304
1305    return @lines if !@lines;
1306
1307    my @authors = ();
1308    foreach my $line (@lines) {
1309    if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1310        my $author = $1;
1311        my ($name, $address) = parse_email($author);
1312        $author = format_email($name, $address, 1);
1313        push(@authors, $author);
1314    }
1315    }
1316
1317    save_commits_by_author(@lines) if ($interactive);
1318    save_commits_by_signer(@lines) if ($interactive);
1319
1320    return @authors;
1321}
1322
1323sub vcs_save_commits {
1324    my ($cmd) = @_;
1325    my @lines = ();
1326    my @commits = ();
1327
1328    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1329
1330    foreach my $line (@lines) {
1331    if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1332        push(@commits, $1);
1333    }
1334    }
1335
1336    return @commits;
1337}
1338
1339sub vcs_blame {
1340    my ($file) = @_;
1341    my $cmd;
1342    my @commits = ();
1343
1344    return @commits if (!(-f $file));
1345
1346    if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1347    my @all_commits = ();
1348
1349    $cmd = $VCS_cmds{"blame_file_cmd"};
1350    $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1351    @all_commits = vcs_save_commits($cmd);
1352
1353    foreach my $file_range_diff (@range) {
1354        next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1355        my $diff_file = $1;
1356        my $diff_start = $2;
1357        my $diff_length = $3;
1358        next if ("$file" ne "$diff_file");
1359        for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1360        push(@commits, $all_commits[$i]);
1361        }
1362    }
1363    } elsif (@range) {
1364    foreach my $file_range_diff (@range) {
1365        next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1366        my $diff_file = $1;
1367        my $diff_start = $2;
1368        my $diff_length = $3;
1369        next if ("$file" ne "$diff_file");
1370        $cmd = $VCS_cmds{"blame_range_cmd"};
1371        $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1372        push(@commits, vcs_save_commits($cmd));
1373    }
1374    } else {
1375    $cmd = $VCS_cmds{"blame_file_cmd"};
1376    $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1377    @commits = vcs_save_commits($cmd);
1378    }
1379
1380    foreach my $commit (@commits) {
1381    $commit =~ s/^\^//g;
1382    }
1383
1384    return @commits;
1385}
1386
1387my $printed_novcs = 0;
1388sub vcs_exists {
1389    %VCS_cmds = %VCS_cmds_git;
1390    return 1 if eval $VCS_cmds{"available"};
1391    %VCS_cmds = %VCS_cmds_hg;
1392    return 2 if eval $VCS_cmds{"available"};
1393    %VCS_cmds = ();
1394    if (!$printed_novcs) {
1395    warn("$P: No supported VCS found. Add --nogit to options?\n");
1396    warn("Using a git repository produces better results.\n");
1397    warn("Try Linus Torvalds' latest git repository using:\n");
1398    warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1399    $printed_novcs = 1;
1400    }
1401    return 0;
1402}
1403
1404sub vcs_is_git {
1405    vcs_exists();
1406    return $vcs_used == 1;
1407}
1408
1409sub vcs_is_hg {
1410    return $vcs_used == 2;
1411}
1412
1413sub interactive_get_maintainers {
1414    my ($list_ref) = @_;
1415    my @list = @$list_ref;
1416
1417    vcs_exists();
1418
1419    my %selected;
1420    my %authored;
1421    my %signed;
1422    my $count = 0;
1423    my $maintained = 0;
1424    foreach my $entry (@list) {
1425    $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1426    $selected{$count} = 1;
1427    $authored{$count} = 0;
1428    $signed{$count} = 0;
1429    $count++;
1430    }
1431
1432    #menu loop
1433    my $done = 0;
1434    my $print_options = 0;
1435    my $redraw = 1;
1436    while (!$done) {
1437    $count = 0;
1438    if ($redraw) {
1439        printf STDERR "\n%1s %2s %-65s",
1440              "*", "#", "email/list and role:stats";
1441        if ($email_git ||
1442        ($email_git_fallback && !$maintained) ||
1443        $email_git_blame) {
1444        print STDERR "auth sign";
1445        }
1446        print STDERR "\n";
1447        foreach my $entry (@list) {
1448        my $email = $entry->[0];
1449        my $role = $entry->[1];
1450        my $sel = "";
1451        $sel = "*" if ($selected{$count});
1452        my $commit_author = $commit_author_hash{$email};
1453        my $commit_signer = $commit_signer_hash{$email};
1454        my $authored = 0;
1455        my $signed = 0;
1456        $authored++ for (@{$commit_author});
1457        $signed++ for (@{$commit_signer});
1458        printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1459        printf STDERR "%4d %4d", $authored, $signed
1460            if ($authored > 0 || $signed > 0);
1461        printf STDERR "\n %s\n", $role;
1462        if ($authored{$count}) {
1463            my $commit_author = $commit_author_hash{$email};
1464            foreach my $ref (@{$commit_author}) {
1465            print STDERR " Author: @{$ref}[1]\n";
1466            }
1467        }
1468        if ($signed{$count}) {
1469            my $commit_signer = $commit_signer_hash{$email};
1470            foreach my $ref (@{$commit_signer}) {
1471            print STDERR " @{$ref}[2]: @{$ref}[1]\n";
1472            }
1473        }
1474
1475        $count++;
1476        }
1477    }
1478    my $date_ref = \$email_git_since;
1479    $date_ref = \$email_hg_since if (vcs_is_hg());
1480    if ($print_options) {
1481        $print_options = 0;
1482        if (vcs_exists()) {
1483        print STDERR <<EOT
1484
1485Version Control options:
1486g use git history [$email_git]
1487gf use git-fallback [$email_git_fallback]
1488b use git blame [$email_git_blame]
1489bs use blame signatures [$email_git_blame_signatures]
1490c# minimum commits [$email_git_min_signatures]
1491%# min percent [$email_git_min_percent]
1492d# history to use [$$date_ref]
1493x# max maintainers [$email_git_max_maintainers]
1494t all signature types [$email_git_all_signature_types]
1495m use .mailmap [$email_use_mailmap]
1496EOT
1497        }
1498        print STDERR <<EOT
1499
1500Additional options:
15010 toggle all
1502tm toggle maintainers
1503tg toggle git entries
1504tl toggle open list entries
1505ts toggle subscriber list entries
1506f emails in file [$file_emails]
1507k keywords in file [$keywords]
1508r remove duplicates [$email_remove_duplicates]
1509p# pattern match depth [$pattern_depth]
1510EOT
1511    }
1512    print STDERR
1513"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1514
1515    my $input = <STDIN>;
1516    chomp($input);
1517
1518    $redraw = 1;
1519    my $rerun = 0;
1520    my @wish = split(/[, ]+/, $input);
1521    foreach my $nr (@wish) {
1522        $nr = lc($nr);
1523        my $sel = substr($nr, 0, 1);
1524        my $str = substr($nr, 1);
1525        my $val = 0;
1526        $val = $1 if $str =~ /^(\d+)$/;
1527
1528        if ($sel eq "y") {
1529        $interactive = 0;
1530        $done = 1;
1531        $output_rolestats = 0;
1532        $output_roles = 0;
1533        last;
1534        } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1535        $selected{$nr - 1} = !$selected{$nr - 1};
1536        } elsif ($sel eq "*" || $sel eq '^') {
1537        my $toggle = 0;
1538        $toggle = 1 if ($sel eq '*');
1539        for (my $i = 0; $i < $count; $i++) {
1540            $selected{$i} = $toggle;
1541        }
1542        } elsif ($sel eq "0") {
1543        for (my $i = 0; $i < $count; $i++) {
1544            $selected{$i} = !$selected{$i};
1545        }
1546        } elsif ($sel eq "t") {
1547        if (lc($str) eq "m") {
1548            for (my $i = 0; $i < $count; $i++) {
1549            $selected{$i} = !$selected{$i}
1550                if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1551            }
1552        } elsif (lc($str) eq "g") {
1553            for (my $i = 0; $i < $count; $i++) {
1554            $selected{$i} = !$selected{$i}
1555                if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1556            }
1557        } elsif (lc($str) eq "l") {
1558            for (my $i = 0; $i < $count; $i++) {
1559            $selected{$i} = !$selected{$i}
1560                if ($list[$i]->[1] =~ /^(open list)/i);
1561            }
1562        } elsif (lc($str) eq "s") {
1563            for (my $i = 0; $i < $count; $i++) {
1564            $selected{$i} = !$selected{$i}
1565                if ($list[$i]->[1] =~ /^(subscriber list)/i);
1566            }
1567        }
1568        } elsif ($sel eq "a") {
1569        if ($val > 0 && $val <= $count) {
1570            $authored{$val - 1} = !$authored{$val - 1};
1571        } elsif ($str eq '*' || $str eq '^') {
1572            my $toggle = 0;
1573            $toggle = 1 if ($str eq '*');
1574            for (my $i = 0; $i < $count; $i++) {
1575            $authored{$i} = $toggle;
1576            }
1577        }
1578        } elsif ($sel eq "s") {
1579        if ($val > 0 && $val <= $count) {
1580            $signed{$val - 1} = !$signed{$val - 1};
1581        } elsif ($str eq '*' || $str eq '^') {
1582            my $toggle = 0;
1583            $toggle = 1 if ($str eq '*');
1584            for (my $i = 0; $i < $count; $i++) {
1585            $signed{$i} = $toggle;
1586            }
1587        }
1588        } elsif ($sel eq "o") {
1589        $print_options = 1;
1590        $redraw = 1;
1591        } elsif ($sel eq "g") {
1592        if ($str eq "f") {
1593            bool_invert(\$email_git_fallback);
1594        } else {
1595            bool_invert(\$email_git);
1596        }
1597        $rerun = 1;
1598        } elsif ($sel eq "b") {
1599        if ($str eq "s") {
1600            bool_invert(\$email_git_blame_signatures);
1601        } else {
1602            bool_invert(\$email_git_blame);
1603        }
1604        $rerun = 1;
1605        } elsif ($sel eq "c") {
1606        if ($val > 0) {
1607            $email_git_min_signatures = $val;
1608            $rerun = 1;
1609        }
1610        } elsif ($sel eq "x") {
1611        if ($val > 0) {
1612            $email_git_max_maintainers = $val;
1613            $rerun = 1;
1614        }
1615        } elsif ($sel eq "%") {
1616        if ($str ne "" && $val >= 0) {
1617            $email_git_min_percent = $val;
1618            $rerun = 1;
1619        }
1620        } elsif ($sel eq "d") {
1621        if (vcs_is_git()) {
1622            $email_git_since = $str;
1623        } elsif (vcs_is_hg()) {
1624            $email_hg_since = $str;
1625        }
1626        $rerun = 1;
1627        } elsif ($sel eq "t") {
1628        bool_invert(\$email_git_all_signature_types);
1629        $rerun = 1;
1630        } elsif ($sel eq "f") {
1631        bool_invert(\$file_emails);
1632        $rerun = 1;
1633        } elsif ($sel eq "r") {
1634        bool_invert(\$email_remove_duplicates);
1635        $rerun = 1;
1636        } elsif ($sel eq "m") {
1637        bool_invert(\$email_use_mailmap);
1638        read_mailmap();
1639        $rerun = 1;
1640        } elsif ($sel eq "k") {
1641        bool_invert(\$keywords);
1642        $rerun = 1;
1643        } elsif ($sel eq "p") {
1644        if ($str ne "" && $val >= 0) {
1645            $pattern_depth = $val;
1646            $rerun = 1;
1647        }
1648        } elsif ($sel eq "h" || $sel eq "?") {
1649        print STDERR <<EOT
1650
1651Interactive mode allows you to select the various maintainers, submitters,
1652commit signers and mailing lists that could be CC'd on a patch.
1653
1654Any *'d entry is selected.
1655
1656If you have git or hg installed, you can choose to summarize the commit
1657history of files in the patch. Also, each line of the current file can
1658be matched to its commit author and that commits signers with blame.
1659
1660Various knobs exist to control the length of time for active commit
1661tracking, the maximum number of commit authors and signers to add,
1662and such.
1663
1664Enter selections at the prompt until you are satisfied that the selected
1665maintainers are appropriate. You may enter multiple selections separated
1666by either commas or spaces.
1667
1668EOT
1669        } else {
1670        print STDERR "invalid option: '$nr'\n";
1671        $redraw = 0;
1672        }
1673    }
1674    if ($rerun) {
1675        print STDERR "git-blame can be very slow, please have patience..."
1676        if ($email_git_blame);
1677        goto &get_maintainers;
1678    }
1679    }
1680
1681    #drop not selected entries
1682    $count = 0;
1683    my @new_emailto = ();
1684    foreach my $entry (@list) {
1685    if ($selected{$count}) {
1686        push(@new_emailto, $list[$count]);
1687    }
1688    $count++;
1689    }
1690    return @new_emailto;
1691}
1692
1693sub bool_invert {
1694    my ($bool_ref) = @_;
1695
1696    if ($$bool_ref) {
1697    $$bool_ref = 0;
1698    } else {
1699    $$bool_ref = 1;
1700    }
1701}
1702
1703sub deduplicate_email {
1704    my ($email) = @_;
1705
1706    my $matched = 0;
1707    my ($name, $address) = parse_email($email);
1708    $email = format_email($name, $address, 1);
1709    $email = mailmap_email($email);
1710
1711    return $email if (!$email_remove_duplicates);
1712
1713    ($name, $address) = parse_email($email);
1714
1715    if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1716    $name = $deduplicate_name_hash{lc($name)}->[0];
1717    $address = $deduplicate_name_hash{lc($name)}->[1];
1718    $matched = 1;
1719    } elsif ($deduplicate_address_hash{lc($address)}) {
1720    $name = $deduplicate_address_hash{lc($address)}->[0];
1721    $address = $deduplicate_address_hash{lc($address)}->[1];
1722    $matched = 1;
1723    }
1724    if (!$matched) {
1725    $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1726    $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1727    }
1728    $email = format_email($name, $address, 1);
1729    $email = mailmap_email($email);
1730    return $email;
1731}
1732
1733sub save_commits_by_author {
1734    my (@lines) = @_;
1735
1736    my @authors = ();
1737    my @commits = ();
1738    my @subjects = ();
1739
1740    foreach my $line (@lines) {
1741    if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1742        my $author = $1;
1743        $author = deduplicate_email($author);
1744        push(@authors, $author);
1745    }
1746    push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1747    push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1748    }
1749
1750    for (my $i = 0; $i < @authors; $i++) {
1751    my $exists = 0;
1752    foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1753        if (@{$ref}[0] eq $commits[$i] &&
1754        @{$ref}[1] eq $subjects[$i]) {
1755        $exists = 1;
1756        last;
1757        }
1758    }
1759    if (!$exists) {
1760        push(@{$commit_author_hash{$authors[$i]}},
1761         [ ($commits[$i], $subjects[$i]) ]);
1762    }
1763    }
1764}
1765
1766sub save_commits_by_signer {
1767    my (@lines) = @_;
1768
1769    my $commit = "";
1770    my $subject = "";
1771
1772    foreach my $line (@lines) {
1773    $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1774    $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1775    if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1776        my @signatures = ($line);
1777        my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1778        my @types = @$types_ref;
1779        my @signers = @$signers_ref;
1780
1781        my $type = $types[0];
1782        my $signer = $signers[0];
1783
1784        $signer = deduplicate_email($signer);
1785
1786        my $exists = 0;
1787        foreach my $ref(@{$commit_signer_hash{$signer}}) {
1788        if (@{$ref}[0] eq $commit &&
1789            @{$ref}[1] eq $subject &&
1790            @{$ref}[2] eq $type) {
1791            $exists = 1;
1792            last;
1793        }
1794        }
1795        if (!$exists) {
1796        push(@{$commit_signer_hash{$signer}},
1797             [ ($commit, $subject, $type) ]);
1798        }
1799    }
1800    }
1801}
1802
1803sub vcs_assign {
1804    my ($role, $divisor, @lines) = @_;
1805
1806    my %hash;
1807    my $count = 0;
1808
1809    return if (@lines <= 0);
1810
1811    if ($divisor <= 0) {
1812    warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1813    $divisor = 1;
1814    }
1815
1816    @lines = mailmap(@lines);
1817
1818    return if (@lines <= 0);
1819
1820    @lines = sort(@lines);
1821
1822    # uniq -c
1823    $hash{$_}++ for @lines;
1824
1825    # sort -rn
1826    foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1827    my $sign_offs = $hash{$line};
1828    my $percent = $sign_offs * 100 / $divisor;
1829
1830    $percent = 100 if ($percent > 100);
1831    $count++;
1832    last if ($sign_offs < $email_git_min_signatures ||
1833         $count > $email_git_max_maintainers ||
1834         $percent < $email_git_min_percent);
1835    push_email_address($line, '');
1836    if ($output_rolestats) {
1837        my $fmt_percent = sprintf("%.0f", $percent);
1838        add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1839    } else {
1840        add_role($line, $role);
1841    }
1842    }
1843}
1844
1845sub vcs_file_signoffs {
1846    my ($file) = @_;
1847
1848    my @signers = ();
1849    my $commits;
1850
1851    $vcs_used = vcs_exists();
1852    return if (!$vcs_used);
1853
1854    my $cmd = $VCS_cmds{"find_signers_cmd"};
1855    $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd
1856
1857    ($commits, @signers) = vcs_find_signers($cmd);
1858
1859    foreach my $signer (@signers) {
1860    $signer = deduplicate_email($signer);
1861    }
1862
1863    vcs_assign("commit_signer", $commits, @signers);
1864}
1865
1866sub vcs_file_blame {
1867    my ($file) = @_;
1868
1869    my @signers = ();
1870    my @all_commits = ();
1871    my @commits = ();
1872    my $total_commits;
1873    my $total_lines;
1874
1875    $vcs_used = vcs_exists();
1876    return if (!$vcs_used);
1877
1878    @all_commits = vcs_blame($file);
1879    @commits = uniq(@all_commits);
1880    $total_commits = @commits;
1881    $total_lines = @all_commits;
1882
1883    if ($email_git_blame_signatures) {
1884    if (vcs_is_hg()) {
1885        my $commit_count;
1886        my @commit_signers = ();
1887        my $commit = join(" -r ", @commits);
1888        my $cmd;
1889
1890        $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1891        $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1892
1893        ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1894
1895        push(@signers, @commit_signers);
1896    } else {
1897        foreach my $commit (@commits) {
1898        my $commit_count;
1899        my @commit_signers = ();
1900        my $cmd;
1901
1902        $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1903        $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1904
1905        ($commit_count, @commit_signers) = vcs_find_signers($cmd);
1906
1907        push(@signers, @commit_signers);
1908        }
1909    }
1910    }
1911
1912    if ($from_filename) {
1913    if ($output_rolestats) {
1914        my @blame_signers;
1915        if (vcs_is_hg()) {{ # Double brace for last exit
1916        my $commit_count;
1917        my @commit_signers = ();
1918        @commits = uniq(@commits);
1919        @commits = sort(@commits);
1920        my $commit = join(" -r ", @commits);
1921        my $cmd;
1922
1923        $cmd = $VCS_cmds{"find_commit_author_cmd"};
1924        $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd
1925
1926        my @lines = ();
1927
1928        @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1929
1930        if (!$email_git_penguin_chiefs) {
1931            @lines = grep(!/${penguin_chiefs}/i, @lines);
1932        }
1933
1934        last if !@lines;
1935
1936        my @authors = ();
1937        foreach my $line (@lines) {
1938            if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1939            my $author = $1;
1940            $author = deduplicate_email($author);
1941            push(@authors, $author);
1942            }
1943        }
1944
1945        save_commits_by_author(@lines) if ($interactive);
1946        save_commits_by_signer(@lines) if ($interactive);
1947
1948        push(@signers, @authors);
1949        }}
1950        else {
1951        foreach my $commit (@commits) {
1952            my $i;
1953            my $cmd = $VCS_cmds{"find_commit_author_cmd"};
1954            $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd
1955            my @author = vcs_find_author($cmd);
1956            next if !@author;
1957
1958            my $formatted_author = deduplicate_email($author[0]);
1959
1960            my $count = grep(/$commit/, @all_commits);
1961            for ($i = 0; $i < $count ; $i++) {
1962            push(@blame_signers, $formatted_author);
1963            }
1964        }
1965        }
1966        if (@blame_signers) {
1967        vcs_assign("authored lines", $total_lines, @blame_signers);
1968        }
1969    }
1970    foreach my $signer (@signers) {
1971        $signer = deduplicate_email($signer);
1972    }
1973    vcs_assign("commits", $total_commits, @signers);
1974    } else {
1975    foreach my $signer (@signers) {
1976        $signer = deduplicate_email($signer);
1977    }
1978    vcs_assign("modified commits", $total_commits, @signers);
1979    }
1980}
1981
1982sub uniq {
1983    my (@parms) = @_;
1984
1985    my %saw;
1986    @parms = grep(!$saw{$_}++, @parms);
1987    return @parms;
1988}
1989
1990sub sort_and_uniq {
1991    my (@parms) = @_;
1992
1993    my %saw;
1994    @parms = sort @parms;
1995    @parms = grep(!$saw{$_}++, @parms);
1996    return @parms;
1997}
1998
1999sub clean_file_emails {
2000    my (@file_emails) = @_;
2001    my @fmt_emails = ();
2002
2003    foreach my $email (@file_emails) {
2004    $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2005    my ($name, $address) = parse_email($email);
2006    if ($name eq '"[,\.]"') {
2007        $name = "";
2008    }
2009
2010    my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2011    if (@nw > 2) {
2012        my $first = $nw[@nw - 3];
2013        my $middle = $nw[@nw - 2];
2014        my $last = $nw[@nw - 1];
2015
2016        if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2017         (length($first) == 2 && substr($first, -1) eq ".")) ||
2018        (length($middle) == 1 ||
2019         (length($middle) == 2 && substr($middle, -1) eq "."))) {
2020        $name = "$first $middle $last";
2021        } else {
2022        $name = "$middle $last";
2023        }
2024    }
2025
2026    if (substr($name, -1) =~ /[,\.]/) {
2027        $name = substr($name, 0, length($name) - 1);
2028    } elsif (substr($name, -2) =~ /[,\.]"/) {
2029        $name = substr($name, 0, length($name) - 2) . '"';
2030    }
2031
2032    if (substr($name, 0, 1) =~ /[,\.]/) {
2033        $name = substr($name, 1, length($name) - 1);
2034    } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2035        $name = '"' . substr($name, 2, length($name) - 2);
2036    }
2037
2038    my $fmt_email = format_email($name, $address, $email_usename);
2039    push(@fmt_emails, $fmt_email);
2040    }
2041    return @fmt_emails;
2042}
2043
2044sub merge_email {
2045    my @lines;
2046    my %saw;
2047
2048    for (@_) {
2049    my ($address, $role) = @$_;
2050    if (!$saw{$address}) {
2051        if ($output_roles) {
2052        push(@lines, "$address ($role)");
2053        } else {
2054        push(@lines, $address);
2055        }
2056        $saw{$address} = 1;
2057    }
2058    }
2059
2060    return @lines;
2061}
2062
2063sub output {
2064    my (@parms) = @_;
2065
2066    if ($output_multiline) {
2067    foreach my $line (@parms) {
2068        print("${line}\n");
2069    }
2070    } else {
2071    print(join($output_separator, @parms));
2072    print("\n");
2073    }
2074}
2075
2076my $rfc822re;
2077
2078sub make_rfc822re {
2079# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2080# comment. We must allow for rfc822_lwsp (or comments) after each of these.
2081# This regexp will only work on addresses which have had comments stripped
2082# and replaced with rfc822_lwsp.
2083
2084    my $specials = '()<>@,;:\\\\".\\[\\]';
2085    my $controls = '\\000-\\037\\177';
2086
2087    my $dtext = "[^\\[\\]\\r\\\\]";
2088    my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2089
2090    my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2091
2092# Use zero-width assertion to spot the limit of an atom. A simple
2093# $rfc822_lwsp* causes the regexp engine to hang occasionally.
2094    my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2095    my $word = "(?:$atom|$quoted_string)";
2096    my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2097
2098    my $sub_domain = "(?:$atom|$domain_literal)";
2099    my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2100
2101    my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2102
2103    my $phrase = "$word*";
2104    my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2105    my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2106    my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2107
2108    my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2109    my $address = "(?:$mailbox|$group)";
2110
2111    return "$rfc822_lwsp*$address";
2112}
2113
2114sub rfc822_strip_comments {
2115    my $s = shift;
2116# Recursively remove comments, and replace with a single space. The simpler
2117# regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2118# chars in atoms, for example.
2119
2120    while ($s =~ s/^((?:[^"\\]|\\.)*
2121                    (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2122                    \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2123    return $s;
2124}
2125
2126# valid: returns true if the parameter is an RFC822 valid address
2127#
2128sub rfc822_valid {
2129    my $s = rfc822_strip_comments(shift);
2130
2131    if (!$rfc822re) {
2132        $rfc822re = make_rfc822re();
2133    }
2134
2135    return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2136}
2137
2138# validlist: In scalar context, returns true if the parameter is an RFC822
2139# valid list of addresses.
2140#
2141# In list context, returns an empty list on failure (an invalid
2142# address was found); otherwise a list whose first element is the
2143# number of addresses found and whose remaining elements are the
2144# addresses. This is needed to disambiguate failure (invalid)
2145# from success with no addresses found, because an empty string is
2146# a valid list.
2147
2148sub rfc822_validlist {
2149    my $s = rfc822_strip_comments(shift);
2150
2151    if (!$rfc822re) {
2152        $rfc822re = make_rfc822re();
2153    }
2154    # * null list items are valid according to the RFC
2155    # * the '1' business is to aid in distinguishing failure from no results
2156
2157    my @r;
2158    if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2159    $s =~ m/^$rfc822_char*$/) {
2160        while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2161            push(@r, $1);
2162        }
2163        return wantarray ? (scalar(@r), @r) : 1;
2164    }
2165    return wantarray ? () : 0;
2166}
2167

Archive Download this file



interactive