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