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