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