~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~

TOMOYO Linux Cross Reference
Linux/scripts/get_maintainer.pl

Version: ~ [ linux-6.11.5 ] ~ [ linux-6.10.14 ] ~ [ linux-6.9.12 ] ~ [ linux-6.8.12 ] ~ [ linux-6.7.12 ] ~ [ linux-6.6.58 ] ~ [ linux-6.5.13 ] ~ [ linux-6.4.16 ] ~ [ linux-6.3.13 ] ~ [ linux-6.2.16 ] ~ [ linux-6.1.114 ] ~ [ linux-6.0.19 ] ~ [ linux-5.19.17 ] ~ [ linux-5.18.19 ] ~ [ linux-5.17.15 ] ~ [ linux-5.16.20 ] ~ [ linux-5.15.169 ] ~ [ linux-5.14.21 ] ~ [ linux-5.13.19 ] ~ [ linux-5.12.19 ] ~ [ linux-5.11.22 ] ~ [ linux-5.10.228 ] ~ [ linux-5.9.16 ] ~ [ linux-5.8.18 ] ~ [ linux-5.7.19 ] ~ [ linux-5.6.19 ] ~ [ linux-5.5.19 ] ~ [ linux-5.4.284 ] ~ [ linux-5.3.18 ] ~ [ linux-5.2.21 ] ~ [ linux-5.1.21 ] ~ [ linux-5.0.21 ] ~ [ linux-4.20.17 ] ~ [ linux-4.19.322 ] ~ [ linux-4.18.20 ] ~ [ linux-4.17.19 ] ~ [ linux-4.16.18 ] ~ [ linux-4.15.18 ] ~ [ linux-4.14.336 ] ~ [ linux-4.13.16 ] ~ [ linux-4.12.14 ] ~ [ linux-4.11.12 ] ~ [ linux-4.10.17 ] ~ [ linux-4.9.337 ] ~ [ linux-4.4.302 ] ~ [ linux-3.10.108 ] ~ [ linux-2.6.32.71 ] ~ [ linux-2.6.0 ] ~ [ linux-2.4.37.11 ] ~ [ unix-v6-master ] ~ [ ccs-tools-1.8.9 ] ~ [ policy-sample ] ~
Architecture: ~ [ i386 ] ~ [ alpha ] ~ [ m68k ] ~ [ mips ] ~ [ ppc ] ~ [ sparc ] ~ [ sparc64 ] ~

Diff markup

Differences between /scripts/get_maintainer.pl (Version linux-6.11.5) and /scripts/get_maintainer.pl (Version linux-4.13.16)


  1 #!/usr/bin/env perl                                 1 #!/usr/bin/env perl
  2 # SPDX-License-Identifier: GPL-2.0             << 
  3 #                                              << 
  4 # (c) 2007, Joe Perches <joe@perches.com>            2 # (c) 2007, Joe Perches <joe@perches.com>
  5 #           created from checkpatch.pl              3 #           created from checkpatch.pl
  6 #                                                   4 #
  7 # Print selected MAINTAINERS information for        5 # Print selected MAINTAINERS information for
  8 # the files modified in a patch or for a file       6 # the files modified in a patch or for a file
  9 #                                                   7 #
 10 # usage: perl scripts/get_maintainer.pl [OPTIO      8 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
 11 #        perl scripts/get_maintainer.pl [OPTIO      9 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
                                                   >>  10 #
                                                   >>  11 # Licensed under the terms of the GNU GPL License version 2
 12                                                    12 
 13 use warnings;                                      13 use warnings;
 14 use strict;                                        14 use strict;
 15                                                    15 
 16 my $P = $0;                                        16 my $P = $0;
 17 my $V = '0.26';                                    17 my $V = '0.26';
 18                                                    18 
 19 use Getopt::Long qw(:config no_auto_abbrev);       19 use Getopt::Long qw(:config no_auto_abbrev);
 20 use Cwd;                                           20 use Cwd;
 21 use File::Find;                                    21 use File::Find;
 22 use File::Spec::Functions;                     << 
 23 use open qw(:std :encoding(UTF-8));            << 
 24                                                    22 
 25 my $cur_path = fastgetcwd() . '/';                 23 my $cur_path = fastgetcwd() . '/';
 26 my $lk_path = "./";                                24 my $lk_path = "./";
 27 my $email = 1;                                     25 my $email = 1;
 28 my $email_usename = 1;                             26 my $email_usename = 1;
 29 my $email_maintainer = 1;                          27 my $email_maintainer = 1;
 30 my $email_reviewer = 1;                            28 my $email_reviewer = 1;
 31 my $email_fixes = 1;                           << 
 32 my $email_list = 1;                                29 my $email_list = 1;
 33 my $email_moderated_list = 1;                  << 
 34 my $email_subscriber_list = 0;                     30 my $email_subscriber_list = 0;
 35 my $email_git_penguin_chiefs = 0;                  31 my $email_git_penguin_chiefs = 0;
 36 my $email_git = 0;                                 32 my $email_git = 0;
 37 my $email_git_all_signature_types = 0;             33 my $email_git_all_signature_types = 0;
 38 my $email_git_blame = 0;                           34 my $email_git_blame = 0;
 39 my $email_git_blame_signatures = 1;                35 my $email_git_blame_signatures = 1;
 40 my $email_git_fallback = 1;                        36 my $email_git_fallback = 1;
 41 my $email_git_min_signatures = 1;                  37 my $email_git_min_signatures = 1;
 42 my $email_git_max_maintainers = 5;                 38 my $email_git_max_maintainers = 5;
 43 my $email_git_min_percent = 5;                     39 my $email_git_min_percent = 5;
 44 my $email_git_since = "1-year-ago";                40 my $email_git_since = "1-year-ago";
 45 my $email_hg_since = "-365";                       41 my $email_hg_since = "-365";
 46 my $interactive = 0;                               42 my $interactive = 0;
 47 my $email_remove_duplicates = 1;                   43 my $email_remove_duplicates = 1;
 48 my $email_use_mailmap = 1;                         44 my $email_use_mailmap = 1;
 49 my $output_multiline = 1;                          45 my $output_multiline = 1;
 50 my $output_separator = ", ";                       46 my $output_separator = ", ";
 51 my $output_roles = 0;                              47 my $output_roles = 0;
 52 my $output_rolestats = 1;                          48 my $output_rolestats = 1;
 53 my $output_section_maxlen = 50;                    49 my $output_section_maxlen = 50;
 54 my $scm = 0;                                       50 my $scm = 0;
 55 my $tree = 1;                                  << 
 56 my $web = 0;                                       51 my $web = 0;
 57 my $subsystem = 0;                                 52 my $subsystem = 0;
 58 my $status = 0;                                    53 my $status = 0;
 59 my $letters = "";                                  54 my $letters = "";
 60 my $keywords = 1;                                  55 my $keywords = 1;
 61 my $keywords_in_file = 0;                      << 
 62 my $sections = 0;                                  56 my $sections = 0;
 63 my $email_file_emails = 0;                     !!  57 my $file_emails = 0;
 64 my $from_filename = 0;                             58 my $from_filename = 0;
 65 my $pattern_depth = 0;                             59 my $pattern_depth = 0;
 66 my $self_test = undef;                         << 
 67 my $version = 0;                                   60 my $version = 0;
 68 my $help = 0;                                      61 my $help = 0;
 69 my $find_maintainer_files = 0;                     62 my $find_maintainer_files = 0;
 70 my $maintainer_path;                           !!  63 
 71 my $vcs_used = 0;                                  64 my $vcs_used = 0;
 72                                                    65 
 73 my $exit = 0;                                      66 my $exit = 0;
 74                                                    67 
 75 my @files = ();                                << 
 76 my @fixes = ();                 # If a patch d << 
 77 my @range = ();                                << 
 78 my @keyword_tvi = ();                          << 
 79 my @file_emails = ();                          << 
 80                                                << 
 81 my %commit_author_hash;                            68 my %commit_author_hash;
 82 my %commit_signer_hash;                            69 my %commit_signer_hash;
 83                                                    70 
 84 my @penguin_chief = ();                            71 my @penguin_chief = ();
 85 push(@penguin_chief, "Linus Torvalds:torvalds\     72 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
 86 #Andrew wants in on most everything - 2009/01/     73 #Andrew wants in on most everything - 2009/01/14
 87 #push(@penguin_chief, "Andrew Morton:akpm\@lin     74 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
 88                                                    75 
 89 my @penguin_chief_names = ();                      76 my @penguin_chief_names = ();
 90 foreach my $chief (@penguin_chief) {               77 foreach my $chief (@penguin_chief) {
 91     if ($chief =~ m/^(.*):(.*)/) {                 78     if ($chief =~ m/^(.*):(.*)/) {
 92         my $chief_name = $1;                       79         my $chief_name = $1;
 93         my $chief_addr = $2;                       80         my $chief_addr = $2;
 94         push(@penguin_chief_names, $chief_name     81         push(@penguin_chief_names, $chief_name);
 95     }                                              82     }
 96 }                                                  83 }
 97 my $penguin_chiefs = "\(" . join("|", @penguin     84 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
 98                                                    85 
 99 # Signature types of people who are either         86 # Signature types of people who are either
100 #       a) responsible for the code in questio     87 #       a) responsible for the code in question, or
101 #       b) familiar enough with it to give rel     88 #       b) familiar enough with it to give relevant feedback
102 my @signature_tags = ();                           89 my @signature_tags = ();
103 push(@signature_tags, "Signed-off-by:");           90 push(@signature_tags, "Signed-off-by:");
104 push(@signature_tags, "Reviewed-by:");             91 push(@signature_tags, "Reviewed-by:");
105 push(@signature_tags, "Acked-by:");                92 push(@signature_tags, "Acked-by:");
106                                                    93 
107 my $signature_pattern = "\(" . join("|", @sign     94 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
108                                                    95 
109 # rfc822 email address - preloaded methods go      96 # rfc822 email address - preloaded methods go here.
110 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";         97 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
111 my $rfc822_char = '[\\000-\\377]';                 98 my $rfc822_char = '[\\000-\\377]';
112                                                    99 
113 # VCS command support: class-like functions an    100 # VCS command support: class-like functions and strings
114                                                   101 
115 my %VCS_cmds;                                     102 my %VCS_cmds;
116                                                   103 
117 my %VCS_cmds_git = (                              104 my %VCS_cmds_git = (
118     "execute_cmd" => \&git_execute_cmd,           105     "execute_cmd" => \&git_execute_cmd,
119     "available" => '(which("git") ne "") && (-    106     "available" => '(which("git") ne "") && (-e ".git")',
120     "find_signers_cmd" =>                         107     "find_signers_cmd" =>
121         "git log --no-color --follow --since=\    108         "git log --no-color --follow --since=\$email_git_since " .
122             '--numstat --no-merges ' .            109             '--numstat --no-merges ' .
123             '--format="GitCommit: %H%n' .         110             '--format="GitCommit: %H%n' .
124                       'GitAuthor: %an <%ae>%n'    111                       'GitAuthor: %an <%ae>%n' .
125                       'GitDate: %aD%n' .          112                       'GitDate: %aD%n' .
126                       'GitSubject: %s%n' .        113                       'GitSubject: %s%n' .
127                       '%b%n"' .                   114                       '%b%n"' .
128             " -- \$file",                         115             " -- \$file",
129     "find_commit_signers_cmd" =>                  116     "find_commit_signers_cmd" =>
130         "git log --no-color " .                   117         "git log --no-color " .
131             '--numstat ' .                        118             '--numstat ' .
132             '--format="GitCommit: %H%n' .         119             '--format="GitCommit: %H%n' .
133                       'GitAuthor: %an <%ae>%n'    120                       'GitAuthor: %an <%ae>%n' .
134                       'GitDate: %aD%n' .          121                       'GitDate: %aD%n' .
135                       'GitSubject: %s%n' .        122                       'GitSubject: %s%n' .
136                       '%b%n"' .                   123                       '%b%n"' .
137             " -1 \$commit",                       124             " -1 \$commit",
138     "find_commit_author_cmd" =>                   125     "find_commit_author_cmd" =>
139         "git log --no-color " .                   126         "git log --no-color " .
140             '--numstat ' .                        127             '--numstat ' .
141             '--format="GitCommit: %H%n' .         128             '--format="GitCommit: %H%n' .
142                       'GitAuthor: %an <%ae>%n'    129                       'GitAuthor: %an <%ae>%n' .
143                       'GitDate: %aD%n' .          130                       'GitDate: %aD%n' .
144                       'GitSubject: %s%n"' .       131                       'GitSubject: %s%n"' .
145             " -1 \$commit",                       132             " -1 \$commit",
146     "blame_range_cmd" => "git blame -l -L \$di    133     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
147     "blame_file_cmd" => "git blame -l \$file",    134     "blame_file_cmd" => "git blame -l \$file",
148     "commit_pattern" => "^GitCommit: ([0-9a-f]    135     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
149     "blame_commit_pattern" => "^([0-9a-f]+) ",    136     "blame_commit_pattern" => "^([0-9a-f]+) ",
150     "author_pattern" => "^GitAuthor: (.*)",       137     "author_pattern" => "^GitAuthor: (.*)",
151     "subject_pattern" => "^GitSubject: (.*)",     138     "subject_pattern" => "^GitSubject: (.*)",
152     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$fi    139     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
153     "file_exists_cmd" => "git ls-files \$file"    140     "file_exists_cmd" => "git ls-files \$file",
154     "list_files_cmd" => "git ls-files \$file", << 
155 );                                                141 );
156                                                   142 
157 my %VCS_cmds_hg = (                               143 my %VCS_cmds_hg = (
158     "execute_cmd" => \&hg_execute_cmd,            144     "execute_cmd" => \&hg_execute_cmd,
159     "available" => '(which("hg") ne "") && (-d    145     "available" => '(which("hg") ne "") && (-d ".hg")',
160     "find_signers_cmd" =>                         146     "find_signers_cmd" =>
161         "hg log --date=\$email_hg_since " .       147         "hg log --date=\$email_hg_since " .
162             "--template='HgCommit: {node}\\n"     148             "--template='HgCommit: {node}\\n" .
163                         "HgAuthor: {author}\\n    149                         "HgAuthor: {author}\\n" .
164                         "HgSubject: {desc}\\n'    150                         "HgSubject: {desc}\\n'" .
165             " -- \$file",                         151             " -- \$file",
166     "find_commit_signers_cmd" =>                  152     "find_commit_signers_cmd" =>
167         "hg log " .                               153         "hg log " .
168             "--template='HgSubject: {desc}\\n'    154             "--template='HgSubject: {desc}\\n'" .
169             " -r \$commit",                       155             " -r \$commit",
170     "find_commit_author_cmd" =>                   156     "find_commit_author_cmd" =>
171         "hg log " .                               157         "hg log " .
172             "--template='HgCommit: {node}\\n"     158             "--template='HgCommit: {node}\\n" .
173                         "HgAuthor: {author}\\n    159                         "HgAuthor: {author}\\n" .
174                         "HgSubject: {desc|firs    160                         "HgSubject: {desc|firstline}\\n'" .
175             " -r \$commit",                       161             " -r \$commit",
176     "blame_range_cmd" => "",            # not     162     "blame_range_cmd" => "",            # not supported
177     "blame_file_cmd" => "hg blame -n \$file",     163     "blame_file_cmd" => "hg blame -n \$file",
178     "commit_pattern" => "^HgCommit: ([0-9a-f]{    164     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
179     "blame_commit_pattern" => "^([ 0-9a-f]+):"    165     "blame_commit_pattern" => "^([ 0-9a-f]+):",
180     "author_pattern" => "^HgAuthor: (.*)",        166     "author_pattern" => "^HgAuthor: (.*)",
181     "subject_pattern" => "^HgSubject: (.*)",      167     "subject_pattern" => "^HgSubject: (.*)",
182     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file    168     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
183     "file_exists_cmd" => "hg files \$file",       169     "file_exists_cmd" => "hg files \$file",
184     "list_files_cmd" => "hg manifest -R \$file << 
185 );                                                170 );
186                                                   171 
187 my $conf = which_conf(".get_maintainer.conf");    172 my $conf = which_conf(".get_maintainer.conf");
188 if (-f $conf) {                                   173 if (-f $conf) {
189     my @conf_args;                                174     my @conf_args;
190     open(my $conffile, '<', "$conf")              175     open(my $conffile, '<', "$conf")
191         or warn "$P: Can't find a readable .ge    176         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
192                                                   177 
193     while (<$conffile>) {                         178     while (<$conffile>) {
194         my $line = $_;                            179         my $line = $_;
195                                                   180 
196         $line =~ s/\s*\n?$//g;                    181         $line =~ s/\s*\n?$//g;
197         $line =~ s/^\s*//g;                       182         $line =~ s/^\s*//g;
198         $line =~ s/\s+/ /g;                       183         $line =~ s/\s+/ /g;
199                                                   184 
200         next if ($line =~ m/^\s*#/);              185         next if ($line =~ m/^\s*#/);
201         next if ($line =~ m/^\s*$/);              186         next if ($line =~ m/^\s*$/);
202                                                   187 
203         my @words = split(" ", $line);            188         my @words = split(" ", $line);
204         foreach my $word (@words) {               189         foreach my $word (@words) {
205             last if ($word =~ m/^#/);             190             last if ($word =~ m/^#/);
206             push (@conf_args, $word);             191             push (@conf_args, $word);
207         }                                         192         }
208     }                                             193     }
209     close($conffile);                             194     close($conffile);
210     unshift(@ARGV, @conf_args) if @conf_args;     195     unshift(@ARGV, @conf_args) if @conf_args;
211 }                                                 196 }
212                                                   197 
213 my @ignore_emails = ();                           198 my @ignore_emails = ();
214 my $ignore_file = which_conf(".get_maintainer.    199 my $ignore_file = which_conf(".get_maintainer.ignore");
215 if (-f $ignore_file) {                            200 if (-f $ignore_file) {
216     open(my $ignore, '<', "$ignore_file")         201     open(my $ignore, '<', "$ignore_file")
217         or warn "$P: Can't find a readable .ge    202         or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
218     while (<$ignore>) {                           203     while (<$ignore>) {
219         my $line = $_;                            204         my $line = $_;
220                                                   205 
221         $line =~ s/\s*\n?$//;                     206         $line =~ s/\s*\n?$//;
222         $line =~ s/^\s*//;                        207         $line =~ s/^\s*//;
223         $line =~ s/\s+$//;                        208         $line =~ s/\s+$//;
224         $line =~ s/#.*$//;                        209         $line =~ s/#.*$//;
225                                                   210 
226         next if ($line =~ m/^\s*$/);              211         next if ($line =~ m/^\s*$/);
227         if (rfc822_valid($line)) {                212         if (rfc822_valid($line)) {
228             push(@ignore_emails, $line);          213             push(@ignore_emails, $line);
229         }                                         214         }
230     }                                             215     }
231     close($ignore);                               216     close($ignore);
232 }                                                 217 }
233                                                   218 
234 if ($#ARGV > 0) {                              << 
235     foreach (@ARGV) {                          << 
236         if ($_ =~ /^-{1,2}self-test(?:=|$)/) { << 
237             die "$P: using --self-test does no << 
238         }                                      << 
239     }                                          << 
240 }                                              << 
241                                                << 
242 if (!GetOptions(                                  219 if (!GetOptions(
243                 'email!' => \$email,              220                 'email!' => \$email,
244                 'git!' => \$email_git,            221                 'git!' => \$email_git,
245                 'git-all-signature-types!' =>     222                 'git-all-signature-types!' => \$email_git_all_signature_types,
246                 'git-blame!' => \$email_git_bl    223                 'git-blame!' => \$email_git_blame,
247                 'git-blame-signatures!' => \$e    224                 'git-blame-signatures!' => \$email_git_blame_signatures,
248                 'git-fallback!' => \$email_git    225                 'git-fallback!' => \$email_git_fallback,
249                 'git-chief-penguins!' => \$ema    226                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
250                 'git-min-signatures=i' => \$em    227                 'git-min-signatures=i' => \$email_git_min_signatures,
251                 'git-max-maintainers=i' => \$e    228                 'git-max-maintainers=i' => \$email_git_max_maintainers,
252                 'git-min-percent=i' => \$email    229                 'git-min-percent=i' => \$email_git_min_percent,
253                 'git-since=s' => \$email_git_s    230                 'git-since=s' => \$email_git_since,
254                 'hg-since=s' => \$email_hg_sin    231                 'hg-since=s' => \$email_hg_since,
255                 'i|interactive!' => \$interact    232                 'i|interactive!' => \$interactive,
256                 'remove-duplicates!' => \$emai    233                 'remove-duplicates!' => \$email_remove_duplicates,
257                 'mailmap!' => \$email_use_mail    234                 'mailmap!' => \$email_use_mailmap,
258                 'm!' => \$email_maintainer,       235                 'm!' => \$email_maintainer,
259                 'r!' => \$email_reviewer,         236                 'r!' => \$email_reviewer,
260                 'n!' => \$email_usename,          237                 'n!' => \$email_usename,
261                 'l!' => \$email_list,             238                 'l!' => \$email_list,
262                 'fixes!' => \$email_fixes,     << 
263                 'moderated!' => \$email_modera << 
264                 's!' => \$email_subscriber_lis    239                 's!' => \$email_subscriber_list,
265                 'multiline!' => \$output_multi    240                 'multiline!' => \$output_multiline,
266                 'roles!' => \$output_roles,       241                 'roles!' => \$output_roles,
267                 'rolestats!' => \$output_roles    242                 'rolestats!' => \$output_rolestats,
268                 'separator=s' => \$output_sepa    243                 'separator=s' => \$output_separator,
269                 'subsystem!' => \$subsystem,      244                 'subsystem!' => \$subsystem,
270                 'status!' => \$status,            245                 'status!' => \$status,
271                 'scm!' => \$scm,                  246                 'scm!' => \$scm,
272                 'tree!' => \$tree,             << 
273                 'web!' => \$web,                  247                 'web!' => \$web,
274                 'letters=s' => \$letters,         248                 'letters=s' => \$letters,
275                 'pattern-depth=i' => \$pattern    249                 'pattern-depth=i' => \$pattern_depth,
276                 'k|keywords!' => \$keywords,      250                 'k|keywords!' => \$keywords,
277                 'kf|keywords-in-file!' => \$ke << 
278                 'sections!' => \$sections,        251                 'sections!' => \$sections,
279                 'fe|file-emails!' => \$email_f !! 252                 'fe|file-emails!' => \$file_emails,
280                 'f|file' => \$from_filename,      253                 'f|file' => \$from_filename,
281                 'find-maintainer-files' => \$f    254                 'find-maintainer-files' => \$find_maintainer_files,
282                 'mpath|maintainer-path=s' => \ << 
283                 'self-test:s' => \$self_test,  << 
284                 'v|version' => \$version,         255                 'v|version' => \$version,
285                 'h|help|usage' => \$help,         256                 'h|help|usage' => \$help,
286                 )) {                              257                 )) {
287     die "$P: invalid argument - use --help if     258     die "$P: invalid argument - use --help if necessary\n";
288 }                                                 259 }
289                                                   260 
290 if ($help != 0) {                                 261 if ($help != 0) {
291     usage();                                      262     usage();
292     exit 0;                                       263     exit 0;
293 }                                                 264 }
294                                                   265 
295 if ($version != 0) {                              266 if ($version != 0) {
296     print("${P} ${V}\n");                         267     print("${P} ${V}\n");
297     exit 0;                                       268     exit 0;
298 }                                                 269 }
299                                                   270 
300 if (defined $self_test) {                      << 
301     read_all_maintainer_files();               << 
302     self_test();                               << 
303     exit 0;                                    << 
304 }                                              << 
305                                                << 
306 if (-t STDIN && !@ARGV) {                         271 if (-t STDIN && !@ARGV) {
307     # We're talking to a terminal, but have no    272     # We're talking to a terminal, but have no command line arguments.
308     die "$P: missing patchfile or -f file - us    273     die "$P: missing patchfile or -f file - use --help if necessary\n";
309 }                                                 274 }
310                                                   275 
311 $output_multiline = 0 if ($output_separator ne    276 $output_multiline = 0 if ($output_separator ne ", ");
312 $output_rolestats = 1 if ($interactive);          277 $output_rolestats = 1 if ($interactive);
313 $output_roles = 1 if ($output_rolestats);         278 $output_roles = 1 if ($output_rolestats);
314                                                   279 
315 if ($sections || $letters ne "") {                280 if ($sections || $letters ne "") {
316     $sections = 1;                                281     $sections = 1;
317     $email = 0;                                   282     $email = 0;
318     $email_list = 0;                              283     $email_list = 0;
319     $scm = 0;                                     284     $scm = 0;
320     $status = 0;                                  285     $status = 0;
321     $subsystem = 0;                               286     $subsystem = 0;
322     $web = 0;                                     287     $web = 0;
323     $keywords = 0;                                288     $keywords = 0;
324     $keywords_in_file = 0;                     << 
325     $interactive = 0;                             289     $interactive = 0;
326 } else {                                          290 } else {
327     my $selections = $email + $scm + $status +    291     my $selections = $email + $scm + $status + $subsystem + $web;
328     if ($selections == 0) {                       292     if ($selections == 0) {
329         die "$P:  Missing required option: ema    293         die "$P:  Missing required option: email, scm, status, subsystem or web\n";
330     }                                             294     }
331 }                                                 295 }
332                                                   296 
333 if ($email &&                                     297 if ($email &&
334     ($email_maintainer + $email_reviewer +        298     ($email_maintainer + $email_reviewer +
335      $email_list + $email_subscriber_list +       299      $email_list + $email_subscriber_list +
336      $email_git + $email_git_penguin_chiefs +     300      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
337     die "$P: Please select at least 1 email op    301     die "$P: Please select at least 1 email option\n";
338 }                                                 302 }
339                                                   303 
340 if ($tree && !top_of_kernel_tree($lk_path)) {  !! 304 if (!top_of_kernel_tree($lk_path)) {
341     die "$P: The current directory does not ap    305     die "$P: The current directory does not appear to be "
342         . "a linux kernel source tree.\n";        306         . "a linux kernel source tree.\n";
343 }                                                 307 }
344                                                   308 
345 ## Read MAINTAINERS for type/value pairs          309 ## Read MAINTAINERS for type/value pairs
346                                                   310 
347 my @typevalue = ();                               311 my @typevalue = ();
348 my %keyword_hash;                                 312 my %keyword_hash;
349 my @mfiles = ();                                  313 my @mfiles = ();
350 my @self_test_info = ();                       << 
351                                                   314 
352 sub read_maintainer_file {                        315 sub read_maintainer_file {
353     my ($file) = @_;                              316     my ($file) = @_;
354                                                   317 
355     open (my $maint, '<', "$file")                318     open (my $maint, '<', "$file")
356         or die "$P: Can't open MAINTAINERS fil    319         or die "$P: Can't open MAINTAINERS file '$file': $!\n";
357     my $i = 1;                                 << 
358     while (<$maint>) {                            320     while (<$maint>) {
359         my $line = $_;                            321         my $line = $_;
360         chomp $line;                           << 
361                                                   322 
362         if ($line =~ m/^([A-Z]):\s*(.*)/) {       323         if ($line =~ m/^([A-Z]):\s*(.*)/) {
363             my $type = $1;                        324             my $type = $1;
364             my $value = $2;                       325             my $value = $2;
365                                                   326 
366             ##Filename pattern matching           327             ##Filename pattern matching
367             if ($type eq "F" || $type eq "X")     328             if ($type eq "F" || $type eq "X") {
368                 $value =~ s@\.@\\\.@g;       #    329                 $value =~ s@\.@\\\.@g;       ##Convert . to \.
369                 $value =~ s/\*/\.\*/g;       #    330                 $value =~ s/\*/\.\*/g;       ##Convert * to .*
370                 $value =~ s/\?/\./g;         #    331                 $value =~ s/\?/\./g;         ##Convert ? to .
371                 ##if pattern is a directory an    332                 ##if pattern is a directory and it lacks a trailing slash, add one
372                 if ((-d $value)) {                333                 if ((-d $value)) {
373                     $value =~ s@([^/])$@$1/@;     334                     $value =~ s@([^/])$@$1/@;
374                 }                                 335                 }
375             } elsif ($type eq "K") {              336             } elsif ($type eq "K") {
376                 $keyword_hash{@typevalue} = $v    337                 $keyword_hash{@typevalue} = $value;
377             }                                     338             }
378             push(@typevalue, "$type:$value");     339             push(@typevalue, "$type:$value");
379         } elsif (!(/^\s*$/ || /^\s*\#/)) {        340         } elsif (!(/^\s*$/ || /^\s*\#/)) {
                                                   >> 341             $line =~ s/\n$//g;
380             push(@typevalue, $line);              342             push(@typevalue, $line);
381         }                                         343         }
382         if (defined $self_test) {              << 
383             push(@self_test_info, {file=>$file << 
384         }                                      << 
385         $i++;                                  << 
386     }                                             344     }
387     close($maint);                                345     close($maint);
388 }                                                 346 }
389                                                   347 
390 sub find_is_maintainer_file {                     348 sub find_is_maintainer_file {
391     my ($file) = $_;                              349     my ($file) = $_;
392     return if ($file !~ m@/MAINTAINERS$@);        350     return if ($file !~ m@/MAINTAINERS$@);
393     $file = $File::Find::name;                    351     $file = $File::Find::name;
394     return if (! -f $file);                       352     return if (! -f $file);
395     push(@mfiles, $file);                         353     push(@mfiles, $file);
396 }                                                 354 }
397                                                   355 
398 sub find_ignore_git {                             356 sub find_ignore_git {
399     return grep { $_ !~ /^\.git$/; } @_;          357     return grep { $_ !~ /^\.git$/; } @_;
400 }                                                 358 }
401                                                   359 
402 read_all_maintainer_files();                   !! 360 if (-d "${lk_path}MAINTAINERS") {
403                                                !! 361     opendir(DIR, "${lk_path}MAINTAINERS") or die $!;
404 sub read_all_maintainer_files {                !! 362     my @files = readdir(DIR);
405     my $path = "${lk_path}MAINTAINERS";        !! 363     closedir(DIR);
406     if (defined $maintainer_path) {            !! 364     foreach my $file (@files) {
407         $path = $maintainer_path;              !! 365         push(@mfiles, "${lk_path}MAINTAINERS/$file") if ($file !~ /^\./);
408         # Perl Cookbook tilde expansion if nec << 
409         $path =~ s@^~([^/]*)@ $1 ? (getpwnam($ << 
410     }                                          << 
411                                                << 
412     if (-d $path) {                            << 
413         $path .= '/' if ($path !~ m@/$@);      << 
414         if ($find_maintainer_files) {          << 
415             find( { wanted => \&find_is_mainta << 
416                     preprocess => \&find_ignor << 
417                     no_chdir => 1,             << 
418                 }, "$path");                   << 
419         } else {                               << 
420             opendir(DIR, "$path") or die $!;   << 
421             my @files = readdir(DIR);          << 
422             closedir(DIR);                     << 
423             foreach my $file (@files) {        << 
424                 push(@mfiles, "$path$file") if << 
425             }                                  << 
426         }                                      << 
427     } elsif (-f "$path") {                     << 
428         push(@mfiles, "$path");                << 
429     } else {                                   << 
430         die "$P: MAINTAINER file not found '$p << 
431     }                                          << 
432     die "$P: No MAINTAINER files found in '$pa << 
433     foreach my $file (@mfiles) {               << 
434         read_maintainer_file("$file");         << 
435     }                                             366     }
436 }                                                 367 }
437                                                   368 
438 sub maintainers_in_file {                      !! 369 if ($find_maintainer_files) {
439     my ($file) = @_;                           !! 370     find( { wanted => \&find_is_maintainer_file,
440                                                !! 371             preprocess => \&find_ignore_git,
441     return if ($file =~ m@\bMAINTAINERS$@);    !! 372             no_chdir => 1,
442                                                !! 373         }, "${lk_path}");
443     if (-f $file && ($email_file_emails || $fi !! 374 } else {
444         open(my $f, '<', $file)                !! 375     push(@mfiles, "${lk_path}MAINTAINERS") if -f "${lk_path}MAINTAINERS";
445             or die "$P: Can't open $file: $!\n !! 376 }
446         my $text = do { local($/) ; <$f> };    << 
447         close($f);                             << 
448                                                   377 
449         my @poss_addr = $text =~ m$[\p{L}\"\' < !! 378 foreach my $file (@mfiles) {
450         push(@file_emails, clean_file_emails(@ !! 379     read_maintainer_file("$file");
451     }                                          << 
452 }                                                 380 }
453                                                   381 
454 #                                                 382 #
455 # Read mail address map                           383 # Read mail address map
456 #                                                 384 #
457                                                   385 
458 my $mailmap;                                      386 my $mailmap;
459                                                   387 
460 read_mailmap();                                   388 read_mailmap();
461                                                   389 
462 sub read_mailmap {                                390 sub read_mailmap {
463     $mailmap = {                                  391     $mailmap = {
464         names => {},                              392         names => {},
465         addresses => {}                           393         addresses => {}
466     };                                            394     };
467                                                   395 
468     return if (!$email_use_mailmap || !(-f "${    396     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
469                                                   397 
470     open(my $mailmap_file, '<', "${lk_path}.ma    398     open(my $mailmap_file, '<', "${lk_path}.mailmap")
471         or warn "$P: Can't open .mailmap: $!\n    399         or warn "$P: Can't open .mailmap: $!\n";
472                                                   400 
473     while (<$mailmap_file>) {                     401     while (<$mailmap_file>) {
474         s/#.*$//; #strip comments                 402         s/#.*$//; #strip comments
475         s/^\s+|\s+$//g; #trim                     403         s/^\s+|\s+$//g; #trim
476                                                   404 
477         next if (/^\s*$/); #skip empty lines      405         next if (/^\s*$/); #skip empty lines
478         #entries have one of the following for    406         #entries have one of the following formats:
479         # name1 <mail1>                           407         # name1 <mail1>
480         # <mail1> <mail2>                         408         # <mail1> <mail2>
481         # name1 <mail1> <mail2>                   409         # name1 <mail1> <mail2>
482         # name1 <mail1> name2 <mail2>             410         # name1 <mail1> name2 <mail2>
483         # (see man git-shortlog)                  411         # (see man git-shortlog)
484                                                   412 
485         if (/^([^<]+)<([^>]+)>$/) {               413         if (/^([^<]+)<([^>]+)>$/) {
486             my $real_name = $1;                   414             my $real_name = $1;
487             my $address = $2;                     415             my $address = $2;
488                                                   416 
489             $real_name =~ s/\s+$//;               417             $real_name =~ s/\s+$//;
490             ($real_name, $address) = parse_ema    418             ($real_name, $address) = parse_email("$real_name <$address>");
491             $mailmap->{names}->{$address} = $r    419             $mailmap->{names}->{$address} = $real_name;
492                                                   420 
493         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {     421         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
494             my $real_address = $1;                422             my $real_address = $1;
495             my $wrong_address = $2;               423             my $wrong_address = $2;
496                                                   424 
497             $mailmap->{addresses}->{$wrong_add    425             $mailmap->{addresses}->{$wrong_address} = $real_address;
498                                                   426 
499         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/    427         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
500             my $real_name = $1;                   428             my $real_name = $1;
501             my $real_address = $2;                429             my $real_address = $2;
502             my $wrong_address = $3;               430             my $wrong_address = $3;
503                                                   431 
504             $real_name =~ s/\s+$//;               432             $real_name =~ s/\s+$//;
505             ($real_name, $real_address) =         433             ($real_name, $real_address) =
506                 parse_email("$real_name <$real    434                 parse_email("$real_name <$real_address>");
507             $mailmap->{names}->{$wrong_address    435             $mailmap->{names}->{$wrong_address} = $real_name;
508             $mailmap->{addresses}->{$wrong_add    436             $mailmap->{addresses}->{$wrong_address} = $real_address;
509                                                   437 
510         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^    438         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
511             my $real_name = $1;                   439             my $real_name = $1;
512             my $real_address = $2;                440             my $real_address = $2;
513             my $wrong_name = $3;                  441             my $wrong_name = $3;
514             my $wrong_address = $4;               442             my $wrong_address = $4;
515                                                   443 
516             $real_name =~ s/\s+$//;               444             $real_name =~ s/\s+$//;
517             ($real_name, $real_address) =         445             ($real_name, $real_address) =
518                 parse_email("$real_name <$real    446                 parse_email("$real_name <$real_address>");
519                                                   447 
520             $wrong_name =~ s/\s+$//;              448             $wrong_name =~ s/\s+$//;
521             ($wrong_name, $wrong_address) =       449             ($wrong_name, $wrong_address) =
522                 parse_email("$wrong_name <$wro    450                 parse_email("$wrong_name <$wrong_address>");
523                                                   451 
524             my $wrong_email = format_email($wr    452             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
525             $mailmap->{names}->{$wrong_email}     453             $mailmap->{names}->{$wrong_email} = $real_name;
526             $mailmap->{addresses}->{$wrong_ema    454             $mailmap->{addresses}->{$wrong_email} = $real_address;
527         }                                         455         }
528     }                                             456     }
529     close($mailmap_file);                         457     close($mailmap_file);
530 }                                                 458 }
531                                                   459 
532 ## use the filenames on the command line or fi    460 ## use the filenames on the command line or find the filenames in the patchfiles
533                                                   461 
                                                   >> 462 my @files = ();
                                                   >> 463 my @range = ();
                                                   >> 464 my @keyword_tvi = ();
                                                   >> 465 my @file_emails = ();
                                                   >> 466 
534 if (!@ARGV) {                                     467 if (!@ARGV) {
535     push(@ARGV, "&STDIN");                        468     push(@ARGV, "&STDIN");
536 }                                                 469 }
537                                                   470 
538 foreach my $file (@ARGV) {                        471 foreach my $file (@ARGV) {
539     if ($file ne "&STDIN") {                      472     if ($file ne "&STDIN") {
540         $file = canonpath($file);              << 
541         ##if $file is a directory and it lacks    473         ##if $file is a directory and it lacks a trailing slash, add one
542         if ((-d $file)) {                         474         if ((-d $file)) {
543             $file =~ s@([^/])$@$1/@;              475             $file =~ s@([^/])$@$1/@;
544         } elsif (!(-f $file)) {                   476         } elsif (!(-f $file)) {
545             die "$P: file '${file}' not found\    477             die "$P: file '${file}' not found\n";
546         }                                         478         }
547     }                                             479     }
548     if ($from_filename && (vcs_exists() && !vc << 
549         warn "$P: file '$file' not found in ve << 
550     }                                          << 
551     if ($from_filename || ($file ne "&STDIN" &    480     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
552         $file =~ s/^\Q${cur_path}\E//;  #strip    481         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
553         $file =~ s/^\Q${lk_path}\E//;   #or th    482         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
554         push(@files, $file);                      483         push(@files, $file);
555         if ($file ne "MAINTAINERS" && -f $file !! 484         if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
556             open(my $f, '<', $file)               485             open(my $f, '<', $file)
557                 or die "$P: Can't open $file:     486                 or die "$P: Can't open $file: $!\n";
558             my $text = do { local($/) ; <$f> }    487             my $text = do { local($/) ; <$f> };
559             close($f);                            488             close($f);
560             foreach my $line (keys %keyword_ha !! 489             if ($keywords) {
561                 if ($text =~ m/$keyword_hash{$ !! 490                 foreach my $line (keys %keyword_hash) {
562                     push(@keyword_tvi, $line); !! 491                     if ($text =~ m/$keyword_hash{$line}/x) {
                                                   >> 492                         push(@keyword_tvi, $line);
                                                   >> 493                     }
563                 }                                 494                 }
564             }                                     495             }
                                                   >> 496             if ($file_emails) {
                                                   >> 497                 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;
                                                   >> 498                 push(@file_emails, clean_file_emails(@poss_addr));
                                                   >> 499             }
565         }                                         500         }
566     } else {                                      501     } else {
567         my $file_cnt = @files;                    502         my $file_cnt = @files;
568         my $lastfile;                             503         my $lastfile;
569                                                   504 
570         open(my $patch, "< $file")                505         open(my $patch, "< $file")
571             or die "$P: Can't open $file: $!\n    506             or die "$P: Can't open $file: $!\n";
572                                                   507 
573         # We can check arbitrary information b    508         # We can check arbitrary information before the patch
574         # like the commit message, mail header    509         # like the commit message, mail headers, etc...
575         # This allows us to match arbitrary ke    510         # This allows us to match arbitrary keywords against any part
576         # of a git format-patch generated file    511         # of a git format-patch generated file (subject tags, etc...)
577                                                   512 
578         my $patch_prefix = "";                    513         my $patch_prefix = "";                  #Parsing the intro
579                                                   514 
580         while (<$patch>) {                        515         while (<$patch>) {
581             my $patch_line = $_;                  516             my $patch_line = $_;
582             if (m/^ mode change [0-7]+ => [0-7 !! 517             if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
583                 my $filename = $1;             << 
584                 push(@files, $filename);       << 
585             } elsif (m/^rename (?:from|to) (\S << 
586                 my $filename = $1;             << 
587                 push(@files, $filename);       << 
588             } elsif (m/^diff --git a\/(\S+) b\ << 
589                 my $filename1 = $1;            << 
590                 my $filename2 = $2;            << 
591                 push(@files, $filename1);      << 
592                 push(@files, $filename2);      << 
593             } elsif (m/^Fixes:\s+([0-9a-fA-F]{ << 
594                 push(@fixes, $1) if ($email_fi << 
595             } elsif (m/^\+\+\+\s+(\S+)/ or m/^ << 
596                 my $filename = $1;                518                 my $filename = $1;
597                 $filename =~ s@^[^/]*/@@;         519                 $filename =~ s@^[^/]*/@@;
598                 $filename =~ s@\n@@;              520                 $filename =~ s@\n@@;
599                 $lastfile = $filename;            521                 $lastfile = $filename;
600                 push(@files, $filename);          522                 push(@files, $filename);
601                 $patch_prefix = "^[+-].*";        523                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
602             } elsif (m/^\@\@ -(\d+),(\d+)/) {     524             } elsif (m/^\@\@ -(\d+),(\d+)/) {
603                 if ($email_git_blame) {           525                 if ($email_git_blame) {
604                     push(@range, "$lastfile:$1    526                     push(@range, "$lastfile:$1:$2");
605                 }                                 527                 }
606             } elsif ($keywords) {                 528             } elsif ($keywords) {
607                 foreach my $line (keys %keywor    529                 foreach my $line (keys %keyword_hash) {
608                     if ($patch_line =~ m/${pat    530                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
609                         push(@keyword_tvi, $li    531                         push(@keyword_tvi, $line);
610                     }                             532                     }
611                 }                                 533                 }
612             }                                     534             }
613         }                                         535         }
614         close($patch);                            536         close($patch);
615                                                   537 
616         if ($file_cnt == @files) {                538         if ($file_cnt == @files) {
617             warn "$P: file '${file}' doesn't a    539             warn "$P: file '${file}' doesn't appear to be a patch.  "
618                 . "Add -f to options?\n";         540                 . "Add -f to options?\n";
619         }                                         541         }
620         @files = sort_and_uniq(@files);           542         @files = sort_and_uniq(@files);
621     }                                             543     }
622 }                                                 544 }
623                                                   545 
624 @file_emails = uniq(@file_emails);                546 @file_emails = uniq(@file_emails);
625 @fixes = uniq(@fixes);                         << 
626                                                   547 
627 my %email_hash_name;                              548 my %email_hash_name;
628 my %email_hash_address;                           549 my %email_hash_address;
629 my @email_to = ();                                550 my @email_to = ();
630 my %hash_list_to;                                 551 my %hash_list_to;
631 my @list_to = ();                                 552 my @list_to = ();
632 my @scm = ();                                     553 my @scm = ();
633 my @web = ();                                     554 my @web = ();
634 my @subsystem = ();                               555 my @subsystem = ();
635 my @status = ();                                  556 my @status = ();
636 my %deduplicate_name_hash = ();                   557 my %deduplicate_name_hash = ();
637 my %deduplicate_address_hash = ();                558 my %deduplicate_address_hash = ();
638                                                   559 
639 my @maintainers = get_maintainers();              560 my @maintainers = get_maintainers();
                                                   >> 561 
640 if (@maintainers) {                               562 if (@maintainers) {
641     @maintainers = merge_email(@maintainers);     563     @maintainers = merge_email(@maintainers);
642     output(@maintainers);                         564     output(@maintainers);
643 }                                                 565 }
644                                                   566 
645 if ($scm) {                                       567 if ($scm) {
646     @scm = uniq(@scm);                            568     @scm = uniq(@scm);
647     output(@scm);                                 569     output(@scm);
648 }                                                 570 }
649                                                   571 
650 if ($status) {                                    572 if ($status) {
651     @status = uniq(@status);                      573     @status = uniq(@status);
652     output(@status);                              574     output(@status);
653 }                                                 575 }
654                                                   576 
655 if ($subsystem) {                                 577 if ($subsystem) {
656     @subsystem = uniq(@subsystem);                578     @subsystem = uniq(@subsystem);
657     output(@subsystem);                           579     output(@subsystem);
658 }                                                 580 }
659                                                   581 
660 if ($web) {                                       582 if ($web) {
661     @web = uniq(@web);                            583     @web = uniq(@web);
662     output(@web);                                 584     output(@web);
663 }                                                 585 }
664                                                   586 
665 exit($exit);                                      587 exit($exit);
666                                                   588 
667 sub self_test {                                << 
668     my @lsfiles = ();                          << 
669     my @good_links = ();                       << 
670     my @bad_links = ();                        << 
671     my @section_headers = ();                  << 
672     my $index = 0;                             << 
673                                                << 
674     @lsfiles = vcs_list_files($lk_path);       << 
675                                                << 
676     for my $x (@self_test_info) {              << 
677         $index++;                              << 
678                                                << 
679         ## Section header duplication and miss << 
680         if (($self_test eq "" || $self_test =~ << 
681             $x->{line} =~ /^\S[^:]/ &&         << 
682             defined $self_test_info[$index] && << 
683             $self_test_info[$index]->{line} =~ << 
684             my $has_S = 0;                     << 
685             my $has_F = 0;                     << 
686             my $has_ML = 0;                    << 
687             my $status = "";                   << 
688             if (grep(m@^\Q$x->{line}\E@, @sect << 
689                 print("$x->{file}:$x->{linenr} << 
690             } else {                           << 
691                 push(@section_headers, $x->{li << 
692             }                                  << 
693             my $nextline = $index;             << 
694             while (defined $self_test_info[$ne << 
695                    $self_test_info[$nextline]- << 
696                 my $type = $1;                 << 
697                 my $value = $2;                << 
698                 if ($type eq "S") {            << 
699                     $has_S = 1;                << 
700                     $status = $value;          << 
701                 } elsif ($type eq "F" || $type << 
702                     $has_F = 1;                << 
703                 } elsif ($type eq "M" || $type << 
704                     $has_ML = 1;               << 
705                 }                              << 
706                 $nextline++;                   << 
707             }                                  << 
708             if (!$has_ML && $status !~ /orphan << 
709                 print("$x->{file}:$x->{linenr} << 
710             }                                  << 
711             if (!$has_S) {                     << 
712                 print("$x->{file}:$x->{linenr} << 
713             }                                  << 
714             if (!$has_F) {                     << 
715                 print("$x->{file}:$x->{linenr} << 
716             }                                  << 
717         }                                      << 
718                                                << 
719         next if ($x->{line} !~ /^([A-Z]):\s*(. << 
720                                                << 
721         my $type = $1;                         << 
722         my $value = $2;                        << 
723                                                << 
724         ## Filename pattern matching           << 
725         if (($type eq "F" || $type eq "X") &&  << 
726             ($self_test eq "" || $self_test =~ << 
727             $value =~ s@\.@\\\.@g;       ##Con << 
728             $value =~ s/\*/\.\*/g;       ##Con << 
729             $value =~ s/\?/\./g;         ##Con << 
730             ##if pattern is a directory and it << 
731             if ((-d $value)) {                 << 
732                 $value =~ s@([^/])$@$1/@;      << 
733             }                                  << 
734             if (!grep(m@^$value@, @lsfiles)) { << 
735                 print("$x->{file}:$x->{linenr} << 
736             }                                  << 
737                                                << 
738         ## Link reachability                   << 
739         } elsif (($type eq "W" || $type eq "Q" << 
740                  $value =~ /^https?:/ &&       << 
741                  ($self_test eq "" || $self_te << 
742             next if (grep(m@^\Q$value\E$@, @go << 
743             my $isbad = 0;                     << 
744             if (grep(m@^\Q$value\E$@, @bad_lin << 
745                 $isbad = 1;                    << 
746             } else {                           << 
747                 my $output = `wget --spider -q << 
748                 if ($? == 0) {                 << 
749                     push(@good_links, $value); << 
750                 } else {                       << 
751                     push(@bad_links, $value);  << 
752                     $isbad = 1;                << 
753                 }                              << 
754             }                                  << 
755             if ($isbad) {                      << 
756                 print("$x->{file}:$x->{linenr} << 
757             }                                  << 
758                                                << 
759         ## SCM reachability                    << 
760         } elsif ($type eq "T" &&               << 
761                  ($self_test eq "" || $self_te << 
762             next if (grep(m@^\Q$value\E$@, @go << 
763             my $isbad = 0;                     << 
764             if (grep(m@^\Q$value\E$@, @bad_lin << 
765                 $isbad = 1;                    << 
766             } elsif ($value !~ /^(?:git|quilt| << 
767                 print("$x->{file}:$x->{linenr} << 
768             } elsif ($value =~ /^git\s+(\S+)(\ << 
769                 my $url = $1;                  << 
770                 my $branch = "";               << 
771                 $branch = $3 if $3;            << 
772                 my $output = `git ls-remote -- << 
773                 if ($? == 0) {                 << 
774                     push(@good_links, $value); << 
775                 } else {                       << 
776                     push(@bad_links, $value);  << 
777                     $isbad = 1;                << 
778                 }                              << 
779             } elsif ($value =~ /^(?:quilt|hg)\ << 
780                 my $url = $1;                  << 
781                 my $output = `wget --spider -q << 
782                 if ($? == 0) {                 << 
783                     push(@good_links, $value); << 
784                 } else {                       << 
785                     push(@bad_links, $value);  << 
786                     $isbad = 1;                << 
787                 }                              << 
788             }                                  << 
789             if ($isbad) {                      << 
790                 print("$x->{file}:$x->{linenr} << 
791             }                                  << 
792         }                                      << 
793     }                                          << 
794 }                                              << 
795                                                << 
796 sub ignore_email_address {                        589 sub ignore_email_address {
797     my ($address) = @_;                           590     my ($address) = @_;
798                                                   591 
799     foreach my $ignore (@ignore_emails) {         592     foreach my $ignore (@ignore_emails) {
800         return 1 if ($ignore eq $address);        593         return 1 if ($ignore eq $address);
801     }                                             594     }
802                                                   595 
803     return 0;                                     596     return 0;
804 }                                                 597 }
805                                                   598 
806 sub range_is_maintained {                         599 sub range_is_maintained {
807     my ($start, $end) = @_;                       600     my ($start, $end) = @_;
808                                                   601 
809     for (my $i = $start; $i < $end; $i++) {       602     for (my $i = $start; $i < $end; $i++) {
810         my $line = $typevalue[$i];                603         my $line = $typevalue[$i];
811         if ($line =~ m/^([A-Z]):\s*(.*)/) {       604         if ($line =~ m/^([A-Z]):\s*(.*)/) {
812             my $type = $1;                        605             my $type = $1;
813             my $value = $2;                       606             my $value = $2;
814             if ($type eq 'S') {                   607             if ($type eq 'S') {
815                 if ($value =~ /(maintain|suppo    608                 if ($value =~ /(maintain|support)/i) {
816                     return 1;                     609                     return 1;
817                 }                                 610                 }
818             }                                     611             }
819         }                                         612         }
820     }                                             613     }
821     return 0;                                     614     return 0;
822 }                                                 615 }
823                                                   616 
824 sub range_has_maintainer {                        617 sub range_has_maintainer {
825     my ($start, $end) = @_;                       618     my ($start, $end) = @_;
826                                                   619 
827     for (my $i = $start; $i < $end; $i++) {       620     for (my $i = $start; $i < $end; $i++) {
828         my $line = $typevalue[$i];                621         my $line = $typevalue[$i];
829         if ($line =~ m/^([A-Z]):\s*(.*)/) {       622         if ($line =~ m/^([A-Z]):\s*(.*)/) {
830             my $type = $1;                        623             my $type = $1;
831             my $value = $2;                       624             my $value = $2;
832             if ($type eq 'M') {                   625             if ($type eq 'M') {
833                 return 1;                         626                 return 1;
834             }                                     627             }
835         }                                         628         }
836     }                                             629     }
837     return 0;                                     630     return 0;
838 }                                                 631 }
839                                                   632 
840 sub get_maintainers {                             633 sub get_maintainers {
841     %email_hash_name = ();                        634     %email_hash_name = ();
842     %email_hash_address = ();                     635     %email_hash_address = ();
843     %commit_author_hash = ();                     636     %commit_author_hash = ();
844     %commit_signer_hash = ();                     637     %commit_signer_hash = ();
845     @email_to = ();                               638     @email_to = ();
846     %hash_list_to = ();                           639     %hash_list_to = ();
847     @list_to = ();                                640     @list_to = ();
848     @scm = ();                                    641     @scm = ();
849     @web = ();                                    642     @web = ();
850     @subsystem = ();                              643     @subsystem = ();
851     @status = ();                                 644     @status = ();
852     %deduplicate_name_hash = ();                  645     %deduplicate_name_hash = ();
853     %deduplicate_address_hash = ();               646     %deduplicate_address_hash = ();
854     if ($email_git_all_signature_types) {         647     if ($email_git_all_signature_types) {
855         $signature_pattern = "(.+?)[Bb][Yy]:";    648         $signature_pattern = "(.+?)[Bb][Yy]:";
856     } else {                                      649     } else {
857         $signature_pattern = "\(" . join("|",     650         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
858     }                                             651     }
859                                                   652 
860     # Find responsible parties                    653     # Find responsible parties
861                                                   654 
862     my %exact_pattern_match_hash = ();            655     my %exact_pattern_match_hash = ();
863                                                   656 
864     foreach my $file (@files) {                   657     foreach my $file (@files) {
865                                                   658 
866         my %hash;                                 659         my %hash;
867         my $tvi = find_first_section();           660         my $tvi = find_first_section();
868         while ($tvi < @typevalue) {               661         while ($tvi < @typevalue) {
869             my $start = find_starting_index($t    662             my $start = find_starting_index($tvi);
870             my $end = find_ending_index($tvi);    663             my $end = find_ending_index($tvi);
871             my $exclude = 0;                      664             my $exclude = 0;
872             my $i;                                665             my $i;
873                                                   666 
874             #Do not match excluded file patter    667             #Do not match excluded file patterns
875                                                   668 
876             for ($i = $start; $i < $end; $i++)    669             for ($i = $start; $i < $end; $i++) {
877                 my $line = $typevalue[$i];        670                 my $line = $typevalue[$i];
878                 if ($line =~ m/^([A-Z]):\s*(.*    671                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
879                     my $type = $1;                672                     my $type = $1;
880                     my $value = $2;               673                     my $value = $2;
881                     if ($type eq 'X') {           674                     if ($type eq 'X') {
882                         if (file_match_pattern    675                         if (file_match_pattern($file, $value)) {
883                             $exclude = 1;         676                             $exclude = 1;
884                             last;                 677                             last;
885                         }                         678                         }
886                     }                             679                     }
887                 }                                 680                 }
888             }                                     681             }
889                                                   682 
890             if (!$exclude) {                      683             if (!$exclude) {
891                 for ($i = $start; $i < $end; $    684                 for ($i = $start; $i < $end; $i++) {
892                     my $line = $typevalue[$i];    685                     my $line = $typevalue[$i];
893                     if ($line =~ m/^([A-Z]):\s    686                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
894                         my $type = $1;            687                         my $type = $1;
895                         my $value = $2;           688                         my $value = $2;
896                         if ($type eq 'F') {       689                         if ($type eq 'F') {
897                             if (file_match_pat    690                             if (file_match_pattern($file, $value)) {
898                                 my $value_pd =    691                                 my $value_pd = ($value =~ tr@/@@);
899                                 my $file_pd =     692                                 my $file_pd = ($file  =~ tr@/@@);
900                                 $value_pd++ if    693                                 $value_pd++ if (substr($value,-1,1) ne "/");
901                                 $value_pd = -1    694                                 $value_pd = -1 if ($value =~ /^\.\*/);
902                                 if ($value_pd     695                                 if ($value_pd >= $file_pd &&
903                                     range_is_m    696                                     range_is_maintained($start, $end) &&
904                                     range_has_    697                                     range_has_maintainer($start, $end)) {
905                                     $exact_pat    698                                     $exact_pattern_match_hash{$file} = 1;
906                                 }                 699                                 }
907                                 if ($pattern_d    700                                 if ($pattern_depth == 0 ||
908                                     (($file_pd    701                                     (($file_pd - $value_pd) < $pattern_depth)) {
909                                     $hash{$tvi    702                                     $hash{$tvi} = $value_pd;
910                                 }                 703                                 }
911                             }                     704                             }
912                         } elsif ($type eq 'N')    705                         } elsif ($type eq 'N') {
913                             if ($file =~ m/$va    706                             if ($file =~ m/$value/x) {
914                                 $hash{$tvi} =     707                                 $hash{$tvi} = 0;
915                             }                     708                             }
916                         }                         709                         }
917                     }                             710                     }
918                 }                                 711                 }
919             }                                     712             }
920             $tvi = $end + 1;                      713             $tvi = $end + 1;
921         }                                         714         }
922                                                   715 
923         foreach my $line (sort {$hash{$b} <=>     716         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
924             add_categories($line, "");         !! 717             add_categories($line);
925             if ($sections) {                      718             if ($sections) {
926                 my $i;                            719                 my $i;
927                 my $start = find_starting_inde    720                 my $start = find_starting_index($line);
928                 my $end = find_ending_index($l    721                 my $end = find_ending_index($line);
929                 for ($i = $start; $i < $end; $    722                 for ($i = $start; $i < $end; $i++) {
930                     my $line = $typevalue[$i];    723                     my $line = $typevalue[$i];
931                     if ($line =~ /^[FX]:/) {      724                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
932                         $line =~ s/([^\\])\.([    725                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
933                         $line =~ s/([^\\])\.$/    726                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
934                         $line =~ s/\\\./\./g;     727                         $line =~ s/\\\./\./g;           ##Convert \. to .
935                         $line =~ s/\.\*/\*/g;     728                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
936                     }                             729                     }
937                     my $count = $line =~ s/^([    730                     my $count = $line =~ s/^([A-Z]):/$1:\t/g;
938                     if ($letters eq "" || (!$c    731                     if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
939                         print("$line\n");         732                         print("$line\n");
940                     }                             733                     }
941                 }                                 734                 }
942                 print("\n");                      735                 print("\n");
943             }                                     736             }
944         }                                         737         }
945                                                << 
946         maintainers_in_file($file);            << 
947     }                                             738     }
948                                                   739 
949     if ($keywords) {                              740     if ($keywords) {
950         @keyword_tvi = sort_and_uniq(@keyword_    741         @keyword_tvi = sort_and_uniq(@keyword_tvi);
951         foreach my $line (@keyword_tvi) {         742         foreach my $line (@keyword_tvi) {
952             add_categories($line, ":Keyword:$k !! 743             add_categories($line);
953         }                                         744         }
954     }                                             745     }
955                                                   746 
956     foreach my $email (@email_to, @list_to) {     747     foreach my $email (@email_to, @list_to) {
957         $email->[0] = deduplicate_email($email    748         $email->[0] = deduplicate_email($email->[0]);
958     }                                             749     }
959                                                   750 
960     foreach my $file (@files) {                   751     foreach my $file (@files) {
961         if ($email &&                             752         if ($email &&
962             ($email_git ||                     !! 753             ($email_git || ($email_git_fallback &&
963              ($email_git_fallback &&           !! 754                             !$exact_pattern_match_hash{$file}))) {
964               $file !~ /MAINTAINERS$/ &&       << 
965               !$exact_pattern_match_hash{$file << 
966             vcs_file_signoffs($file);             755             vcs_file_signoffs($file);
967         }                                         756         }
968         if ($email && $email_git_blame) {         757         if ($email && $email_git_blame) {
969             vcs_file_blame($file);                758             vcs_file_blame($file);
970         }                                         759         }
971     }                                             760     }
972                                                   761 
973     if ($email) {                                 762     if ($email) {
974         foreach my $chief (@penguin_chief) {      763         foreach my $chief (@penguin_chief) {
975             if ($chief =~ m/^(.*):(.*)/) {        764             if ($chief =~ m/^(.*):(.*)/) {
976                 my $email_address;                765                 my $email_address;
977                                                   766 
978                 $email_address = format_email(    767                 $email_address = format_email($1, $2, $email_usename);
979                 if ($email_git_penguin_chiefs)    768                 if ($email_git_penguin_chiefs) {
980                     push(@email_to, [$email_ad    769                     push(@email_to, [$email_address, 'chief penguin']);
981                 } else {                          770                 } else {
982                     @email_to = grep($_->[0] !    771                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
983                 }                                 772                 }
984             }                                     773             }
985         }                                         774         }
986                                                   775 
987         foreach my $email (@file_emails) {        776         foreach my $email (@file_emails) {
988             $email = mailmap_email($email);    << 
989             my ($name, $address) = parse_email    777             my ($name, $address) = parse_email($email);
990                                                   778 
991             my $tmp_email = format_email($name    779             my $tmp_email = format_email($name, $address, $email_usename);
992             push_email_address($tmp_email, '')    780             push_email_address($tmp_email, '');
993             add_role($tmp_email, 'in file');      781             add_role($tmp_email, 'in file');
994         }                                         782         }
995     }                                             783     }
996                                                   784 
997     foreach my $fix (@fixes) {                 << 
998         vcs_add_commit_signers($fix, "blamed_f << 
999     }                                          << 
1000                                               << 
1001     my @to = ();                                 785     my @to = ();
1002     if ($email || $email_list) {                 786     if ($email || $email_list) {
1003         if ($email) {                            787         if ($email) {
1004             @to = (@to, @email_to);              788             @to = (@to, @email_to);
1005         }                                        789         }
1006         if ($email_list) {                       790         if ($email_list) {
1007             @to = (@to, @list_to);               791             @to = (@to, @list_to);
1008         }                                        792         }
1009     }                                            793     }
1010                                                  794 
1011     if ($interactive) {                          795     if ($interactive) {
1012         @to = interactive_get_maintainers(\@t    796         @to = interactive_get_maintainers(\@to);
1013     }                                            797     }
1014                                                  798 
1015     return @to;                                  799     return @to;
1016 }                                                800 }
1017                                                  801 
1018 sub file_match_pattern {                         802 sub file_match_pattern {
1019     my ($file, $pattern) = @_;                   803     my ($file, $pattern) = @_;
1020     if (substr($pattern, -1) eq "/") {           804     if (substr($pattern, -1) eq "/") {
1021         if ($file =~ m@^$pattern@) {             805         if ($file =~ m@^$pattern@) {
1022             return 1;                            806             return 1;
1023         }                                        807         }
1024     } else {                                     808     } else {
1025         if ($file =~ m@^$pattern@) {             809         if ($file =~ m@^$pattern@) {
1026             my $s1 = ($file =~ tr@/@@);          810             my $s1 = ($file =~ tr@/@@);
1027             my $s2 = ($pattern =~ tr@/@@);       811             my $s2 = ($pattern =~ tr@/@@);
1028             if ($s1 == $s2) {                    812             if ($s1 == $s2) {
1029                 return 1;                        813                 return 1;
1030             }                                    814             }
1031         }                                        815         }
1032     }                                            816     }
1033     return 0;                                    817     return 0;
1034 }                                                818 }
1035                                                  819 
1036 sub usage {                                      820 sub usage {
1037     print <<EOT;                                 821     print <<EOT;
1038 usage: $P [options] patchfile                    822 usage: $P [options] patchfile
1039        $P [options] -f file|directory            823        $P [options] -f file|directory
1040 version: $V                                      824 version: $V
1041                                                  825 
1042 MAINTAINER field selection options:              826 MAINTAINER field selection options:
1043   --email => print email address(es) if any      827   --email => print email address(es) if any
1044     --git => include recent git \*-by: signer    828     --git => include recent git \*-by: signers
1045     --git-all-signature-types => include sign    829     --git-all-signature-types => include signers regardless of signature type
1046         or use only ${signature_pattern} sign    830         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1047     --git-fallback => use git when no exact M    831     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1048     --git-chief-penguins => include ${penguin    832     --git-chief-penguins => include ${penguin_chiefs}
1049     --git-min-signatures => number of signatu    833     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1050     --git-max-maintainers => maximum maintain    834     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1051     --git-min-percent => minimum percentage o    835     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1052     --git-blame => use git blame to find modi    836     --git-blame => use git blame to find modified commits for patch or file
1053     --git-blame-signatures => when used with     837     --git-blame-signatures => when used with --git-blame, also include all commit signers
1054     --git-since => git history to use (defaul    838     --git-since => git history to use (default: $email_git_since)
1055     --hg-since => hg history to use (default:    839     --hg-since => hg history to use (default: $email_hg_since)
1056     --interactive => display a menu (mostly u    840     --interactive => display a menu (mostly useful if used with the --git option)
1057     --m => include maintainer(s) if any          841     --m => include maintainer(s) if any
1058     --r => include reviewer(s) if any            842     --r => include reviewer(s) if any
1059     --n => include name 'Full Name <addr\@doma    843     --n => include name 'Full Name <addr\@domain.tld>'
1060     --l => include list(s) if any                844     --l => include list(s) if any
1061     --moderated => include moderated lists(s) !! 845     --s => include subscriber only list(s) if any
1062     --s => include subscriber only list(s) if << 
1063     --remove-duplicates => minimize duplicate    846     --remove-duplicates => minimize duplicate email names/addresses
1064     --roles => show roles (status:subsystem,     847     --roles => show roles (status:subsystem, git-signer, list, etc...)
1065     --rolestats => show roles and statistics     848     --rolestats => show roles and statistics (commits/total_commits, %)
1066     --file-emails => add email addresses foun    849     --file-emails => add email addresses found in -f file (default: 0 (off))
1067     --fixes => for patches, add signatures of << 
1068   --scm => print SCM tree(s) if any              850   --scm => print SCM tree(s) if any
1069   --status => print status if any                851   --status => print status if any
1070   --subsystem => print subsystem name if any     852   --subsystem => print subsystem name if any
1071   --web => print website(s) if any               853   --web => print website(s) if any
1072                                                  854 
1073 Output type options:                             855 Output type options:
1074   --separator [, ] => separator for multiple     856   --separator [, ] => separator for multiple entries on 1 line
1075     using --separator also sets --nomultiline    857     using --separator also sets --nomultiline if --separator is not [, ]
1076   --multiline => print 1 entry per line          858   --multiline => print 1 entry per line
1077                                                  859 
1078 Other options:                                   860 Other options:
1079   --pattern-depth => Number of pattern direct    861   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1080   --keywords => scan patch for keywords (defa    862   --keywords => scan patch for keywords (default: $keywords)
1081   --keywords-in-file => scan file for keyword << 
1082   --sections => print all of the subsystem se    863   --sections => print all of the subsystem sections with pattern matches
1083   --letters => print all matching 'letter' ty    864   --letters => print all matching 'letter' types from all matching sections
1084   --mailmap => use .mailmap file (default: $e    865   --mailmap => use .mailmap file (default: $email_use_mailmap)
1085   --no-tree => run without a kernel tree      << 
1086   --self-test => show potential issues with M << 
1087   --version => show version                      866   --version => show version
1088   --help => show this help information           867   --help => show this help information
1089                                                  868 
1090 Default options:                                 869 Default options:
1091   [--email --tree --nogit --git-fallback --m  !! 870   [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0
1092    --pattern-depth=0 --remove-duplicates --ro !! 871    --remove-duplicates --rolestats]
1093                                                  872 
1094 Notes:                                           873 Notes:
1095   Using "-f directory" may give unexpected re    874   Using "-f directory" may give unexpected results:
1096       Used with "--git", git signators for _a    875       Used with "--git", git signators for _all_ files in and below
1097           directory are examined as git recur    876           directory are examined as git recurses directories.
1098           Any specified X: (exclude) pattern     877           Any specified X: (exclude) pattern matches are _not_ ignored.
1099       Used with "--nogit", directory is used     878       Used with "--nogit", directory is used as a pattern match,
1100           no individual file within the direc    879           no individual file within the directory or subdirectory
1101           is matched.                            880           is matched.
1102       Used with "--git-blame", does not itera    881       Used with "--git-blame", does not iterate all files in directory
1103   Using "--git-blame" is slow and may add old    882   Using "--git-blame" is slow and may add old committers and authors
1104       that are no longer active maintainers t    883       that are no longer active maintainers to the output.
1105   Using "--roles" or "--rolestats" with git s    884   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1106       other automated tools that expect only     885       other automated tools that expect only ["name"] <email address>
1107       may not work because of additional outp    886       may not work because of additional output after <email address>.
1108   Using "--rolestats" and "--git-blame" shows    887   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1109       not the percentage of the entire file a    888       not the percentage of the entire file authored.  # of commits is
1110       not a good measure of amount of code au    889       not a good measure of amount of code authored.  1 major commit may
1111       contain a thousand lines, 5 trivial com    890       contain a thousand lines, 5 trivial commits may modify a single line.
1112   If git is not installed, but mercurial (hg)    891   If git is not installed, but mercurial (hg) is installed and an .hg
1113       repository exists, the following option    892       repository exists, the following options apply to mercurial:
1114           --git,                                 893           --git,
1115           --git-min-signatures, --git-max-mai    894           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1116           --git-blame                            895           --git-blame
1117       Use --hg-since not --git-since to contr    896       Use --hg-since not --git-since to control date selection
1118   File ".get_maintainer.conf", if it exists i    897   File ".get_maintainer.conf", if it exists in the linux kernel source root
1119       directory, can change whatever get_main    898       directory, can change whatever get_maintainer defaults are desired.
1120       Entries in this file can be any command    899       Entries in this file can be any command line argument.
1121       This file is prepended to any additiona    900       This file is prepended to any additional command line arguments.
1122       Multiple lines and # comments are allow    901       Multiple lines and # comments are allowed.
1123   Most options have both positive and negativ    902   Most options have both positive and negative forms.
1124       The negative forms for --<foo> are --no    903       The negative forms for --<foo> are --no<foo> and --no-<foo>.
1125                                                  904 
1126 EOT                                              905 EOT
1127 }                                                906 }
1128                                                  907 
1129 sub top_of_kernel_tree {                         908 sub top_of_kernel_tree {
1130     my ($lk_path) = @_;                          909     my ($lk_path) = @_;
1131                                                  910 
1132     if ($lk_path ne "" && substr($lk_path,len    911     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1133         $lk_path .= "/";                         912         $lk_path .= "/";
1134     }                                            913     }
1135     if (   (-f "${lk_path}COPYING")              914     if (   (-f "${lk_path}COPYING")
1136         && (-f "${lk_path}CREDITS")              915         && (-f "${lk_path}CREDITS")
1137         && (-f "${lk_path}Kbuild")               916         && (-f "${lk_path}Kbuild")
1138         && (-e "${lk_path}MAINTAINERS")          917         && (-e "${lk_path}MAINTAINERS")
1139         && (-f "${lk_path}Makefile")             918         && (-f "${lk_path}Makefile")
1140         && (-f "${lk_path}README")               919         && (-f "${lk_path}README")
1141         && (-d "${lk_path}Documentation")        920         && (-d "${lk_path}Documentation")
1142         && (-d "${lk_path}arch")                 921         && (-d "${lk_path}arch")
1143         && (-d "${lk_path}include")              922         && (-d "${lk_path}include")
1144         && (-d "${lk_path}drivers")              923         && (-d "${lk_path}drivers")
1145         && (-d "${lk_path}fs")                   924         && (-d "${lk_path}fs")
1146         && (-d "${lk_path}init")                 925         && (-d "${lk_path}init")
1147         && (-d "${lk_path}ipc")                  926         && (-d "${lk_path}ipc")
1148         && (-d "${lk_path}kernel")               927         && (-d "${lk_path}kernel")
1149         && (-d "${lk_path}lib")                  928         && (-d "${lk_path}lib")
1150         && (-d "${lk_path}scripts")) {           929         && (-d "${lk_path}scripts")) {
1151         return 1;                                930         return 1;
1152     }                                            931     }
1153     return 0;                                    932     return 0;
1154 }                                                933 }
1155                                                  934 
1156 sub escape_name {                             << 
1157     my ($name) = @_;                          << 
1158                                               << 
1159     if ($name =~ /[^\w \-]/ai) {         ##ha << 
1160         $name =~ s/(?<!\\)"/\\"/g;       ##es << 
1161         $name = "\"$name\"";                  << 
1162     }                                         << 
1163                                               << 
1164     return $name;                             << 
1165 }                                             << 
1166                                               << 
1167 sub parse_email {                                935 sub parse_email {
1168     my ($formatted_email) = @_;                  936     my ($formatted_email) = @_;
1169                                                  937 
1170     my $name = "";                               938     my $name = "";
1171     my $address = "";                            939     my $address = "";
1172                                                  940 
1173     if ($formatted_email =~ /^([^<]+)<(.+\@.*)    941     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
1174         $name = $1;                              942         $name = $1;
1175         $address = $2;                           943         $address = $2;
1176     } elsif ($formatted_email =~ /^\s*<(.+\@\S    944     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
1177         $address = $1;                           945         $address = $1;
1178     } elsif ($formatted_email =~ /^(.+\@\S*).    946     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
1179         $address = $1;                           947         $address = $1;
1180     }                                            948     }
1181                                                  949 
1182     $name =~ s/^\s+|\s+$//g;                     950     $name =~ s/^\s+|\s+$//g;
1183     $name =~ s/^\"|\"$//g;                       951     $name =~ s/^\"|\"$//g;
1184     $name = escape_name($name);               << 
1185     $address =~ s/^\s+|\s+$//g;                  952     $address =~ s/^\s+|\s+$//g;
1186                                                  953 
                                                   >> 954     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
                                                   >> 955         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
                                                   >> 956         $name = "\"$name\"";
                                                   >> 957     }
                                                   >> 958 
1187     return ($name, $address);                    959     return ($name, $address);
1188 }                                                960 }
1189                                                  961 
1190 sub format_email {                               962 sub format_email {
1191     my ($name, $address, $usename) = @_;         963     my ($name, $address, $usename) = @_;
1192                                                  964 
1193     my $formatted_email;                         965     my $formatted_email;
1194                                                  966 
1195     $name =~ s/^\s+|\s+$//g;                     967     $name =~ s/^\s+|\s+$//g;
1196     $name =~ s/^\"|\"$//g;                       968     $name =~ s/^\"|\"$//g;
1197     $name = escape_name($name);               << 
1198     $address =~ s/^\s+|\s+$//g;                  969     $address =~ s/^\s+|\s+$//g;
1199                                                  970 
                                                   >> 971     if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
                                                   >> 972         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
                                                   >> 973         $name = "\"$name\"";
                                                   >> 974     }
                                                   >> 975 
1200     if ($usename) {                              976     if ($usename) {
1201         if ("$name" eq "") {                     977         if ("$name" eq "") {
1202             $formatted_email = "$address";       978             $formatted_email = "$address";
1203         } else {                                 979         } else {
1204             $formatted_email = "$name <$addre    980             $formatted_email = "$name <$address>";
1205         }                                        981         }
1206     } else {                                     982     } else {
1207         $formatted_email = $address;             983         $formatted_email = $address;
1208     }                                            984     }
1209                                                  985 
1210     return $formatted_email;                     986     return $formatted_email;
1211 }                                                987 }
1212                                                  988 
1213 sub find_first_section {                         989 sub find_first_section {
1214     my $index = 0;                               990     my $index = 0;
1215                                                  991 
1216     while ($index < @typevalue) {                992     while ($index < @typevalue) {
1217         my $tv = $typevalue[$index];             993         my $tv = $typevalue[$index];
1218         if (($tv =~ m/^([A-Z]):\s*(.*)/)) {      994         if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
1219             last;                                995             last;
1220         }                                        996         }
1221         $index++;                                997         $index++;
1222     }                                            998     }
1223                                                  999 
1224     return $index;                               1000     return $index;
1225 }                                                1001 }
1226                                                  1002 
1227 sub find_starting_index {                        1003 sub find_starting_index {
1228     my ($index) = @_;                            1004     my ($index) = @_;
1229                                                  1005 
1230     while ($index > 0) {                         1006     while ($index > 0) {
1231         my $tv = $typevalue[$index];             1007         my $tv = $typevalue[$index];
1232         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {     1008         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1233             last;                                1009             last;
1234         }                                        1010         }
1235         $index--;                                1011         $index--;
1236     }                                            1012     }
1237                                                  1013 
1238     return $index;                               1014     return $index;
1239 }                                                1015 }
1240                                                  1016 
1241 sub find_ending_index {                          1017 sub find_ending_index {
1242     my ($index) = @_;                            1018     my ($index) = @_;
1243                                                  1019 
1244     while ($index < @typevalue) {                1020     while ($index < @typevalue) {
1245         my $tv = $typevalue[$index];             1021         my $tv = $typevalue[$index];
1246         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {     1022         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1247             last;                                1023             last;
1248         }                                        1024         }
1249         $index++;                                1025         $index++;
1250     }                                            1026     }
1251                                                  1027 
1252     return $index;                               1028     return $index;
1253 }                                                1029 }
1254                                                  1030 
1255 sub get_subsystem_name {                         1031 sub get_subsystem_name {
1256     my ($index) = @_;                            1032     my ($index) = @_;
1257                                                  1033 
1258     my $start = find_starting_index($index);     1034     my $start = find_starting_index($index);
1259                                                  1035 
1260     my $subsystem = $typevalue[$start];          1036     my $subsystem = $typevalue[$start];
1261     if ($output_section_maxlen && length($sub    1037     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1262         $subsystem = substr($subsystem, 0, $o    1038         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1263         $subsystem =~ s/\s*$//;                  1039         $subsystem =~ s/\s*$//;
1264         $subsystem = $subsystem . "...";         1040         $subsystem = $subsystem . "...";
1265     }                                            1041     }
1266     return $subsystem;                           1042     return $subsystem;
1267 }                                                1043 }
1268                                                  1044 
1269 sub get_maintainer_role {                        1045 sub get_maintainer_role {
1270     my ($index) = @_;                            1046     my ($index) = @_;
1271                                                  1047 
1272     my $i;                                       1048     my $i;
1273     my $start = find_starting_index($index);     1049     my $start = find_starting_index($index);
1274     my $end = find_ending_index($index);         1050     my $end = find_ending_index($index);
1275                                                  1051 
1276     my $role = "unknown";                        1052     my $role = "unknown";
1277     my $subsystem = get_subsystem_name($index    1053     my $subsystem = get_subsystem_name($index);
1278                                                  1054 
1279     for ($i = $start + 1; $i < $end; $i++) {     1055     for ($i = $start + 1; $i < $end; $i++) {
1280         my $tv = $typevalue[$i];                 1056         my $tv = $typevalue[$i];
1281         if ($tv =~ m/^([A-Z]):\s*(.*)/) {        1057         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1282             my $ptype = $1;                      1058             my $ptype = $1;
1283             my $pvalue = $2;                     1059             my $pvalue = $2;
1284             if ($ptype eq "S") {                 1060             if ($ptype eq "S") {
1285                 $role = $pvalue;                 1061                 $role = $pvalue;
1286             }                                    1062             }
1287         }                                        1063         }
1288     }                                            1064     }
1289                                                  1065 
1290     $role = lc($role);                           1066     $role = lc($role);
1291     if      ($role eq "supported") {             1067     if      ($role eq "supported") {
1292         $role = "supporter";                     1068         $role = "supporter";
1293     } elsif ($role eq "maintained") {            1069     } elsif ($role eq "maintained") {
1294         $role = "maintainer";                    1070         $role = "maintainer";
1295     } elsif ($role eq "odd fixes") {             1071     } elsif ($role eq "odd fixes") {
1296         $role = "odd fixer";                     1072         $role = "odd fixer";
1297     } elsif ($role eq "orphan") {                1073     } elsif ($role eq "orphan") {
1298         $role = "orphan minder";                 1074         $role = "orphan minder";
1299     } elsif ($role eq "obsolete") {              1075     } elsif ($role eq "obsolete") {
1300         $role = "obsolete minder";               1076         $role = "obsolete minder";
1301     } elsif ($role eq "buried alive in report    1077     } elsif ($role eq "buried alive in reporters") {
1302         $role = "chief penguin";                 1078         $role = "chief penguin";
1303     }                                            1079     }
1304                                                  1080 
1305     return $role . ":" . $subsystem;             1081     return $role . ":" . $subsystem;
1306 }                                                1082 }
1307                                                  1083 
1308 sub get_list_role {                              1084 sub get_list_role {
1309     my ($index) = @_;                            1085     my ($index) = @_;
1310                                                  1086 
1311     my $subsystem = get_subsystem_name($index    1087     my $subsystem = get_subsystem_name($index);
1312                                                  1088 
1313     if ($subsystem eq "THE REST") {              1089     if ($subsystem eq "THE REST") {
1314         $subsystem = "";                         1090         $subsystem = "";
1315     }                                            1091     }
1316                                                  1092 
1317     return $subsystem;                           1093     return $subsystem;
1318 }                                                1094 }
1319                                                  1095 
1320 sub add_categories {                             1096 sub add_categories {
1321     my ($index, $suffix) = @_;                !! 1097     my ($index) = @_;
1322                                                  1098 
1323     my $i;                                       1099     my $i;
1324     my $start = find_starting_index($index);     1100     my $start = find_starting_index($index);
1325     my $end = find_ending_index($index);         1101     my $end = find_ending_index($index);
1326                                                  1102 
1327     push(@subsystem, $typevalue[$start]);        1103     push(@subsystem, $typevalue[$start]);
1328                                                  1104 
1329     for ($i = $start + 1; $i < $end; $i++) {     1105     for ($i = $start + 1; $i < $end; $i++) {
1330         my $tv = $typevalue[$i];                 1106         my $tv = $typevalue[$i];
1331         if ($tv =~ m/^([A-Z]):\s*(.*)/) {        1107         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1332             my $ptype = $1;                      1108             my $ptype = $1;
1333             my $pvalue = $2;                     1109             my $pvalue = $2;
1334             if ($ptype eq "L") {                 1110             if ($ptype eq "L") {
1335                 my $list_address = $pvalue;      1111                 my $list_address = $pvalue;
1336                 my $list_additional = "";        1112                 my $list_additional = "";
1337                 my $list_role = get_list_role    1113                 my $list_role = get_list_role($i);
1338                                                  1114 
1339                 if ($list_role ne "") {          1115                 if ($list_role ne "") {
1340                     $list_role = ":" . $list_    1116                     $list_role = ":" . $list_role;
1341                 }                                1117                 }
1342                 if ($list_address =~ m/([^\s]    1118                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1343                     $list_address = $1;          1119                     $list_address = $1;
1344                     $list_additional = $2;       1120                     $list_additional = $2;
1345                 }                                1121                 }
1346                 if ($list_additional =~ m/sub    1122                 if ($list_additional =~ m/subscribers-only/) {
1347                     if ($email_subscriber_lis    1123                     if ($email_subscriber_list) {
1348                         if (!$hash_list_to{lc    1124                         if (!$hash_list_to{lc($list_address)}) {
1349                             $hash_list_to{lc(    1125                             $hash_list_to{lc($list_address)} = 1;
1350                             push(@list_to, [$    1126                             push(@list_to, [$list_address,
1351                                             " !! 1127                                             "subscriber list${list_role}"]);
1352                         }                        1128                         }
1353                     }                            1129                     }
1354                 } else {                         1130                 } else {
1355                     if ($email_list) {           1131                     if ($email_list) {
1356                         if (!$hash_list_to{lc    1132                         if (!$hash_list_to{lc($list_address)}) {
                                                   >> 1133                             $hash_list_to{lc($list_address)} = 1;
1357                             if ($list_additio    1134                             if ($list_additional =~ m/moderated/) {
1358                                 if ($email_mo !! 1135                                 push(@list_to, [$list_address,
1359                                     $hash_lis !! 1136                                                 "moderated list${list_role}"]);
1360                                     push(@lis << 
1361                                               << 
1362                                 }             << 
1363                             } else {             1137                             } else {
1364                                 $hash_list_to << 
1365                                 push(@list_to    1138                                 push(@list_to, [$list_address,
1366                                               !! 1139                                                 "open list${list_role}"]);
1367                             }                    1140                             }
1368                         }                        1141                         }
1369                     }                            1142                     }
1370                 }                                1143                 }
1371             } elsif ($ptype eq "M") {            1144             } elsif ($ptype eq "M") {
                                                   >> 1145                 my ($name, $address) = parse_email($pvalue);
                                                   >> 1146                 if ($name eq "") {
                                                   >> 1147                     if ($i > 0) {
                                                   >> 1148                         my $tv = $typevalue[$i - 1];
                                                   >> 1149                         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
                                                   >> 1150                             if ($1 eq "P") {
                                                   >> 1151                                 $name = $2;
                                                   >> 1152                                 $pvalue = format_email($name, $address, $email_usename);
                                                   >> 1153                             }
                                                   >> 1154                         }
                                                   >> 1155                     }
                                                   >> 1156                 }
1372                 if ($email_maintainer) {         1157                 if ($email_maintainer) {
1373                     my $role = get_maintainer    1158                     my $role = get_maintainer_role($i);
1374                     push_email_addresses($pva !! 1159                     push_email_addresses($pvalue, $role);
1375                 }                                1160                 }
1376             } elsif ($ptype eq "R") {            1161             } elsif ($ptype eq "R") {
                                                   >> 1162                 my ($name, $address) = parse_email($pvalue);
                                                   >> 1163                 if ($name eq "") {
                                                   >> 1164                     if ($i > 0) {
                                                   >> 1165                         my $tv = $typevalue[$i - 1];
                                                   >> 1166                         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
                                                   >> 1167                             if ($1 eq "P") {
                                                   >> 1168                                 $name = $2;
                                                   >> 1169                                 $pvalue = format_email($name, $address, $email_usename);
                                                   >> 1170                             }
                                                   >> 1171                         }
                                                   >> 1172                     }
                                                   >> 1173                 }
1377                 if ($email_reviewer) {           1174                 if ($email_reviewer) {
1378                     my $subsystem = get_subsy    1175                     my $subsystem = get_subsystem_name($i);
1379                     push_email_addresses($pva !! 1176                     push_email_addresses($pvalue, "reviewer:$subsystem");
1380                 }                                1177                 }
1381             } elsif ($ptype eq "T") {            1178             } elsif ($ptype eq "T") {
1382                 push(@scm, $pvalue . $suffix) !! 1179                 push(@scm, $pvalue);
1383             } elsif ($ptype eq "W") {            1180             } elsif ($ptype eq "W") {
1384                 push(@web, $pvalue . $suffix) !! 1181                 push(@web, $pvalue);
1385             } elsif ($ptype eq "S") {            1182             } elsif ($ptype eq "S") {
1386                 push(@status, $pvalue . $suff !! 1183                 push(@status, $pvalue);
1387             }                                    1184             }
1388         }                                        1185         }
1389     }                                            1186     }
1390 }                                                1187 }
1391                                                  1188 
1392 sub email_inuse {                                1189 sub email_inuse {
1393     my ($name, $address) = @_;                   1190     my ($name, $address) = @_;
1394                                                  1191 
1395     return 1 if (($name eq "") && ($address e    1192     return 1 if (($name eq "") && ($address eq ""));
1396     return 1 if (($name ne "") && exists($ema    1193     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1397     return 1 if (($address ne "") && exists($    1194     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1398                                                  1195 
1399     return 0;                                    1196     return 0;
1400 }                                                1197 }
1401                                                  1198 
1402 sub push_email_address {                         1199 sub push_email_address {
1403     my ($line, $role) = @_;                      1200     my ($line, $role) = @_;
1404                                                  1201 
1405     my ($name, $address) = parse_email($line)    1202     my ($name, $address) = parse_email($line);
1406                                                  1203 
1407     if ($address eq "") {                        1204     if ($address eq "") {
1408         return 0;                                1205         return 0;
1409     }                                            1206     }
1410                                                  1207 
1411     if (!$email_remove_duplicates) {             1208     if (!$email_remove_duplicates) {
1412         push(@email_to, [format_email($name,     1209         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1413     } elsif (!email_inuse($name, $address)) {    1210     } elsif (!email_inuse($name, $address)) {
1414         push(@email_to, [format_email($name,     1211         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1415         $email_hash_name{lc($name)}++ if ($na    1212         $email_hash_name{lc($name)}++ if ($name ne "");
1416         $email_hash_address{lc($address)}++;     1213         $email_hash_address{lc($address)}++;
1417     }                                            1214     }
1418                                                  1215 
1419     return 1;                                    1216     return 1;
1420 }                                                1217 }
1421                                                  1218 
1422 sub push_email_addresses {                       1219 sub push_email_addresses {
1423     my ($address, $role) = @_;                   1220     my ($address, $role) = @_;
1424                                                  1221 
1425     my @address_list = ();                       1222     my @address_list = ();
1426                                                  1223 
1427     if (rfc822_valid($address)) {                1224     if (rfc822_valid($address)) {
1428         push_email_address($address, $role);     1225         push_email_address($address, $role);
1429     } elsif (@address_list = rfc822_validlist    1226     } elsif (@address_list = rfc822_validlist($address)) {
1430         my $array_count = shift(@address_list    1227         my $array_count = shift(@address_list);
1431         while (my $entry = shift(@address_lis    1228         while (my $entry = shift(@address_list)) {
1432             push_email_address($entry, $role)    1229             push_email_address($entry, $role);
1433         }                                        1230         }
1434     } else {                                     1231     } else {
1435         if (!push_email_address($address, $ro    1232         if (!push_email_address($address, $role)) {
1436             warn("Invalid MAINTAINERS address    1233             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1437         }                                        1234         }
1438     }                                            1235     }
1439 }                                                1236 }
1440                                                  1237 
1441 sub add_role {                                   1238 sub add_role {
1442     my ($line, $role) = @_;                      1239     my ($line, $role) = @_;
1443                                                  1240 
1444     my ($name, $address) = parse_email($line)    1241     my ($name, $address) = parse_email($line);
1445     my $email = format_email($name, $address,    1242     my $email = format_email($name, $address, $email_usename);
1446                                                  1243 
1447     foreach my $entry (@email_to) {              1244     foreach my $entry (@email_to) {
1448         if ($email_remove_duplicates) {          1245         if ($email_remove_duplicates) {
1449             my ($entry_name, $entry_address)     1246             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1450             if (($name eq $entry_name || $add    1247             if (($name eq $entry_name || $address eq $entry_address)
1451                 && ($role eq "" || !($entry->    1248                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1452             ) {                                  1249             ) {
1453                 if ($entry->[1] eq "") {         1250                 if ($entry->[1] eq "") {
1454                     $entry->[1] = "$role";       1251                     $entry->[1] = "$role";
1455                 } else {                         1252                 } else {
1456                     $entry->[1] = "$entry->[1    1253                     $entry->[1] = "$entry->[1],$role";
1457                 }                                1254                 }
1458             }                                    1255             }
1459         } else {                                 1256         } else {
1460             if ($email eq $entry->[0]            1257             if ($email eq $entry->[0]
1461                 && ($role eq "" || !($entry->    1258                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1462             ) {                                  1259             ) {
1463                 if ($entry->[1] eq "") {         1260                 if ($entry->[1] eq "") {
1464                     $entry->[1] = "$role";       1261                     $entry->[1] = "$role";
1465                 } else {                         1262                 } else {
1466                     $entry->[1] = "$entry->[1    1263                     $entry->[1] = "$entry->[1],$role";
1467                 }                                1264                 }
1468             }                                    1265             }
1469         }                                        1266         }
1470     }                                            1267     }
1471 }                                                1268 }
1472                                                  1269 
1473 sub which {                                      1270 sub which {
1474     my ($bin) = @_;                              1271     my ($bin) = @_;
1475                                                  1272 
1476     foreach my $path (split(/:/, $ENV{PATH}))    1273     foreach my $path (split(/:/, $ENV{PATH})) {
1477         if (-e "$path/$bin") {                   1274         if (-e "$path/$bin") {
1478             return "$path/$bin";                 1275             return "$path/$bin";
1479         }                                        1276         }
1480     }                                            1277     }
1481                                                  1278 
1482     return "";                                   1279     return "";
1483 }                                                1280 }
1484                                                  1281 
1485 sub which_conf {                                 1282 sub which_conf {
1486     my ($conf) = @_;                             1283     my ($conf) = @_;
1487                                                  1284 
1488     foreach my $path (split(/:/, ".:$ENV{HOME    1285     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1489         if (-e "$path/$conf") {                  1286         if (-e "$path/$conf") {
1490             return "$path/$conf";                1287             return "$path/$conf";
1491         }                                        1288         }
1492     }                                            1289     }
1493                                                  1290 
1494     return "";                                   1291     return "";
1495 }                                                1292 }
1496                                                  1293 
1497 sub mailmap_email {                              1294 sub mailmap_email {
1498     my ($line) = @_;                             1295     my ($line) = @_;
1499                                                  1296 
1500     my ($name, $address) = parse_email($line)    1297     my ($name, $address) = parse_email($line);
1501     my $email = format_email($name, $address,    1298     my $email = format_email($name, $address, 1);
1502     my $real_name = $name;                       1299     my $real_name = $name;
1503     my $real_address = $address;                 1300     my $real_address = $address;
1504                                                  1301 
1505     if (exists $mailmap->{names}->{$email} ||    1302     if (exists $mailmap->{names}->{$email} ||
1506         exists $mailmap->{addresses}->{$email    1303         exists $mailmap->{addresses}->{$email}) {
1507         if (exists $mailmap->{names}->{$email    1304         if (exists $mailmap->{names}->{$email}) {
1508             $real_name = $mailmap->{names}->{    1305             $real_name = $mailmap->{names}->{$email};
1509         }                                        1306         }
1510         if (exists $mailmap->{addresses}->{$e    1307         if (exists $mailmap->{addresses}->{$email}) {
1511             $real_address = $mailmap->{addres    1308             $real_address = $mailmap->{addresses}->{$email};
1512         }                                        1309         }
1513     } else {                                     1310     } else {
1514         if (exists $mailmap->{names}->{$addre    1311         if (exists $mailmap->{names}->{$address}) {
1515             $real_name = $mailmap->{names}->{    1312             $real_name = $mailmap->{names}->{$address};
1516         }                                        1313         }
1517         if (exists $mailmap->{addresses}->{$a    1314         if (exists $mailmap->{addresses}->{$address}) {
1518             $real_address = $mailmap->{addres    1315             $real_address = $mailmap->{addresses}->{$address};
1519         }                                        1316         }
1520     }                                            1317     }
1521     return format_email($real_name, $real_add    1318     return format_email($real_name, $real_address, 1);
1522 }                                                1319 }
1523                                                  1320 
1524 sub mailmap {                                    1321 sub mailmap {
1525     my (@addresses) = @_;                        1322     my (@addresses) = @_;
1526                                                  1323 
1527     my @mapped_emails = ();                      1324     my @mapped_emails = ();
1528     foreach my $line (@addresses) {              1325     foreach my $line (@addresses) {
1529         push(@mapped_emails, mailmap_email($l    1326         push(@mapped_emails, mailmap_email($line));
1530     }                                            1327     }
1531     merge_by_realname(@mapped_emails) if ($em    1328     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1532     return @mapped_emails;                       1329     return @mapped_emails;
1533 }                                                1330 }
1534                                                  1331 
1535 sub merge_by_realname {                          1332 sub merge_by_realname {
1536     my %address_map;                             1333     my %address_map;
1537     my (@emails) = @_;                           1334     my (@emails) = @_;
1538                                                  1335 
1539     foreach my $email (@emails) {                1336     foreach my $email (@emails) {
1540         my ($name, $address) = parse_email($e    1337         my ($name, $address) = parse_email($email);
1541         if (exists $address_map{$name}) {        1338         if (exists $address_map{$name}) {
1542             $address = $address_map{$name};      1339             $address = $address_map{$name};
1543             $email = format_email($name, $add    1340             $email = format_email($name, $address, 1);
1544         } else {                                 1341         } else {
1545             $address_map{$name} = $address;      1342             $address_map{$name} = $address;
1546         }                                        1343         }
1547     }                                            1344     }
1548 }                                                1345 }
1549                                                  1346 
1550 sub git_execute_cmd {                            1347 sub git_execute_cmd {
1551     my ($cmd) = @_;                              1348     my ($cmd) = @_;
1552     my @lines = ();                              1349     my @lines = ();
1553                                                  1350 
1554     my $output = `$cmd`;                         1351     my $output = `$cmd`;
1555     $output =~ s/^\s*//gm;                       1352     $output =~ s/^\s*//gm;
1556     @lines = split("\n", $output);               1353     @lines = split("\n", $output);
1557                                                  1354 
1558     return @lines;                               1355     return @lines;
1559 }                                                1356 }
1560                                                  1357 
1561 sub hg_execute_cmd {                             1358 sub hg_execute_cmd {
1562     my ($cmd) = @_;                              1359     my ($cmd) = @_;
1563     my @lines = ();                              1360     my @lines = ();
1564                                                  1361 
1565     my $output = `$cmd`;                         1362     my $output = `$cmd`;
1566     @lines = split("\n", $output);               1363     @lines = split("\n", $output);
1567                                                  1364 
1568     return @lines;                               1365     return @lines;
1569 }                                                1366 }
1570                                                  1367 
1571 sub extract_formatted_signatures {               1368 sub extract_formatted_signatures {
1572     my (@signature_lines) = @_;                  1369     my (@signature_lines) = @_;
1573                                                  1370 
1574     my @type = @signature_lines;                 1371     my @type = @signature_lines;
1575                                                  1372 
1576     s/\s*(.*):.*/$1/ for (@type);                1373     s/\s*(.*):.*/$1/ for (@type);
1577                                                  1374 
1578     # cut -f2- -d":"                             1375     # cut -f2- -d":"
1579     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_li    1376     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1580                                                  1377 
1581 ## Reformat email addresses (with names) to a    1378 ## Reformat email addresses (with names) to avoid badly written signatures
1582                                                  1379 
1583     foreach my $signer (@signature_lines) {      1380     foreach my $signer (@signature_lines) {
1584         $signer = deduplicate_email($signer);    1381         $signer = deduplicate_email($signer);
1585     }                                            1382     }
1586                                                  1383 
1587     return (\@type, \@signature_lines);          1384     return (\@type, \@signature_lines);
1588 }                                                1385 }
1589                                                  1386 
1590 sub vcs_find_signers {                           1387 sub vcs_find_signers {
1591     my ($cmd, $file) = @_;                       1388     my ($cmd, $file) = @_;
1592     my $commits;                                 1389     my $commits;
1593     my @lines = ();                              1390     my @lines = ();
1594     my @signatures = ();                         1391     my @signatures = ();
1595     my @authors = ();                            1392     my @authors = ();
1596     my @stats = ();                              1393     my @stats = ();
1597                                                  1394 
1598     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd    1395     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1599                                                  1396 
1600     my $pattern = $VCS_cmds{"commit_pattern"}    1397     my $pattern = $VCS_cmds{"commit_pattern"};
1601     my $author_pattern = $VCS_cmds{"author_pa    1398     my $author_pattern = $VCS_cmds{"author_pattern"};
1602     my $stat_pattern = $VCS_cmds{"stat_patter    1399     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1603                                                  1400 
1604     $stat_pattern =~ s/(\$\w+)/$1/eeg;           1401     $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1605                                                  1402 
1606     $commits = grep(/$pattern/, @lines);         1403     $commits = grep(/$pattern/, @lines);        # of commits
1607                                                  1404 
1608     @authors = grep(/$author_pattern/, @lines    1405     @authors = grep(/$author_pattern/, @lines);
1609     @signatures = grep(/^[ \t]*${signature_pa    1406     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1610     @stats = grep(/$stat_pattern/, @lines);      1407     @stats = grep(/$stat_pattern/, @lines);
1611                                                  1408 
1612 #    print("stats: <@stats>\n");                  1409 #    print("stats: <@stats>\n");
1613                                                  1410 
1614     return (0, \@signatures, \@authors, \@sta    1411     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1615                                                  1412 
1616     save_commits_by_author(@lines) if ($inter    1413     save_commits_by_author(@lines) if ($interactive);
1617     save_commits_by_signer(@lines) if ($inter    1414     save_commits_by_signer(@lines) if ($interactive);
1618                                                  1415 
1619     if (!$email_git_penguin_chiefs) {            1416     if (!$email_git_penguin_chiefs) {
1620         @signatures = grep(!/${penguin_chiefs    1417         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1621     }                                            1418     }
1622                                                  1419 
1623     my ($author_ref, $authors_ref) = extract_    1420     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1624     my ($types_ref, $signers_ref) = extract_f    1421     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1625                                                  1422 
1626     return ($commits, $signers_ref, $authors_    1423     return ($commits, $signers_ref, $authors_ref, \@stats);
1627 }                                                1424 }
1628                                                  1425 
1629 sub vcs_find_author {                            1426 sub vcs_find_author {
1630     my ($cmd) = @_;                              1427     my ($cmd) = @_;
1631     my @lines = ();                              1428     my @lines = ();
1632                                                  1429 
1633     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd    1430     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1634                                                  1431 
1635     if (!$email_git_penguin_chiefs) {            1432     if (!$email_git_penguin_chiefs) {
1636         @lines = grep(!/${penguin_chiefs}/i,     1433         @lines = grep(!/${penguin_chiefs}/i, @lines);
1637     }                                            1434     }
1638                                                  1435 
1639     return @lines if !@lines;                    1436     return @lines if !@lines;
1640                                                  1437 
1641     my @authors = ();                            1438     my @authors = ();
1642     foreach my $line (@lines) {                  1439     foreach my $line (@lines) {
1643         if ($line =~ m/$VCS_cmds{"author_patt    1440         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1644             my $author = $1;                     1441             my $author = $1;
1645             my ($name, $address) = parse_emai    1442             my ($name, $address) = parse_email($author);
1646             $author = format_email($name, $ad    1443             $author = format_email($name, $address, 1);
1647             push(@authors, $author);             1444             push(@authors, $author);
1648         }                                        1445         }
1649     }                                            1446     }
1650                                                  1447 
1651     save_commits_by_author(@lines) if ($inter    1448     save_commits_by_author(@lines) if ($interactive);
1652     save_commits_by_signer(@lines) if ($inter    1449     save_commits_by_signer(@lines) if ($interactive);
1653                                                  1450 
1654     return @authors;                             1451     return @authors;
1655 }                                                1452 }
1656                                                  1453 
1657 sub vcs_save_commits {                           1454 sub vcs_save_commits {
1658     my ($cmd) = @_;                              1455     my ($cmd) = @_;
1659     my @lines = ();                              1456     my @lines = ();
1660     my @commits = ();                            1457     my @commits = ();
1661                                                  1458 
1662     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd    1459     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1663                                                  1460 
1664     foreach my $line (@lines) {                  1461     foreach my $line (@lines) {
1665         if ($line =~ m/$VCS_cmds{"blame_commi    1462         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1666             push(@commits, $1);                  1463             push(@commits, $1);
1667         }                                        1464         }
1668     }                                            1465     }
1669                                                  1466 
1670     return @commits;                             1467     return @commits;
1671 }                                                1468 }
1672                                                  1469 
1673 sub vcs_blame {                                  1470 sub vcs_blame {
1674     my ($file) = @_;                             1471     my ($file) = @_;
1675     my $cmd;                                     1472     my $cmd;
1676     my @commits = ();                            1473     my @commits = ();
1677                                                  1474 
1678     return @commits if (!(-f $file));            1475     return @commits if (!(-f $file));
1679                                                  1476 
1680     if (@range && $VCS_cmds{"blame_range_cmd"    1477     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1681         my @all_commits = ();                    1478         my @all_commits = ();
1682                                                  1479 
1683         $cmd = $VCS_cmds{"blame_file_cmd"};      1480         $cmd = $VCS_cmds{"blame_file_cmd"};
1684         $cmd =~ s/(\$\w+)/$1/eeg;                1481         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1685         @all_commits = vcs_save_commits($cmd)    1482         @all_commits = vcs_save_commits($cmd);
1686                                                  1483 
1687         foreach my $file_range_diff (@range)     1484         foreach my $file_range_diff (@range) {
1688             next if (!($file_range_diff =~ m/    1485             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1689             my $diff_file = $1;                  1486             my $diff_file = $1;
1690             my $diff_start = $2;                 1487             my $diff_start = $2;
1691             my $diff_length = $3;                1488             my $diff_length = $3;
1692             next if ("$file" ne "$diff_file")    1489             next if ("$file" ne "$diff_file");
1693             for (my $i = $diff_start; $i < $d    1490             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1694                 push(@commits, $all_commits[$    1491                 push(@commits, $all_commits[$i]);
1695             }                                    1492             }
1696         }                                        1493         }
1697     } elsif (@range) {                           1494     } elsif (@range) {
1698         foreach my $file_range_diff (@range)     1495         foreach my $file_range_diff (@range) {
1699             next if (!($file_range_diff =~ m/    1496             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1700             my $diff_file = $1;                  1497             my $diff_file = $1;
1701             my $diff_start = $2;                 1498             my $diff_start = $2;
1702             my $diff_length = $3;                1499             my $diff_length = $3;
1703             next if ("$file" ne "$diff_file")    1500             next if ("$file" ne "$diff_file");
1704             $cmd = $VCS_cmds{"blame_range_cmd    1501             $cmd = $VCS_cmds{"blame_range_cmd"};
1705             $cmd =~ s/(\$\w+)/$1/eeg;            1502             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1706             push(@commits, vcs_save_commits($    1503             push(@commits, vcs_save_commits($cmd));
1707         }                                        1504         }
1708     } else {                                     1505     } else {
1709         $cmd = $VCS_cmds{"blame_file_cmd"};      1506         $cmd = $VCS_cmds{"blame_file_cmd"};
1710         $cmd =~ s/(\$\w+)/$1/eeg;                1507         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1711         @commits = vcs_save_commits($cmd);       1508         @commits = vcs_save_commits($cmd);
1712     }                                            1509     }
1713                                                  1510 
1714     foreach my $commit (@commits) {              1511     foreach my $commit (@commits) {
1715         $commit =~ s/^\^//g;                     1512         $commit =~ s/^\^//g;
1716     }                                            1513     }
1717                                                  1514 
1718     return @commits;                             1515     return @commits;
1719 }                                                1516 }
1720                                                  1517 
1721 my $printed_novcs = 0;                           1518 my $printed_novcs = 0;
1722 sub vcs_exists {                                 1519 sub vcs_exists {
1723     %VCS_cmds = %VCS_cmds_git;                   1520     %VCS_cmds = %VCS_cmds_git;
1724     return 1 if eval $VCS_cmds{"available"};     1521     return 1 if eval $VCS_cmds{"available"};
1725     %VCS_cmds = %VCS_cmds_hg;                    1522     %VCS_cmds = %VCS_cmds_hg;
1726     return 2 if eval $VCS_cmds{"available"};     1523     return 2 if eval $VCS_cmds{"available"};
1727     %VCS_cmds = ();                              1524     %VCS_cmds = ();
1728     if (!$printed_novcs && $email_git) {      !! 1525     if (!$printed_novcs) {
1729         warn("$P: No supported VCS found.  Ad    1526         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1730         warn("Using a git repository produces    1527         warn("Using a git repository produces better results.\n");
1731         warn("Try Linus Torvalds' latest git     1528         warn("Try Linus Torvalds' latest git repository using:\n");
1732         warn("git clone git://git.kernel.org/    1529         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1733         $printed_novcs = 1;                      1530         $printed_novcs = 1;
1734     }                                            1531     }
1735     return 0;                                    1532     return 0;
1736 }                                                1533 }
1737                                                  1534 
1738 sub vcs_is_git {                                 1535 sub vcs_is_git {
1739     vcs_exists();                                1536     vcs_exists();
1740     return $vcs_used == 1;                       1537     return $vcs_used == 1;
1741 }                                                1538 }
1742                                                  1539 
1743 sub vcs_is_hg {                                  1540 sub vcs_is_hg {
1744     return $vcs_used == 2;                       1541     return $vcs_used == 2;
1745 }                                                1542 }
1746                                                  1543 
1747 sub vcs_add_commit_signers {                  << 
1748     return if (!vcs_exists());                << 
1749                                               << 
1750     my ($commit, $desc) = @_;                 << 
1751     my $commit_count = 0;                     << 
1752     my $commit_authors_ref;                   << 
1753     my $commit_signers_ref;                   << 
1754     my $stats_ref;                            << 
1755     my @commit_authors = ();                  << 
1756     my @commit_signers = ();                  << 
1757     my $cmd;                                  << 
1758                                               << 
1759     $cmd = $VCS_cmds{"find_commit_signers_cmd << 
1760     $cmd =~ s/(\$\w+)/$1/eeg;   #substitute v << 
1761                                               << 
1762     ($commit_count, $commit_signers_ref, $com << 
1763     @commit_authors = @{$commit_authors_ref}  << 
1764     @commit_signers = @{$commit_signers_ref}  << 
1765                                               << 
1766     foreach my $signer (@commit_signers) {    << 
1767         $signer = deduplicate_email($signer); << 
1768     }                                         << 
1769                                               << 
1770     vcs_assign($desc, 1, @commit_signers);    << 
1771 }                                             << 
1772                                               << 
1773 sub interactive_get_maintainers {                1544 sub interactive_get_maintainers {
1774     my ($list_ref) = @_;                         1545     my ($list_ref) = @_;
1775     my @list = @$list_ref;                       1546     my @list = @$list_ref;
1776                                                  1547 
1777     vcs_exists();                                1548     vcs_exists();
1778                                                  1549 
1779     my %selected;                                1550     my %selected;
1780     my %authored;                                1551     my %authored;
1781     my %signed;                                  1552     my %signed;
1782     my $count = 0;                               1553     my $count = 0;
1783     my $maintained = 0;                          1554     my $maintained = 0;
1784     foreach my $entry (@list) {                  1555     foreach my $entry (@list) {
1785         $maintained = 1 if ($entry->[1] =~ /^    1556         $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1786         $selected{$count} = 1;                   1557         $selected{$count} = 1;
1787         $authored{$count} = 0;                   1558         $authored{$count} = 0;
1788         $signed{$count} = 0;                     1559         $signed{$count} = 0;
1789         $count++;                                1560         $count++;
1790     }                                            1561     }
1791                                                  1562 
1792     #menu loop                                   1563     #menu loop
1793     my $done = 0;                                1564     my $done = 0;
1794     my $print_options = 0;                       1565     my $print_options = 0;
1795     my $redraw = 1;                              1566     my $redraw = 1;
1796     while (!$done) {                             1567     while (!$done) {
1797         $count = 0;                              1568         $count = 0;
1798         if ($redraw) {                           1569         if ($redraw) {
1799             printf STDERR "\n%1s %2s %-65s",     1570             printf STDERR "\n%1s %2s %-65s",
1800                           "*", "#", "email/li    1571                           "*", "#", "email/list and role:stats";
1801             if ($email_git ||                    1572             if ($email_git ||
1802                 ($email_git_fallback && !$mai    1573                 ($email_git_fallback && !$maintained) ||
1803                 $email_git_blame) {              1574                 $email_git_blame) {
1804                 print STDERR "auth sign";        1575                 print STDERR "auth sign";
1805             }                                    1576             }
1806             print STDERR "\n";                   1577             print STDERR "\n";
1807             foreach my $entry (@list) {          1578             foreach my $entry (@list) {
1808                 my $email = $entry->[0];         1579                 my $email = $entry->[0];
1809                 my $role = $entry->[1];          1580                 my $role = $entry->[1];
1810                 my $sel = "";                    1581                 my $sel = "";
1811                 $sel = "*" if ($selected{$cou    1582                 $sel = "*" if ($selected{$count});
1812                 my $commit_author = $commit_a    1583                 my $commit_author = $commit_author_hash{$email};
1813                 my $commit_signer = $commit_s    1584                 my $commit_signer = $commit_signer_hash{$email};
1814                 my $authored = 0;                1585                 my $authored = 0;
1815                 my $signed = 0;                  1586                 my $signed = 0;
1816                 $authored++ for (@{$commit_au    1587                 $authored++ for (@{$commit_author});
1817                 $signed++ for (@{$commit_sign    1588                 $signed++ for (@{$commit_signer});
1818                 printf STDERR "%1s %2d %-65s"    1589                 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1819                 printf STDERR "%4d %4d", $aut    1590                 printf STDERR "%4d %4d", $authored, $signed
1820                     if ($authored > 0 || $sig    1591                     if ($authored > 0 || $signed > 0);
1821                 printf STDERR "\n     %s\n",     1592                 printf STDERR "\n     %s\n", $role;
1822                 if ($authored{$count}) {         1593                 if ($authored{$count}) {
1823                     my $commit_author = $comm    1594                     my $commit_author = $commit_author_hash{$email};
1824                     foreach my $ref (@{$commi    1595                     foreach my $ref (@{$commit_author}) {
1825                         print STDERR "     Au    1596                         print STDERR "     Author: @{$ref}[1]\n";
1826                     }                            1597                     }
1827                 }                                1598                 }
1828                 if ($signed{$count}) {           1599                 if ($signed{$count}) {
1829                     my $commit_signer = $comm    1600                     my $commit_signer = $commit_signer_hash{$email};
1830                     foreach my $ref (@{$commi    1601                     foreach my $ref (@{$commit_signer}) {
1831                         print STDERR "     @{    1602                         print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1832                     }                            1603                     }
1833                 }                                1604                 }
1834                                                  1605 
1835                 $count++;                        1606                 $count++;
1836             }                                    1607             }
1837         }                                        1608         }
1838         my $date_ref = \$email_git_since;        1609         my $date_ref = \$email_git_since;
1839         $date_ref = \$email_hg_since if (vcs_    1610         $date_ref = \$email_hg_since if (vcs_is_hg());
1840         if ($print_options) {                    1611         if ($print_options) {
1841             $print_options = 0;                  1612             $print_options = 0;
1842             if (vcs_exists()) {                  1613             if (vcs_exists()) {
1843                 print STDERR <<EOT               1614                 print STDERR <<EOT
1844                                                  1615 
1845 Version Control options:                         1616 Version Control options:
1846 g  use git history      [$email_git]             1617 g  use git history      [$email_git]
1847 gf use git-fallback     [$email_git_fallback]    1618 gf use git-fallback     [$email_git_fallback]
1848 b  use git blame        [$email_git_blame]       1619 b  use git blame        [$email_git_blame]
1849 bs use blame signatures [$email_git_blame_sig    1620 bs use blame signatures [$email_git_blame_signatures]
1850 c# minimum commits      [$email_git_min_signa    1621 c# minimum commits      [$email_git_min_signatures]
1851 %# min percent          [$email_git_min_perce    1622 %# min percent          [$email_git_min_percent]
1852 d# history to use       [$$date_ref]             1623 d# history to use       [$$date_ref]
1853 x# max maintainers      [$email_git_max_maint    1624 x# max maintainers      [$email_git_max_maintainers]
1854 t  all signature types  [$email_git_all_signa    1625 t  all signature types  [$email_git_all_signature_types]
1855 m  use .mailmap         [$email_use_mailmap]     1626 m  use .mailmap         [$email_use_mailmap]
1856 EOT                                              1627 EOT
1857             }                                    1628             }
1858             print STDERR <<EOT                   1629             print STDERR <<EOT
1859                                                  1630 
1860 Additional options:                              1631 Additional options:
1861 0  toggle all                                    1632 0  toggle all
1862 tm toggle maintainers                            1633 tm toggle maintainers
1863 tg toggle git entries                            1634 tg toggle git entries
1864 tl toggle open list entries                      1635 tl toggle open list entries
1865 ts toggle subscriber list entries                1636 ts toggle subscriber list entries
1866 f  emails in file       [$email_file_emails]  !! 1637 f  emails in file       [$file_emails]
1867 k  keywords in file     [$keywords]              1638 k  keywords in file     [$keywords]
1868 r  remove duplicates    [$email_remove_duplic    1639 r  remove duplicates    [$email_remove_duplicates]
1869 p# pattern match depth  [$pattern_depth]         1640 p# pattern match depth  [$pattern_depth]
1870 EOT                                              1641 EOT
1871         }                                        1642         }
1872         print STDERR                             1643         print STDERR
1873 "\n#(toggle), A#(author), S#(signed) *(all),     1644 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1874                                                  1645 
1875         my $input = <STDIN>;                     1646         my $input = <STDIN>;
1876         chomp($input);                           1647         chomp($input);
1877                                                  1648 
1878         $redraw = 1;                             1649         $redraw = 1;
1879         my $rerun = 0;                           1650         my $rerun = 0;
1880         my @wish = split(/[, ]+/, $input);       1651         my @wish = split(/[, ]+/, $input);
1881         foreach my $nr (@wish) {                 1652         foreach my $nr (@wish) {
1882             $nr = lc($nr);                       1653             $nr = lc($nr);
1883             my $sel = substr($nr, 0, 1);         1654             my $sel = substr($nr, 0, 1);
1884             my $str = substr($nr, 1);            1655             my $str = substr($nr, 1);
1885             my $val = 0;                         1656             my $val = 0;
1886             $val = $1 if $str =~ /^(\d+)$/;      1657             $val = $1 if $str =~ /^(\d+)$/;
1887                                                  1658 
1888             if ($sel eq "y") {                   1659             if ($sel eq "y") {
1889                 $interactive = 0;                1660                 $interactive = 0;
1890                 $done = 1;                       1661                 $done = 1;
1891                 $output_rolestats = 0;           1662                 $output_rolestats = 0;
1892                 $output_roles = 0;               1663                 $output_roles = 0;
1893                 last;                            1664                 last;
1894             } elsif ($nr =~ /^\d+$/ && $nr >     1665             } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1895                 $selected{$nr - 1} = !$select    1666                 $selected{$nr - 1} = !$selected{$nr - 1};
1896             } elsif ($sel eq "*" || $sel eq '    1667             } elsif ($sel eq "*" || $sel eq '^') {
1897                 my $toggle = 0;                  1668                 my $toggle = 0;
1898                 $toggle = 1 if ($sel eq '*');    1669                 $toggle = 1 if ($sel eq '*');
1899                 for (my $i = 0; $i < $count;     1670                 for (my $i = 0; $i < $count; $i++) {
1900                     $selected{$i} = $toggle;     1671                     $selected{$i} = $toggle;
1901                 }                                1672                 }
1902             } elsif ($sel eq "0") {              1673             } elsif ($sel eq "0") {
1903                 for (my $i = 0; $i < $count;     1674                 for (my $i = 0; $i < $count; $i++) {
1904                     $selected{$i} = !$selecte    1675                     $selected{$i} = !$selected{$i};
1905                 }                                1676                 }
1906             } elsif ($sel eq "t") {              1677             } elsif ($sel eq "t") {
1907                 if (lc($str) eq "m") {           1678                 if (lc($str) eq "m") {
1908                     for (my $i = 0; $i < $cou    1679                     for (my $i = 0; $i < $count; $i++) {
1909                         $selected{$i} = !$sel    1680                         $selected{$i} = !$selected{$i}
1910                             if ($list[$i]->[1    1681                             if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1911                     }                            1682                     }
1912                 } elsif (lc($str) eq "g") {      1683                 } elsif (lc($str) eq "g") {
1913                     for (my $i = 0; $i < $cou    1684                     for (my $i = 0; $i < $count; $i++) {
1914                         $selected{$i} = !$sel    1685                         $selected{$i} = !$selected{$i}
1915                             if ($list[$i]->[1    1686                             if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1916                     }                            1687                     }
1917                 } elsif (lc($str) eq "l") {      1688                 } elsif (lc($str) eq "l") {
1918                     for (my $i = 0; $i < $cou    1689                     for (my $i = 0; $i < $count; $i++) {
1919                         $selected{$i} = !$sel    1690                         $selected{$i} = !$selected{$i}
1920                             if ($list[$i]->[1    1691                             if ($list[$i]->[1] =~ /^(open list)/i);
1921                     }                            1692                     }
1922                 } elsif (lc($str) eq "s") {      1693                 } elsif (lc($str) eq "s") {
1923                     for (my $i = 0; $i < $cou    1694                     for (my $i = 0; $i < $count; $i++) {
1924                         $selected{$i} = !$sel    1695                         $selected{$i} = !$selected{$i}
1925                             if ($list[$i]->[1    1696                             if ($list[$i]->[1] =~ /^(subscriber list)/i);
1926                     }                            1697                     }
1927                 }                                1698                 }
1928             } elsif ($sel eq "a") {              1699             } elsif ($sel eq "a") {
1929                 if ($val > 0 && $val <= $coun    1700                 if ($val > 0 && $val <= $count) {
1930                     $authored{$val - 1} = !$a    1701                     $authored{$val - 1} = !$authored{$val - 1};
1931                 } elsif ($str eq '*' || $str     1702                 } elsif ($str eq '*' || $str eq '^') {
1932                     my $toggle = 0;              1703                     my $toggle = 0;
1933                     $toggle = 1 if ($str eq '    1704                     $toggle = 1 if ($str eq '*');
1934                     for (my $i = 0; $i < $cou    1705                     for (my $i = 0; $i < $count; $i++) {
1935                         $authored{$i} = $togg    1706                         $authored{$i} = $toggle;
1936                     }                            1707                     }
1937                 }                                1708                 }
1938             } elsif ($sel eq "s") {              1709             } elsif ($sel eq "s") {
1939                 if ($val > 0 && $val <= $coun    1710                 if ($val > 0 && $val <= $count) {
1940                     $signed{$val - 1} = !$sig    1711                     $signed{$val - 1} = !$signed{$val - 1};
1941                 } elsif ($str eq '*' || $str     1712                 } elsif ($str eq '*' || $str eq '^') {
1942                     my $toggle = 0;              1713                     my $toggle = 0;
1943                     $toggle = 1 if ($str eq '    1714                     $toggle = 1 if ($str eq '*');
1944                     for (my $i = 0; $i < $cou    1715                     for (my $i = 0; $i < $count; $i++) {
1945                         $signed{$i} = $toggle    1716                         $signed{$i} = $toggle;
1946                     }                            1717                     }
1947                 }                                1718                 }
1948             } elsif ($sel eq "o") {              1719             } elsif ($sel eq "o") {
1949                 $print_options = 1;              1720                 $print_options = 1;
1950                 $redraw = 1;                     1721                 $redraw = 1;
1951             } elsif ($sel eq "g") {              1722             } elsif ($sel eq "g") {
1952                 if ($str eq "f") {               1723                 if ($str eq "f") {
1953                     bool_invert(\$email_git_f    1724                     bool_invert(\$email_git_fallback);
1954                 } else {                         1725                 } else {
1955                     bool_invert(\$email_git);    1726                     bool_invert(\$email_git);
1956                 }                                1727                 }
1957                 $rerun = 1;                      1728                 $rerun = 1;
1958             } elsif ($sel eq "b") {              1729             } elsif ($sel eq "b") {
1959                 if ($str eq "s") {               1730                 if ($str eq "s") {
1960                     bool_invert(\$email_git_b    1731                     bool_invert(\$email_git_blame_signatures);
1961                 } else {                         1732                 } else {
1962                     bool_invert(\$email_git_b    1733                     bool_invert(\$email_git_blame);
1963                 }                                1734                 }
1964                 $rerun = 1;                      1735                 $rerun = 1;
1965             } elsif ($sel eq "c") {              1736             } elsif ($sel eq "c") {
1966                 if ($val > 0) {                  1737                 if ($val > 0) {
1967                     $email_git_min_signatures    1738                     $email_git_min_signatures = $val;
1968                     $rerun = 1;                  1739                     $rerun = 1;
1969                 }                                1740                 }
1970             } elsif ($sel eq "x") {              1741             } elsif ($sel eq "x") {
1971                 if ($val > 0) {                  1742                 if ($val > 0) {
1972                     $email_git_max_maintainer    1743                     $email_git_max_maintainers = $val;
1973                     $rerun = 1;                  1744                     $rerun = 1;
1974                 }                                1745                 }
1975             } elsif ($sel eq "%") {              1746             } elsif ($sel eq "%") {
1976                 if ($str ne "" && $val >= 0)     1747                 if ($str ne "" && $val >= 0) {
1977                     $email_git_min_percent =     1748                     $email_git_min_percent = $val;
1978                     $rerun = 1;                  1749                     $rerun = 1;
1979                 }                                1750                 }
1980             } elsif ($sel eq "d") {              1751             } elsif ($sel eq "d") {
1981                 if (vcs_is_git()) {              1752                 if (vcs_is_git()) {
1982                     $email_git_since = $str;     1753                     $email_git_since = $str;
1983                 } elsif (vcs_is_hg()) {          1754                 } elsif (vcs_is_hg()) {
1984                     $email_hg_since = $str;      1755                     $email_hg_since = $str;
1985                 }                                1756                 }
1986                 $rerun = 1;                      1757                 $rerun = 1;
1987             } elsif ($sel eq "t") {              1758             } elsif ($sel eq "t") {
1988                 bool_invert(\$email_git_all_s    1759                 bool_invert(\$email_git_all_signature_types);
1989                 $rerun = 1;                      1760                 $rerun = 1;
1990             } elsif ($sel eq "f") {              1761             } elsif ($sel eq "f") {
1991                 bool_invert(\$email_file_emai !! 1762                 bool_invert(\$file_emails);
1992                 $rerun = 1;                      1763                 $rerun = 1;
1993             } elsif ($sel eq "r") {              1764             } elsif ($sel eq "r") {
1994                 bool_invert(\$email_remove_du    1765                 bool_invert(\$email_remove_duplicates);
1995                 $rerun = 1;                      1766                 $rerun = 1;
1996             } elsif ($sel eq "m") {              1767             } elsif ($sel eq "m") {
1997                 bool_invert(\$email_use_mailm    1768                 bool_invert(\$email_use_mailmap);
1998                 read_mailmap();                  1769                 read_mailmap();
1999                 $rerun = 1;                      1770                 $rerun = 1;
2000             } elsif ($sel eq "k") {              1771             } elsif ($sel eq "k") {
2001                 bool_invert(\$keywords);         1772                 bool_invert(\$keywords);
2002                 $rerun = 1;                      1773                 $rerun = 1;
2003             } elsif ($sel eq "p") {              1774             } elsif ($sel eq "p") {
2004                 if ($str ne "" && $val >= 0)     1775                 if ($str ne "" && $val >= 0) {
2005                     $pattern_depth = $val;       1776                     $pattern_depth = $val;
2006                     $rerun = 1;                  1777                     $rerun = 1;
2007                 }                                1778                 }
2008             } elsif ($sel eq "h" || $sel eq "    1779             } elsif ($sel eq "h" || $sel eq "?") {
2009                 print STDERR <<EOT               1780                 print STDERR <<EOT
2010                                                  1781 
2011 Interactive mode allows you to select the var    1782 Interactive mode allows you to select the various maintainers, submitters,
2012 commit signers and mailing lists that could b    1783 commit signers and mailing lists that could be CC'd on a patch.
2013                                                  1784 
2014 Any *'d entry is selected.                       1785 Any *'d entry is selected.
2015                                                  1786 
2016 If you have git or hg installed, you can choo    1787 If you have git or hg installed, you can choose to summarize the commit
2017 history of files in the patch.  Also, each li    1788 history of files in the patch.  Also, each line of the current file can
2018 be matched to its commit author and that comm    1789 be matched to its commit author and that commits signers with blame.
2019                                                  1790 
2020 Various knobs exist to control the length of     1791 Various knobs exist to control the length of time for active commit
2021 tracking, the maximum number of commit author    1792 tracking, the maximum number of commit authors and signers to add,
2022 and such.                                        1793 and such.
2023                                                  1794 
2024 Enter selections at the prompt until you are     1795 Enter selections at the prompt until you are satisfied that the selected
2025 maintainers are appropriate.  You may enter m    1796 maintainers are appropriate.  You may enter multiple selections separated
2026 by either commas or spaces.                      1797 by either commas or spaces.
2027                                                  1798 
2028 EOT                                              1799 EOT
2029             } else {                             1800             } else {
2030                 print STDERR "invalid option:    1801                 print STDERR "invalid option: '$nr'\n";
2031                 $redraw = 0;                     1802                 $redraw = 0;
2032             }                                    1803             }
2033         }                                        1804         }
2034         if ($rerun) {                            1805         if ($rerun) {
2035             print STDERR "git-blame can be ve    1806             print STDERR "git-blame can be very slow, please have patience..."
2036                 if ($email_git_blame);           1807                 if ($email_git_blame);
2037             goto &get_maintainers;               1808             goto &get_maintainers;
2038         }                                        1809         }
2039     }                                            1810     }
2040                                                  1811 
2041     #drop not selected entries                   1812     #drop not selected entries
2042     $count = 0;                                  1813     $count = 0;
2043     my @new_emailto = ();                        1814     my @new_emailto = ();
2044     foreach my $entry (@list) {                  1815     foreach my $entry (@list) {
2045         if ($selected{$count}) {                 1816         if ($selected{$count}) {
2046             push(@new_emailto, $list[$count])    1817             push(@new_emailto, $list[$count]);
2047         }                                        1818         }
2048         $count++;                                1819         $count++;
2049     }                                            1820     }
2050     return @new_emailto;                         1821     return @new_emailto;
2051 }                                                1822 }
2052                                                  1823 
2053 sub bool_invert {                                1824 sub bool_invert {
2054     my ($bool_ref) = @_;                         1825     my ($bool_ref) = @_;
2055                                                  1826 
2056     if ($$bool_ref) {                            1827     if ($$bool_ref) {
2057         $$bool_ref = 0;                          1828         $$bool_ref = 0;
2058     } else {                                     1829     } else {
2059         $$bool_ref = 1;                          1830         $$bool_ref = 1;
2060     }                                            1831     }
2061 }                                                1832 }
2062                                                  1833 
2063 sub deduplicate_email {                          1834 sub deduplicate_email {
2064     my ($email) = @_;                            1835     my ($email) = @_;
2065                                                  1836 
2066     my $matched = 0;                             1837     my $matched = 0;
2067     my ($name, $address) = parse_email($email    1838     my ($name, $address) = parse_email($email);
2068     $email = format_email($name, $address, 1)    1839     $email = format_email($name, $address, 1);
2069     $email = mailmap_email($email);              1840     $email = mailmap_email($email);
2070                                                  1841 
2071     return $email if (!$email_remove_duplicat    1842     return $email if (!$email_remove_duplicates);
2072                                                  1843 
2073     ($name, $address) = parse_email($email);     1844     ($name, $address) = parse_email($email);
2074                                                  1845 
2075     if ($name ne "" && $deduplicate_name_hash    1846     if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
2076         $name = $deduplicate_name_hash{lc($na    1847         $name = $deduplicate_name_hash{lc($name)}->[0];
2077         $address = $deduplicate_name_hash{lc(    1848         $address = $deduplicate_name_hash{lc($name)}->[1];
2078         $matched = 1;                            1849         $matched = 1;
2079     } elsif ($deduplicate_address_hash{lc($ad    1850     } elsif ($deduplicate_address_hash{lc($address)}) {
2080         $name = $deduplicate_address_hash{lc(    1851         $name = $deduplicate_address_hash{lc($address)}->[0];
2081         $address = $deduplicate_address_hash{    1852         $address = $deduplicate_address_hash{lc($address)}->[1];
2082         $matched = 1;                            1853         $matched = 1;
2083     }                                            1854     }
2084     if (!$matched) {                             1855     if (!$matched) {
2085         $deduplicate_name_hash{lc($name)} = [    1856         $deduplicate_name_hash{lc($name)} = [ $name, $address ];
2086         $deduplicate_address_hash{lc($address    1857         $deduplicate_address_hash{lc($address)} = [ $name, $address ];
2087     }                                            1858     }
2088     $email = format_email($name, $address, 1)    1859     $email = format_email($name, $address, 1);
2089     $email = mailmap_email($email);              1860     $email = mailmap_email($email);
2090     return $email;                               1861     return $email;
2091 }                                                1862 }
2092                                                  1863 
2093 sub save_commits_by_author {                     1864 sub save_commits_by_author {
2094     my (@lines) = @_;                            1865     my (@lines) = @_;
2095                                                  1866 
2096     my @authors = ();                            1867     my @authors = ();
2097     my @commits = ();                            1868     my @commits = ();
2098     my @subjects = ();                           1869     my @subjects = ();
2099                                                  1870 
2100     foreach my $line (@lines) {                  1871     foreach my $line (@lines) {
2101         if ($line =~ m/$VCS_cmds{"author_patt    1872         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2102             my $author = $1;                     1873             my $author = $1;
2103             $author = deduplicate_email($auth    1874             $author = deduplicate_email($author);
2104             push(@authors, $author);             1875             push(@authors, $author);
2105         }                                        1876         }
2106         push(@commits, $1) if ($line =~ m/$VC    1877         push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2107         push(@subjects, $1) if ($line =~ m/$V    1878         push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2108     }                                            1879     }
2109                                                  1880 
2110     for (my $i = 0; $i < @authors; $i++) {       1881     for (my $i = 0; $i < @authors; $i++) {
2111         my $exists = 0;                          1882         my $exists = 0;
2112         foreach my $ref(@{$commit_author_hash    1883         foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
2113             if (@{$ref}[0] eq $commits[$i] &&    1884             if (@{$ref}[0] eq $commits[$i] &&
2114                 @{$ref}[1] eq $subjects[$i])     1885                 @{$ref}[1] eq $subjects[$i]) {
2115                 $exists = 1;                     1886                 $exists = 1;
2116                 last;                            1887                 last;
2117             }                                    1888             }
2118         }                                        1889         }
2119         if (!$exists) {                          1890         if (!$exists) {
2120             push(@{$commit_author_hash{$autho    1891             push(@{$commit_author_hash{$authors[$i]}},
2121                  [ ($commits[$i], $subjects[$    1892                  [ ($commits[$i], $subjects[$i]) ]);
2122         }                                        1893         }
2123     }                                            1894     }
2124 }                                                1895 }
2125                                                  1896 
2126 sub save_commits_by_signer {                     1897 sub save_commits_by_signer {
2127     my (@lines) = @_;                            1898     my (@lines) = @_;
2128                                                  1899 
2129     my $commit = "";                             1900     my $commit = "";
2130     my $subject = "";                            1901     my $subject = "";
2131                                                  1902 
2132     foreach my $line (@lines) {                  1903     foreach my $line (@lines) {
2133         $commit = $1 if ($line =~ m/$VCS_cmds    1904         $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2134         $subject = $1 if ($line =~ m/$VCS_cmd    1905         $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2135         if ($line =~ /^[ \t]*${signature_patt    1906         if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
2136             my @signatures = ($line);            1907             my @signatures = ($line);
2137             my ($types_ref, $signers_ref) = e    1908             my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
2138             my @types = @$types_ref;             1909             my @types = @$types_ref;
2139             my @signers = @$signers_ref;         1910             my @signers = @$signers_ref;
2140                                                  1911 
2141             my $type = $types[0];                1912             my $type = $types[0];
2142             my $signer = $signers[0];            1913             my $signer = $signers[0];
2143                                                  1914 
2144             $signer = deduplicate_email($sign    1915             $signer = deduplicate_email($signer);
2145                                                  1916 
2146             my $exists = 0;                      1917             my $exists = 0;
2147             foreach my $ref(@{$commit_signer_    1918             foreach my $ref(@{$commit_signer_hash{$signer}}) {
2148                 if (@{$ref}[0] eq $commit &&     1919                 if (@{$ref}[0] eq $commit &&
2149                     @{$ref}[1] eq $subject &&    1920                     @{$ref}[1] eq $subject &&
2150                     @{$ref}[2] eq $type) {       1921                     @{$ref}[2] eq $type) {
2151                     $exists = 1;                 1922                     $exists = 1;
2152                     last;                        1923                     last;
2153                 }                                1924                 }
2154             }                                    1925             }
2155             if (!$exists) {                      1926             if (!$exists) {
2156                 push(@{$commit_signer_hash{$s    1927                 push(@{$commit_signer_hash{$signer}},
2157                      [ ($commit, $subject, $t    1928                      [ ($commit, $subject, $type) ]);
2158             }                                    1929             }
2159         }                                        1930         }
2160     }                                            1931     }
2161 }                                                1932 }
2162                                                  1933 
2163 sub vcs_assign {                                 1934 sub vcs_assign {
2164     my ($role, $divisor, @lines) = @_;           1935     my ($role, $divisor, @lines) = @_;
2165                                                  1936 
2166     my %hash;                                    1937     my %hash;
2167     my $count = 0;                               1938     my $count = 0;
2168                                                  1939 
2169     return if (@lines <= 0);                     1940     return if (@lines <= 0);
2170                                                  1941 
2171     if ($divisor <= 0) {                         1942     if ($divisor <= 0) {
2172         warn("Bad divisor in " . (caller(0))[    1943         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
2173         $divisor = 1;                            1944         $divisor = 1;
2174     }                                            1945     }
2175                                                  1946 
2176     @lines = mailmap(@lines);                    1947     @lines = mailmap(@lines);
2177                                                  1948 
2178     return if (@lines <= 0);                     1949     return if (@lines <= 0);
2179                                                  1950 
2180     @lines = sort(@lines);                       1951     @lines = sort(@lines);
2181                                                  1952 
2182     # uniq -c                                    1953     # uniq -c
2183     $hash{$_}++ for @lines;                      1954     $hash{$_}++ for @lines;
2184                                                  1955 
2185     # sort -rn                                   1956     # sort -rn
2186     foreach my $line (sort {$hash{$b} <=> $ha    1957     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
2187         my $sign_offs = $hash{$line};            1958         my $sign_offs = $hash{$line};
2188         my $percent = $sign_offs * 100 / $div    1959         my $percent = $sign_offs * 100 / $divisor;
2189                                                  1960 
2190         $percent = 100 if ($percent > 100);      1961         $percent = 100 if ($percent > 100);
2191         next if (ignore_email_address($line))    1962         next if (ignore_email_address($line));
2192         $count++;                                1963         $count++;
2193         last if ($sign_offs < $email_git_min_    1964         last if ($sign_offs < $email_git_min_signatures ||
2194                  $count > $email_git_max_main    1965                  $count > $email_git_max_maintainers ||
2195                  $percent < $email_git_min_pe    1966                  $percent < $email_git_min_percent);
2196         push_email_address($line, '');           1967         push_email_address($line, '');
2197         if ($output_rolestats) {                 1968         if ($output_rolestats) {
2198             my $fmt_percent = sprintf("%.0f",    1969             my $fmt_percent = sprintf("%.0f", $percent);
2199             add_role($line, "$role:$sign_offs    1970             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
2200         } else {                                 1971         } else {
2201             add_role($line, $role);              1972             add_role($line, $role);
2202         }                                        1973         }
2203     }                                            1974     }
2204 }                                                1975 }
2205                                                  1976 
2206 sub vcs_file_signoffs {                          1977 sub vcs_file_signoffs {
2207     my ($file) = @_;                             1978     my ($file) = @_;
2208                                                  1979 
2209     my $authors_ref;                             1980     my $authors_ref;
2210     my $signers_ref;                             1981     my $signers_ref;
2211     my $stats_ref;                               1982     my $stats_ref;
2212     my @authors = ();                            1983     my @authors = ();
2213     my @signers = ();                            1984     my @signers = ();
2214     my @stats = ();                              1985     my @stats = ();
2215     my $commits;                                 1986     my $commits;
2216                                                  1987 
2217     $vcs_used = vcs_exists();                    1988     $vcs_used = vcs_exists();
2218     return if (!$vcs_used);                      1989     return if (!$vcs_used);
2219                                                  1990 
2220     my $cmd = $VCS_cmds{"find_signers_cmd"};     1991     my $cmd = $VCS_cmds{"find_signers_cmd"};
2221     $cmd =~ s/(\$\w+)/$1/eeg;           # int    1992     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2222                                                  1993 
2223     ($commits, $signers_ref, $authors_ref, $s    1994     ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2224                                                  1995 
2225     @signers = @{$signers_ref} if defined $si    1996     @signers = @{$signers_ref} if defined $signers_ref;
2226     @authors = @{$authors_ref} if defined $au    1997     @authors = @{$authors_ref} if defined $authors_ref;
2227     @stats = @{$stats_ref} if defined $stats_    1998     @stats = @{$stats_ref} if defined $stats_ref;
2228                                                  1999 
2229 #    print("commits: <$commits>\nsigners:<@sig    2000 #    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
2230                                                  2001 
2231     foreach my $signer (@signers) {              2002     foreach my $signer (@signers) {
2232         $signer = deduplicate_email($signer);    2003         $signer = deduplicate_email($signer);
2233     }                                            2004     }
2234                                                  2005 
2235     vcs_assign("commit_signer", $commits, @si    2006     vcs_assign("commit_signer", $commits, @signers);
2236     vcs_assign("authored", $commits, @authors    2007     vcs_assign("authored", $commits, @authors);
2237     if ($#authors == $#stats) {                  2008     if ($#authors == $#stats) {
2238         my $stat_pattern = $VCS_cmds{"stat_pa    2009         my $stat_pattern = $VCS_cmds{"stat_pattern"};
2239         $stat_pattern =~ s/(\$\w+)/$1/eeg;       2010         $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
2240                                                  2011 
2241         my $added = 0;                           2012         my $added = 0;
2242         my $deleted = 0;                         2013         my $deleted = 0;
2243         for (my $i = 0; $i <= $#stats; $i++)     2014         for (my $i = 0; $i <= $#stats; $i++) {
2244             if ($stats[$i] =~ /$stat_pattern/    2015             if ($stats[$i] =~ /$stat_pattern/) {
2245                 $added += $1;                    2016                 $added += $1;
2246                 $deleted += $2;                  2017                 $deleted += $2;
2247             }                                    2018             }
2248         }                                        2019         }
2249         my @tmp_authors = uniq(@authors);        2020         my @tmp_authors = uniq(@authors);
2250         foreach my $author (@tmp_authors) {      2021         foreach my $author (@tmp_authors) {
2251             $author = deduplicate_email($auth    2022             $author = deduplicate_email($author);
2252         }                                        2023         }
2253         @tmp_authors = uniq(@tmp_authors);       2024         @tmp_authors = uniq(@tmp_authors);
2254         my @list_added = ();                     2025         my @list_added = ();
2255         my @list_deleted = ();                   2026         my @list_deleted = ();
2256         foreach my $author (@tmp_authors) {      2027         foreach my $author (@tmp_authors) {
2257             my $auth_added = 0;                  2028             my $auth_added = 0;
2258             my $auth_deleted = 0;                2029             my $auth_deleted = 0;
2259             for (my $i = 0; $i <= $#stats; $i    2030             for (my $i = 0; $i <= $#stats; $i++) {
2260                 if ($author eq deduplicate_em    2031                 if ($author eq deduplicate_email($authors[$i]) &&
2261                     $stats[$i] =~ /$stat_patt    2032                     $stats[$i] =~ /$stat_pattern/) {
2262                     $auth_added += $1;           2033                     $auth_added += $1;
2263                     $auth_deleted += $2;         2034                     $auth_deleted += $2;
2264                 }                                2035                 }
2265             }                                    2036             }
2266             for (my $i = 0; $i < $auth_added;    2037             for (my $i = 0; $i < $auth_added; $i++) {
2267                 push(@list_added, $author);      2038                 push(@list_added, $author);
2268             }                                    2039             }
2269             for (my $i = 0; $i < $auth_delete    2040             for (my $i = 0; $i < $auth_deleted; $i++) {
2270                 push(@list_deleted, $author);    2041                 push(@list_deleted, $author);
2271             }                                    2042             }
2272         }                                        2043         }
2273         vcs_assign("added_lines", $added, @li    2044         vcs_assign("added_lines", $added, @list_added);
2274         vcs_assign("removed_lines", $deleted,    2045         vcs_assign("removed_lines", $deleted, @list_deleted);
2275     }                                            2046     }
2276 }                                                2047 }
2277                                                  2048 
2278 sub vcs_file_blame {                             2049 sub vcs_file_blame {
2279     my ($file) = @_;                             2050     my ($file) = @_;
2280                                                  2051 
2281     my @signers = ();                            2052     my @signers = ();
2282     my @all_commits = ();                        2053     my @all_commits = ();
2283     my @commits = ();                            2054     my @commits = ();
2284     my $total_commits;                           2055     my $total_commits;
2285     my $total_lines;                             2056     my $total_lines;
2286                                                  2057 
2287     $vcs_used = vcs_exists();                    2058     $vcs_used = vcs_exists();
2288     return if (!$vcs_used);                      2059     return if (!$vcs_used);
2289                                                  2060 
2290     @all_commits = vcs_blame($file);             2061     @all_commits = vcs_blame($file);
2291     @commits = uniq(@all_commits);               2062     @commits = uniq(@all_commits);
2292     $total_commits = @commits;                   2063     $total_commits = @commits;
2293     $total_lines = @all_commits;                 2064     $total_lines = @all_commits;
2294                                                  2065 
2295     if ($email_git_blame_signatures) {           2066     if ($email_git_blame_signatures) {
2296         if (vcs_is_hg()) {                       2067         if (vcs_is_hg()) {
2297             my $commit_count;                    2068             my $commit_count;
2298             my $commit_authors_ref;              2069             my $commit_authors_ref;
2299             my $commit_signers_ref;              2070             my $commit_signers_ref;
2300             my $stats_ref;                       2071             my $stats_ref;
2301             my @commit_authors = ();             2072             my @commit_authors = ();
2302             my @commit_signers = ();             2073             my @commit_signers = ();
2303             my $commit = join(" -r ", @commit    2074             my $commit = join(" -r ", @commits);
2304             my $cmd;                             2075             my $cmd;
2305                                                  2076 
2306             $cmd = $VCS_cmds{"find_commit_sig    2077             $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2307             $cmd =~ s/(\$\w+)/$1/eeg;   #subs    2078             $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2308                                                  2079 
2309             ($commit_count, $commit_signers_r    2080             ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2310             @commit_authors = @{$commit_autho    2081             @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2311             @commit_signers = @{$commit_signe    2082             @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2312                                                  2083 
2313             push(@signers, @commit_signers);     2084             push(@signers, @commit_signers);
2314         } else {                                 2085         } else {
2315             foreach my $commit (@commits) {      2086             foreach my $commit (@commits) {
2316                 my $commit_count;                2087                 my $commit_count;
2317                 my $commit_authors_ref;          2088                 my $commit_authors_ref;
2318                 my $commit_signers_ref;          2089                 my $commit_signers_ref;
2319                 my $stats_ref;                   2090                 my $stats_ref;
2320                 my @commit_authors = ();         2091                 my @commit_authors = ();
2321                 my @commit_signers = ();         2092                 my @commit_signers = ();
2322                 my $cmd;                         2093                 my $cmd;
2323                                                  2094 
2324                 $cmd = $VCS_cmds{"find_commit    2095                 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2325                 $cmd =~ s/(\$\w+)/$1/eeg;        2096                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2326                                                  2097 
2327                 ($commit_count, $commit_signe    2098                 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2328                 @commit_authors = @{$commit_a    2099                 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2329                 @commit_signers = @{$commit_s    2100                 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2330                                                  2101 
2331                 push(@signers, @commit_signer    2102                 push(@signers, @commit_signers);
2332             }                                    2103             }
2333         }                                        2104         }
2334     }                                            2105     }
2335                                                  2106 
2336     if ($from_filename) {                        2107     if ($from_filename) {
2337         if ($output_rolestats) {                 2108         if ($output_rolestats) {
2338             my @blame_signers;                   2109             my @blame_signers;
2339             if (vcs_is_hg()) {{         # Dou    2110             if (vcs_is_hg()) {{         # Double brace for last exit
2340                 my $commit_count;                2111                 my $commit_count;
2341                 my @commit_signers = ();         2112                 my @commit_signers = ();
2342                 @commits = uniq(@commits);       2113                 @commits = uniq(@commits);
2343                 @commits = sort(@commits);       2114                 @commits = sort(@commits);
2344                 my $commit = join(" -r ", @co    2115                 my $commit = join(" -r ", @commits);
2345                 my $cmd;                         2116                 my $cmd;
2346                                                  2117 
2347                 $cmd = $VCS_cmds{"find_commit    2118                 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2348                 $cmd =~ s/(\$\w+)/$1/eeg;        2119                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2349                                                  2120 
2350                 my @lines = ();                  2121                 my @lines = ();
2351                                                  2122 
2352                 @lines = &{$VCS_cmds{"execute    2123                 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2353                                                  2124 
2354                 if (!$email_git_penguin_chief    2125                 if (!$email_git_penguin_chiefs) {
2355                     @lines = grep(!/${penguin    2126                     @lines = grep(!/${penguin_chiefs}/i, @lines);
2356                 }                                2127                 }
2357                                                  2128 
2358                 last if !@lines;                 2129                 last if !@lines;
2359                                                  2130 
2360                 my @authors = ();                2131                 my @authors = ();
2361                 foreach my $line (@lines) {      2132                 foreach my $line (@lines) {
2362                     if ($line =~ m/$VCS_cmds{    2133                     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2363                         my $author = $1;         2134                         my $author = $1;
2364                         $author = deduplicate    2135                         $author = deduplicate_email($author);
2365                         push(@authors, $autho    2136                         push(@authors, $author);
2366                     }                            2137                     }
2367                 }                                2138                 }
2368                                                  2139 
2369                 save_commits_by_author(@lines    2140                 save_commits_by_author(@lines) if ($interactive);
2370                 save_commits_by_signer(@lines    2141                 save_commits_by_signer(@lines) if ($interactive);
2371                                                  2142 
2372                 push(@signers, @authors);        2143                 push(@signers, @authors);
2373             }}                                   2144             }}
2374             else {                               2145             else {
2375                 foreach my $commit (@commits)    2146                 foreach my $commit (@commits) {
2376                     my $i;                       2147                     my $i;
2377                     my $cmd = $VCS_cmds{"find    2148                     my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2378                     $cmd =~ s/(\$\w+)/$1/eeg;    2149                     $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2379                     my @author = vcs_find_aut    2150                     my @author = vcs_find_author($cmd);
2380                     next if !@author;            2151                     next if !@author;
2381                                                  2152 
2382                     my $formatted_author = de    2153                     my $formatted_author = deduplicate_email($author[0]);
2383                                                  2154 
2384                     my $count = grep(/$commit    2155                     my $count = grep(/$commit/, @all_commits);
2385                     for ($i = 0; $i < $count     2156                     for ($i = 0; $i < $count ; $i++) {
2386                         push(@blame_signers,     2157                         push(@blame_signers, $formatted_author);
2387                     }                            2158                     }
2388                 }                                2159                 }
2389             }                                    2160             }
2390             if (@blame_signers) {                2161             if (@blame_signers) {
2391                 vcs_assign("authored lines",     2162                 vcs_assign("authored lines", $total_lines, @blame_signers);
2392             }                                    2163             }
2393         }                                        2164         }
2394         foreach my $signer (@signers) {          2165         foreach my $signer (@signers) {
2395             $signer = deduplicate_email($sign    2166             $signer = deduplicate_email($signer);
2396         }                                        2167         }
2397         vcs_assign("commits", $total_commits,    2168         vcs_assign("commits", $total_commits, @signers);
2398     } else {                                     2169     } else {
2399         foreach my $signer (@signers) {          2170         foreach my $signer (@signers) {
2400             $signer = deduplicate_email($sign    2171             $signer = deduplicate_email($signer);
2401         }                                        2172         }
2402         vcs_assign("modified commits", $total    2173         vcs_assign("modified commits", $total_commits, @signers);
2403     }                                            2174     }
2404 }                                                2175 }
2405                                                  2176 
2406 sub vcs_file_exists {                            2177 sub vcs_file_exists {
2407     my ($file) = @_;                             2178     my ($file) = @_;
2408                                                  2179 
2409     my $exists;                                  2180     my $exists;
2410                                                  2181 
2411     my $vcs_used = vcs_exists();                 2182     my $vcs_used = vcs_exists();
2412     return 0 if (!$vcs_used);                    2183     return 0 if (!$vcs_used);
2413                                                  2184 
2414     my $cmd = $VCS_cmds{"file_exists_cmd"};      2185     my $cmd = $VCS_cmds{"file_exists_cmd"};
2415     $cmd =~ s/(\$\w+)/$1/eeg;           # int    2186     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2416     $cmd .= " 2>&1";                             2187     $cmd .= " 2>&1";
2417     $exists = &{$VCS_cmds{"execute_cmd"}}($cm    2188     $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2418                                                  2189 
2419     return 0 if ($? != 0);                       2190     return 0 if ($? != 0);
2420                                                  2191 
2421     return $exists;                              2192     return $exists;
2422 }                                                2193 }
2423                                                  2194 
2424 sub vcs_list_files {                          << 
2425     my ($file) = @_;                          << 
2426                                               << 
2427     my @lsfiles = ();                         << 
2428                                               << 
2429     my $vcs_used = vcs_exists();              << 
2430     return 0 if (!$vcs_used);                 << 
2431                                               << 
2432     my $cmd = $VCS_cmds{"list_files_cmd"};    << 
2433     $cmd =~ s/(\$\w+)/$1/eeg;   # interpolate << 
2434     @lsfiles = &{$VCS_cmds{"execute_cmd"}}($c << 
2435                                               << 
2436     return () if ($? != 0);                   << 
2437                                               << 
2438     return @lsfiles;                          << 
2439 }                                             << 
2440                                               << 
2441 sub uniq {                                       2195 sub uniq {
2442     my (@parms) = @_;                            2196     my (@parms) = @_;
2443                                                  2197 
2444     my %saw;                                     2198     my %saw;
2445     @parms = grep(!$saw{$_}++, @parms);          2199     @parms = grep(!$saw{$_}++, @parms);
2446     return @parms;                               2200     return @parms;
2447 }                                                2201 }
2448                                                  2202 
2449 sub sort_and_uniq {                              2203 sub sort_and_uniq {
2450     my (@parms) = @_;                            2204     my (@parms) = @_;
2451                                                  2205 
2452     my %saw;                                     2206     my %saw;
2453     @parms = sort @parms;                        2207     @parms = sort @parms;
2454     @parms = grep(!$saw{$_}++, @parms);          2208     @parms = grep(!$saw{$_}++, @parms);
2455     return @parms;                               2209     return @parms;
2456 }                                                2210 }
2457                                                  2211 
2458 sub clean_file_emails {                          2212 sub clean_file_emails {
2459     my (@file_emails) = @_;                      2213     my (@file_emails) = @_;
2460     my @fmt_emails = ();                         2214     my @fmt_emails = ();
2461                                                  2215 
2462     foreach my $email (@file_emails) {           2216     foreach my $email (@file_emails) {
2463         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\    2217         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2464         my ($name, $address) = parse_email($e    2218         my ($name, $address) = parse_email($email);
                                                   >> 2219         if ($name eq '"[,\.]"') {
                                                   >> 2220             $name = "";
                                                   >> 2221         }
2465                                                  2222 
2466         # Strip quotes for easier processing, !! 2223         my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
2467         $name =~ s/^"(.*)"$/$1/;              << 
2468                                               << 
2469         # Split into name-like parts and remo << 
2470         my @nw = split(/[^\p{L}\'\,\.\+-]/, $ << 
2471         @nw = grep(!/^[\'\,\.\+-]$/, @nw);    << 
2472                                               << 
2473         # Make a best effort to extract the n << 
2474         # only the last two names, or in the  << 
2475         # three names.                        << 
2476         if (@nw > 2) {                           2224         if (@nw > 2) {
2477             my $first = $nw[@nw - 3];            2225             my $first = $nw[@nw - 3];
2478             my $middle = $nw[@nw - 2];           2226             my $middle = $nw[@nw - 2];
2479             my $last = $nw[@nw - 1];             2227             my $last = $nw[@nw - 1];
2480                                                  2228 
2481             if (((length($first) == 1 && $fir !! 2229             if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2482                  (length($first) == 2 && subs    2230                  (length($first) == 2 && substr($first, -1) eq ".")) ||
2483                 (length($middle) == 1 ||         2231                 (length($middle) == 1 ||
2484                  (length($middle) == 2 && sub    2232                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
2485                 $name = "$first $middle $last    2233                 $name = "$first $middle $last";
2486             } else {                             2234             } else {
2487                 $name = "$middle $last";         2235                 $name = "$middle $last";
2488             }                                    2236             }
2489         } else {                              << 
2490             $name = "@nw";                    << 
2491         }                                        2237         }
2492                                                  2238 
2493         if (substr($name, -1) =~ /[,\.]/) {      2239         if (substr($name, -1) =~ /[,\.]/) {
2494             $name = substr($name, 0, length($    2240             $name = substr($name, 0, length($name) - 1);
                                                   >> 2241         } elsif (substr($name, -2) =~ /[,\.]"/) {
                                                   >> 2242             $name = substr($name, 0, length($name) - 2) . '"';
2495         }                                        2243         }
2496                                                  2244 
2497         if (substr($name, 0, 1) =~ /[,\.]/) {    2245         if (substr($name, 0, 1) =~ /[,\.]/) {
2498             $name = substr($name, 1, length($    2246             $name = substr($name, 1, length($name) - 1);
                                                   >> 2247         } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
                                                   >> 2248             $name = '"' . substr($name, 2, length($name) - 2);
2499         }                                        2249         }
2500                                                  2250 
2501         my $fmt_email = format_email($name, $    2251         my $fmt_email = format_email($name, $address, $email_usename);
2502         push(@fmt_emails, $fmt_email);           2252         push(@fmt_emails, $fmt_email);
2503     }                                            2253     }
2504     return @fmt_emails;                          2254     return @fmt_emails;
2505 }                                                2255 }
2506                                                  2256 
2507 sub merge_email {                                2257 sub merge_email {
2508     my @lines;                                   2258     my @lines;
2509     my %saw;                                     2259     my %saw;
2510                                                  2260 
2511     for (@_) {                                   2261     for (@_) {
2512         my ($address, $role) = @$_;              2262         my ($address, $role) = @$_;
2513         if (!$saw{$address}) {                   2263         if (!$saw{$address}) {
2514             if ($output_roles) {                 2264             if ($output_roles) {
2515                 push(@lines, "$address ($role    2265                 push(@lines, "$address ($role)");
2516             } else {                             2266             } else {
2517                 push(@lines, $address);          2267                 push(@lines, $address);
2518             }                                    2268             }
2519             $saw{$address} = 1;                  2269             $saw{$address} = 1;
2520         }                                        2270         }
2521     }                                            2271     }
2522                                                  2272 
2523     return @lines;                               2273     return @lines;
2524 }                                                2274 }
2525                                                  2275 
2526 sub output {                                     2276 sub output {
2527     my (@parms) = @_;                            2277     my (@parms) = @_;
2528                                                  2278 
2529     if ($output_multiline) {                     2279     if ($output_multiline) {
2530         foreach my $line (@parms) {              2280         foreach my $line (@parms) {
2531             print("${line}\n");                  2281             print("${line}\n");
2532         }                                        2282         }
2533     } else {                                     2283     } else {
2534         print(join($output_separator, @parms)    2284         print(join($output_separator, @parms));
2535         print("\n");                             2285         print("\n");
2536     }                                            2286     }
2537 }                                                2287 }
2538                                                  2288 
2539 my $rfc822re;                                    2289 my $rfc822re;
2540                                                  2290 
2541 sub make_rfc822re {                              2291 sub make_rfc822re {
2542 #   Basic lexical tokens are specials, domain    2292 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2543 #   comment.  We must allow for rfc822_lwsp (    2293 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2544 #   This regexp will only work on addresses w    2294 #   This regexp will only work on addresses which have had comments stripped
2545 #   and replaced with rfc822_lwsp.               2295 #   and replaced with rfc822_lwsp.
2546                                                  2296 
2547     my $specials = '()<>@,;:\\\\".\\[\\]';       2297     my $specials = '()<>@,;:\\\\".\\[\\]';
2548     my $controls = '\\000-\\037\\177';           2298     my $controls = '\\000-\\037\\177';
2549                                                  2299 
2550     my $dtext = "[^\\[\\]\\r\\\\]";              2300     my $dtext = "[^\\[\\]\\r\\\\]";
2551     my $domain_literal = "\\[(?:$dtext|\\\\.)    2301     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2552                                                  2302 
2553     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|    2303     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2554                                                  2304 
2555 #   Use zero-width assertion to spot the limi    2305 #   Use zero-width assertion to spot the limit of an atom.  A simple
2556 #   $rfc822_lwsp* causes the regexp engine to    2306 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2557     my $atom = "[^$specials $controls]+(?:$rf    2307     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2558     my $word = "(?:$atom|$quoted_string)";       2308     my $word = "(?:$atom|$quoted_string)";
2559     my $localpart = "$word(?:\\.$rfc822_lwsp*    2309     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2560                                                  2310 
2561     my $sub_domain = "(?:$atom|$domain_litera    2311     my $sub_domain = "(?:$atom|$domain_literal)";
2562     my $domain = "$sub_domain(?:\\.$rfc822_lw    2312     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2563                                                  2313 
2564     my $addr_spec = "$localpart\@$rfc822_lwsp    2314     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2565                                                  2315 
2566     my $phrase = "$word*";                       2316     my $phrase = "$word*";
2567     my $route = "(?:\@$domain(?:,\@$rfc822_lw    2317     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2568     my $route_addr = "\\<$rfc822_lwsp*$route?    2318     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2569     my $mailbox = "(?:$addr_spec|$phrase$rout    2319     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2570                                                  2320 
2571     my $group = "$phrase:$rfc822_lwsp*(?:$mai    2321     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2572     my $address = "(?:$mailbox|$group)";         2322     my $address = "(?:$mailbox|$group)";
2573                                                  2323 
2574     return "$rfc822_lwsp*$address";              2324     return "$rfc822_lwsp*$address";
2575 }                                                2325 }
2576                                                  2326 
2577 sub rfc822_strip_comments {                      2327 sub rfc822_strip_comments {
2578     my $s = shift;                               2328     my $s = shift;
2579 #   Recursively remove comments, and replace     2329 #   Recursively remove comments, and replace with a single space.  The simpler
2580 #   regexps in the Email Addressing FAQ are i    2330 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2581 #   chars in atoms, for example.                 2331 #   chars in atoms, for example.
2582                                                  2332 
2583     while ($s =~ s/^((?:[^"\\]|\\.)*             2333     while ($s =~ s/^((?:[^"\\]|\\.)*
2584                     (?:"(?:[^"\\]|\\.)*"(?:[^    2334                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2585                     \((?:[^()\\]|\\.)*\)/$1 /    2335                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2586     return $s;                                   2336     return $s;
2587 }                                                2337 }
2588                                                  2338 
2589 #   valid: returns true if the parameter is a    2339 #   valid: returns true if the parameter is an RFC822 valid address
2590 #                                                2340 #
2591 sub rfc822_valid {                               2341 sub rfc822_valid {
2592     my $s = rfc822_strip_comments(shift);        2342     my $s = rfc822_strip_comments(shift);
2593                                                  2343 
2594     if (!$rfc822re) {                            2344     if (!$rfc822re) {
2595         $rfc822re = make_rfc822re();             2345         $rfc822re = make_rfc822re();
2596     }                                            2346     }
2597                                                  2347 
2598     return $s =~ m/^$rfc822re$/so && $s =~ m/    2348     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2599 }                                                2349 }
2600                                                  2350 
2601 #   validlist: In scalar context, returns tru    2351 #   validlist: In scalar context, returns true if the parameter is an RFC822
2602 #              valid list of addresses.          2352 #              valid list of addresses.
2603 #                                                2353 #
2604 #              In list context, returns an em    2354 #              In list context, returns an empty list on failure (an invalid
2605 #              address was found); otherwise     2355 #              address was found); otherwise a list whose first element is the
2606 #              number of addresses found and     2356 #              number of addresses found and whose remaining elements are the
2607 #              addresses.  This is needed to     2357 #              addresses.  This is needed to disambiguate failure (invalid)
2608 #              from success with no addresses    2358 #              from success with no addresses found, because an empty string is
2609 #              a valid list.                     2359 #              a valid list.
2610                                                  2360 
2611 sub rfc822_validlist {                           2361 sub rfc822_validlist {
2612     my $s = rfc822_strip_comments(shift);        2362     my $s = rfc822_strip_comments(shift);
2613                                                  2363 
2614     if (!$rfc822re) {                            2364     if (!$rfc822re) {
2615         $rfc822re = make_rfc822re();             2365         $rfc822re = make_rfc822re();
2616     }                                            2366     }
2617     # * null list items are valid according t    2367     # * null list items are valid according to the RFC
2618     # * the '1' business is to aid in disting    2368     # * the '1' business is to aid in distinguishing failure from no results
2619                                                  2369 
2620     my @r;                                       2370     my @r;
2621     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822    2371     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2622         $s =~ m/^$rfc822_char*$/) {              2372         $s =~ m/^$rfc822_char*$/) {
2623         while ($s =~ m/(?:^|,$rfc822_lwsp*)($    2373         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2624             push(@r, $1);                        2374             push(@r, $1);
2625         }                                        2375         }
2626         return wantarray ? (scalar(@r), @r) :    2376         return wantarray ? (scalar(@r), @r) : 1;
2627     }                                            2377     }
2628     return wantarray ? () : 0;                   2378     return wantarray ? () : 0;
2629 }                                                2379 }
                                                      

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~

kernel.org | git.kernel.org | LWN.net | Project Home | SVN repository | Mail admin

Linux® is a registered trademark of Linus Torvalds in the United States and other countries.
TOMOYO® is a registered trademark of NTT DATA CORPORATION.

sflogo.php