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