1#!/usr/bin/env perl 2# (c) 2007, Joe Perches <joe@perches.com> 3# created from checkpatch.pl 4# 5# Print selected MAINTAINERS information for 6# the files modified in a patch or for a file 7# 8# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 9# perl scripts/get_maintainer.pl [OPTIONS] -f <file> 10# 11# Licensed under the terms of the GNU GPL License version 2 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/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) { 546 my $filename = $1; 547 $filename =~ s@^[^/]*/@@; 548 $filename =~ s@\n@@; 549 $lastfile = $filename; 550 push(@files, $filename); 551 $patch_prefix = "^[+-].*"; #Now parsing the actual patch 552 } elsif (m/^\@\@ -(\d+),(\d+)/) { 553 if ($email_git_blame) { 554 push(@range, "$lastfile:$1:$2"); 555 } 556 } elsif ($keywords) { 557 foreach my $line (keys %keyword_hash) { 558 if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) { 559 push(@keyword_tvi, $line); 560 } 561 } 562 } 563 } 564 close($patch); 565 566 if ($file_cnt == @files) { 567 warn "$P: file '${file}' doesn't appear to be a patch. " 568 . "Add -f to options?\n"; 569 } 570 @files = sort_and_uniq(@files); 571 } 572} 573 574@file_emails = uniq(@file_emails); 575 576my %email_hash_name; 577my %email_hash_address; 578my @email_to = (); 579my %hash_list_to; 580my @list_to = (); 581my @scm = (); 582my @web = (); 583my @subsystem = (); 584my @status = (); 585my %deduplicate_name_hash = (); 586my %deduplicate_address_hash = (); 587 588my @maintainers = get_maintainers(); 589 590if (@maintainers) { 591 @maintainers = merge_email(@maintainers); 592 output(@maintainers); 593} 594 595if ($scm) { 596 @scm = uniq(@scm); 597 output(@scm); 598} 599 600if ($status) { 601 @status = uniq(@status); 602 output(@status); 603} 604 605if ($subsystem) { 606 @subsystem = uniq(@subsystem); 607 output(@subsystem); 608} 609 610if ($web) { 611 @web = uniq(@web); 612 output(@web); 613} 614 615exit($exit); 616 617sub self_test { 618 my @lsfiles = (); 619 my @good_links = (); 620 my @bad_links = (); 621 my @section_headers = (); 622 my $index = 0; 623 624 @lsfiles = vcs_list_files($lk_path); 625 626 for my $x (@self_test_info) { 627 $index++; 628 629 ## Section header duplication and missing section content 630 if (($self_test eq "" || $self_test =~ /\bsections\b/) && 631 $x->{line} =~ /^\S[^:]/ && 632 defined $self_test_info[$index] && 633 $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) { 634 my $has_S = 0; 635 my $has_F = 0; 636 my $has_ML = 0; 637 my $status = ""; 638 if (grep(m@^\Q$x->{line}\E@, @section_headers)) { 639 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n"); 640 } else { 641 push(@section_headers, $x->{line}); 642 } 643 my $nextline = $index; 644 while (defined $self_test_info[$nextline] && 645 $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) { 646 my $type = $1; 647 my $value = $2; 648 if ($type eq "S") { 649 $has_S = 1; 650 $status = $value; 651 } elsif ($type eq "F" || $type eq "N") { 652 $has_F = 1; 653 } elsif ($type eq "M" || $type eq "R" || $type eq "L") { 654 $has_ML = 1; 655 } 656 $nextline++; 657 } 658 if (!$has_ML && $status !~ /orphan|obsolete/i) { 659 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n"); 660 } 661 if (!$has_S) { 662 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n"); 663 } 664 if (!$has_F) { 665 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n"); 666 } 667 } 668 669 next if ($x->{line} !~ /^([A-Z]):\s*(.*)/); 670 671 my $type = $1; 672 my $value = $2; 673 674 ## Filename pattern matching 675 if (($type eq "F" || $type eq "X") && 676 ($self_test eq "" || $self_test =~ /\bpatterns\b/)) { 677 $value =~ s@\.@\\\.@g; ##Convert . to \. 678 $value =~ s/\*/\.\*/g; ##Convert * to .* 679 $value =~ s/\?/\./g; ##Convert ? to . 680 ##if pattern is a directory and it lacks a trailing slash, add one 681 if ((-d $value)) { 682 $value =~ s@([^/])$@$1/@; 683 } 684 if (!grep(m@^$value@, @lsfiles)) { 685 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n"); 686 } 687 688 ## Link reachability 689 } elsif (($type eq "W" || $type eq "Q" || $type eq "B") && 690 $value =~ /^https?:/ && 691 ($self_test eq "" || $self_test =~ /\blinks\b/)) { 692 next if (grep(m@^\Q$value\E$@, @good_links)); 693 my $isbad = 0; 694 if (grep(m@^\Q$value\E$@, @bad_links)) { 695 $isbad = 1; 696 } else { 697 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`; 698 if ($? == 0) { 699 push(@good_links, $value); 700 } else { 701 push(@bad_links, $value); 702 $isbad = 1; 703 } 704 } 705 if ($isbad) { 706 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); 707 } 708 709 ## SCM reachability 710 } elsif ($type eq "T" && 711 ($self_test eq "" || $self_test =~ /\bscm\b/)) { 712 next if (grep(m@^\Q$value\E$@, @good_links)); 713 my $isbad = 0; 714 if (grep(m@^\Q$value\E$@, @bad_links)) { 715 $isbad = 1; 716 } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) { 717 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n"); 718 } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) { 719 my $url = $1; 720 my $branch = ""; 721 $branch = $3 if $3; 722 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`; 723 if ($? == 0) { 724 push(@good_links, $value); 725 } else { 726 push(@bad_links, $value); 727 $isbad = 1; 728 } 729 } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) { 730 my $url = $1; 731 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`; 732 if ($? == 0) { 733 push(@good_links, $value); 734 } else { 735 push(@bad_links, $value); 736 $isbad = 1; 737 } 738 } 739 if ($isbad) { 740 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); 741 } 742 } 743 } 744} 745 746sub ignore_email_address { 747 my ($address) = @_; 748 749 foreach my $ignore (@ignore_emails) { 750 return 1 if ($ignore eq $address); 751 } 752 753 return 0; 754} 755 756sub range_is_maintained { 757 my ($start, $end) = @_; 758 759 for (my $i = $start; $i < $end; $i++) { 760 my $line = $typevalue[$i]; 761 if ($line =~ m/^([A-Z]):\s*(.*)/) { 762 my $type = $1; 763 my $value = $2; 764 if ($type eq 'S') { 765 if ($value =~ /(maintain|support)/i) { 766 return 1; 767 } 768 } 769 } 770 } 771 return 0; 772} 773 774sub range_has_maintainer { 775 my ($start, $end) = @_; 776 777 for (my $i = $start; $i < $end; $i++) { 778 my $line = $typevalue[$i]; 779 if ($line =~ m/^([A-Z]):\s*(.*)/) { 780 my $type = $1; 781 my $value = $2; 782 if ($type eq 'M') { 783 return 1; 784 } 785 } 786 } 787 return 0; 788} 789 790sub get_maintainers { 791 %email_hash_name = (); 792 %email_hash_address = (); 793 %commit_author_hash = (); 794 %commit_signer_hash = (); 795 @email_to = (); 796 %hash_list_to = (); 797 @list_to = (); 798 @scm = (); 799 @web = (); 800 @subsystem = (); 801 @status = (); 802 %deduplicate_name_hash = (); 803 %deduplicate_address_hash = (); 804 if ($email_git_all_signature_types) { 805 $signature_pattern = "(.+?)[Bb][Yy]:"; 806 } else { 807 $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 808 } 809 810 # Find responsible parties 811 812 my %exact_pattern_match_hash = (); 813 814 foreach my $file (@files) { 815 816 my %hash; 817 my $tvi = find_first_section(); 818 while ($tvi < @typevalue) { 819 my $start = find_starting_index($tvi); 820 my $end = find_ending_index($tvi); 821 my $exclude = 0; 822 my $i; 823 824 #Do not match excluded file patterns 825 826 for ($i = $start; $i < $end; $i++) { 827 my $line = $typevalue[$i]; 828 if ($line =~ m/^([A-Z]):\s*(.*)/) { 829 my $type = $1; 830 my $value = $2; 831 if ($type eq 'X') { 832 if (file_match_pattern($file, $value)) { 833 $exclude = 1; 834 last; 835 } 836 } 837 } 838 } 839 840 if (!$exclude) { 841 for ($i = $start; $i < $end; $i++) { 842 my $line = $typevalue[$i]; 843 if ($line =~ m/^([A-Z]):\s*(.*)/) { 844 my $type = $1; 845 my $value = $2; 846 if ($type eq 'F') { 847 if (file_match_pattern($file, $value)) { 848 my $value_pd = ($value =~ tr@/@@); 849 my $file_pd = ($file =~ tr@/@@); 850 $value_pd++ if (substr($value,-1,1) ne "/"); 851 $value_pd = -1 if ($value =~ /^\.\*/); 852 if ($value_pd >= $file_pd && 853 range_is_maintained($start, $end) && 854 range_has_maintainer($start, $end)) { 855 $exact_pattern_match_hash{$file} = 1; 856 } 857 if ($pattern_depth == 0 || 858 (($file_pd - $value_pd) < $pattern_depth)) { 859 $hash{$tvi} = $value_pd; 860 } 861 } 862 } elsif ($type eq 'N') { 863 if ($file =~ m/$value/x) { 864 $hash{$tvi} = 0; 865 } 866 } 867 } 868 } 869 } 870 $tvi = $end + 1; 871 } 872 873 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 874 add_categories($line); 875 if ($sections) { 876 my $i; 877 my $start = find_starting_index($line); 878 my $end = find_ending_index($line); 879 for ($i = $start; $i < $end; $i++) { 880 my $line = $typevalue[$i]; 881 if ($line =~ /^[FX]:/) { ##Restore file patterns 882 $line =~ s/([^\\])\.([^\*])/$1\?$2/g; 883 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ? 884 $line =~ s/\\\./\./g; ##Convert \. to . 885 $line =~ s/\.\*/\*/g; ##Convert .* to * 886 } 887 my $count = $line =~ s/^([A-Z]):/$1:\t/g; 888 if ($letters eq "" || (!$count || $letters =~ /$1/i)) { 889 print("$line\n"); 890 } 891 } 892 print("\n"); 893 } 894 } 895 } 896 897 if ($keywords) { 898 @keyword_tvi = sort_and_uniq(@keyword_tvi); 899 foreach my $line (@keyword_tvi) { 900 add_categories($line); 901 } 902 } 903 904 foreach my $email (@email_to, @list_to) { 905 $email->[0] = deduplicate_email($email->[0]); 906 } 907 908 foreach my $file (@files) { 909 if ($email && 910 ($email_git || ($email_git_fallback && 911 !$exact_pattern_match_hash{$file}))) { 912 vcs_file_signoffs($file); 913 } 914 if ($email && $email_git_blame) { 915 vcs_file_blame($file); 916 } 917 } 918 919 if ($email) { 920 foreach my $chief (@penguin_chief) { 921 if ($chief =~ m/^(.*):(.*)/) { 922 my $email_address; 923 924 $email_address = format_email($1, $2, $email_usename); 925 if ($email_git_penguin_chiefs) { 926 push(@email_to, [$email_address, 'chief penguin']); 927 } else { 928 @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 929 } 930 } 931 } 932 933 foreach my $email (@file_emails) { 934 my ($name, $address) = parse_email($email); 935 936 my $tmp_email = format_email($name, $address, $email_usename); 937 push_email_address($tmp_email, ''); 938 add_role($tmp_email, 'in file'); 939 } 940 } 941 942 my @to = (); 943 if ($email || $email_list) { 944 if ($email) { 945 @to = (@to, @email_to); 946 } 947 if ($email_list) { 948 @to = (@to, @list_to); 949 } 950 } 951 952 if ($interactive) { 953 @to = interactive_get_maintainers(\@to); 954 } 955 956 return @to; 957} 958 959sub file_match_pattern { 960 my ($file, $pattern) = @_; 961 if (substr($pattern, -1) eq "/") { 962 if ($file =~ m@^$pattern@) { 963 return 1; 964 } 965 } else { 966 if ($file =~ m@^$pattern@) { 967 my $s1 = ($file =~ tr@/@@); 968 my $s2 = ($pattern =~ tr@/@@); 969 if ($s1 == $s2) { 970 return 1; 971 } 972 } 973 } 974 return 0; 975} 976 977sub usage { 978 print <<EOT; 979usage: $P [options] patchfile 980 $P [options] -f file|directory 981version: $V 982 983MAINTAINER field selection options: 984 --email => print email address(es) if any 985 --git => include recent git \*-by: signers 986 --git-all-signature-types => include signers regardless of signature type 987 or use only ${signature_pattern} signers (default: $email_git_all_signature_types) 988 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback) 989 --git-chief-penguins => include ${penguin_chiefs} 990 --git-min-signatures => number of signatures required (default: $email_git_min_signatures) 991 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers) 992 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent) 993 --git-blame => use git blame to find modified commits for patch or file 994 --git-blame-signatures => when used with --git-blame, also include all commit signers 995 --git-since => git history to use (default: $email_git_since) 996 --hg-since => hg history to use (default: $email_hg_since) 997 --interactive => display a menu (mostly useful if used with the --git option) 998 --m => include maintainer(s) if any 999 --r => include reviewer(s) if any 1000 --n => include name 'Full Name <addr\@domain.tld>' 1001 --l => include list(s) if any 1002 --s => include subscriber only list(s) if any 1003 --remove-duplicates => minimize duplicate email names/addresses 1004 --roles => show roles (status:subsystem, git-signer, list, etc...) 1005 --rolestats => show roles and statistics (commits/total_commits, %) 1006 --file-emails => add email addresses found in -f file (default: 0 (off)) 1007 --scm => print SCM tree(s) if any 1008 --status => print status if any 1009 --subsystem => print subsystem name if any 1010 --web => print website(s) if any 1011 1012Output type options: 1013 --separator [, ] => separator for multiple entries on 1 line 1014 using --separator also sets --nomultiline if --separator is not [, ] 1015 --multiline => print 1 entry per line 1016 1017Other options: 1018 --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 1019 --keywords => scan patch for keywords (default: $keywords) 1020 --sections => print all of the subsystem sections with pattern matches 1021 --letters => print all matching 'letter' types from all matching sections 1022 --mailmap => use .mailmap file (default: $email_use_mailmap) 1023 --self-test => show potential issues with MAINTAINERS file content 1024 --version => show version 1025 --help => show this help information 1026 1027Default options: 1028 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0 1029 --remove-duplicates --rolestats] 1030 1031Notes: 1032 Using "-f directory" may give unexpected results: 1033 Used with "--git", git signators for _all_ files in and below 1034 directory are examined as git recurses directories. 1035 Any specified X: (exclude) pattern matches are _not_ ignored. 1036 Used with "--nogit", directory is used as a pattern match, 1037 no individual file within the directory or subdirectory 1038 is matched. 1039 Used with "--git-blame", does not iterate all files in directory 1040 Using "--git-blame" is slow and may add old committers and authors 1041 that are no longer active maintainers to the output. 1042 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 1043 other automated tools that expect only ["name"] <email address> 1044 may not work because of additional output after <email address>. 1045 Using "--rolestats" and "--git-blame" shows the #/total=% commits, 1046 not the percentage of the entire file authored. # of commits is 1047 not a good measure of amount of code authored. 1 major commit may 1048 contain a thousand lines, 5 trivial commits may modify a single line. 1049 If git is not installed, but mercurial (hg) is installed and an .hg 1050 repository exists, the following options apply to mercurial: 1051 --git, 1052 --git-min-signatures, --git-max-maintainers, --git-min-percent, and 1053 --git-blame 1054 Use --hg-since not --git-since to control date selection 1055 File ".get_maintainer.conf", if it exists in the linux kernel source root 1056 directory, can change whatever get_maintainer defaults are desired. 1057 Entries in this file can be any command line argument. 1058 This file is prepended to any additional command line arguments. 1059 Multiple lines and # comments are allowed. 1060 Most options have both positive and negative forms. 1061 The negative forms for --<foo> are --no<foo> and --no-<foo>. 1062 1063EOT 1064} 1065 1066sub top_of_kernel_tree { 1067 my ($lk_path) = @_; 1068 1069 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 1070 $lk_path .= "/"; 1071 } 1072 if ( (-f "${lk_path}COPYING") 1073 && (-f "${lk_path}CREDITS") 1074 && (-f "${lk_path}Kbuild") 1075 && (-e "${lk_path}MAINTAINERS") 1076 && (-f "${lk_path}Makefile") 1077 && (-f "${lk_path}README") 1078 && (-d "${lk_path}Documentation") 1079 && (-d "${lk_path}arch") 1080 && (-d "${lk_path}include") 1081 && (-d "${lk_path}drivers") 1082 && (-d "${lk_path}fs") 1083 && (-d "${lk_path}init") 1084 && (-d "${lk_path}ipc") 1085 && (-d "${lk_path}kernel") 1086 && (-d "${lk_path}lib") 1087 && (-d "${lk_path}scripts")) { 1088 return 1; 1089 } 1090 return 0; 1091} 1092 1093sub parse_email { 1094 my ($formatted_email) = @_; 1095 1096 my $name = ""; 1097 my $address = ""; 1098 1099 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 1100 $name = $1; 1101 $address = $2; 1102 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 1103 $address = $1; 1104 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 1105 $address = $1; 1106 } 1107 1108 $name =~ s/^\s+|\s+$//g; 1109 $name =~ s/^\"|\"$//g; 1110 $address =~ s/^\s+|\s+$//g; 1111 1112 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 1113 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 1114 $name = "\"$name\""; 1115 } 1116 1117 return ($name, $address); 1118} 1119 1120sub format_email { 1121 my ($name, $address, $usename) = @_; 1122 1123 my $formatted_email; 1124 1125 $name =~ s/^\s+|\s+$//g; 1126 $name =~ s/^\"|\"$//g; 1127 $address =~ s/^\s+|\s+$//g; 1128 1129 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 1130 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 1131 $name = "\"$name\""; 1132 } 1133 1134 if ($usename) { 1135 if ("$name" eq "") { 1136 $formatted_email = "$address"; 1137 } else { 1138 $formatted_email = "$name <$address>"; 1139 } 1140 } else { 1141 $formatted_email = $address; 1142 } 1143 1144 return $formatted_email; 1145} 1146 1147sub find_first_section { 1148 my $index = 0; 1149 1150 while ($index < @typevalue) { 1151 my $tv = $typevalue[$index]; 1152 if (($tv =~ m/^([A-Z]):\s*(.*)/)) { 1153 last; 1154 } 1155 $index++; 1156 } 1157 1158 return $index; 1159} 1160 1161sub find_starting_index { 1162 my ($index) = @_; 1163 1164 while ($index > 0) { 1165 my $tv = $typevalue[$index]; 1166 if (!($tv =~ m/^([A-Z]):\s*(.*)/)) { 1167 last; 1168 } 1169 $index--; 1170 } 1171 1172 return $index; 1173} 1174 1175sub find_ending_index { 1176 my ($index) = @_; 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 get_subsystem_name { 1190 my ($index) = @_; 1191 1192 my $start = find_starting_index($index); 1193 1194 my $subsystem = $typevalue[$start]; 1195 if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) { 1196 $subsystem = substr($subsystem, 0, $output_section_maxlen - 3); 1197 $subsystem =~ s/\s*$//; 1198 $subsystem = $subsystem . "..."; 1199 } 1200 return $subsystem; 1201} 1202 1203sub get_maintainer_role { 1204 my ($index) = @_; 1205 1206 my $i; 1207 my $start = find_starting_index($index); 1208 my $end = find_ending_index($index); 1209 1210 my $role = "unknown"; 1211 my $subsystem = get_subsystem_name($index); 1212 1213 for ($i = $start + 1; $i < $end; $i++) { 1214 my $tv = $typevalue[$i]; 1215 if ($tv =~ m/^([A-Z]):\s*(.*)/) { 1216 my $ptype = $1; 1217 my $pvalue = $2; 1218 if ($ptype eq "S") { 1219 $role = $pvalue; 1220 } 1221 } 1222 } 1223 1224 $role = lc($role); 1225 if ($role eq "supported") { 1226 $role = "supporter"; 1227 } elsif ($role eq "maintained") { 1228 $role = "maintainer"; 1229 } elsif ($role eq "odd fixes") { 1230 $role = "odd fixer"; 1231 } elsif ($role eq "orphan") { 1232 $role = "orphan minder"; 1233 } elsif ($role eq "obsolete") { 1234 $role = "obsolete minder"; 1235 } elsif ($role eq "buried alive in reporters") { 1236 $role = "chief penguin"; 1237 } 1238 1239 return $role . ":" . $subsystem; 1240} 1241 1242sub get_list_role { 1243 my ($index) = @_; 1244 1245 my $subsystem = get_subsystem_name($index); 1246 1247 if ($subsystem eq "THE REST") { 1248 $subsystem = ""; 1249 } 1250 1251 return $subsystem; 1252} 1253 1254sub add_categories { 1255 my ($index) = @_; 1256 1257 my $i; 1258 my $start = find_starting_index($index); 1259 my $end = find_ending_index($index); 1260 1261 push(@subsystem, $typevalue[$start]); 1262 1263 for ($i = $start + 1; $i < $end; $i++) { 1264 my $tv = $typevalue[$i]; 1265 if ($tv =~ m/^([A-Z]):\s*(.*)/) { 1266 my $ptype = $1; 1267 my $pvalue = $2; 1268 if ($ptype eq "L") { 1269 my $list_address = $pvalue; 1270 my $list_additional = ""; 1271 my $list_role = get_list_role($i); 1272 1273 if ($list_role ne "") { 1274 $list_role = ":" . $list_role; 1275 } 1276 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 1277 $list_address = $1; 1278 $list_additional = $2; 1279 } 1280 if ($list_additional =~ m/subscribers-only/) { 1281 if ($email_subscriber_list) { 1282 if (!$hash_list_to{lc($list_address)}) { 1283 $hash_list_to{lc($list_address)} = 1; 1284 push(@list_to, [$list_address, 1285 "subscriber list${list_role}"]); 1286 } 1287 } 1288 } else { 1289 if ($email_list) { 1290 if (!$hash_list_to{lc($list_address)}) { 1291 $hash_list_to{lc($list_address)} = 1; 1292 if ($list_additional =~ m/moderated/) { 1293 push(@list_to, [$list_address, 1294 "moderated list${list_role}"]); 1295 } else { 1296 push(@list_to, [$list_address, 1297 "open list${list_role}"]); 1298 } 1299 } 1300 } 1301 } 1302 } elsif ($ptype eq "M") { 1303 my ($name, $address) = parse_email($pvalue); 1304 if ($name eq "") { 1305 if ($i > 0) { 1306 my $tv = $typevalue[$i - 1]; 1307 if ($tv =~ m/^([A-Z]):\s*(.*)/) { 1308 if ($1 eq "P") { 1309 $name = $2; 1310 $pvalue = format_email($name, $address, $email_usename); 1311 } 1312 } 1313 } 1314 } 1315 if ($email_maintainer) { 1316 my $role = get_maintainer_role($i); 1317 push_email_addresses($pvalue, $role); 1318 } 1319 } elsif ($ptype eq "R") { 1320 my ($name, $address) = parse_email($pvalue); 1321 if ($name eq "") { 1322 if ($i > 0) { 1323 my $tv = $typevalue[$i - 1]; 1324 if ($tv =~ m/^([A-Z]):\s*(.*)/) { 1325 if ($1 eq "P") { 1326 $name = $2; 1327 $pvalue = format_email($name, $address, $email_usename); 1328 } 1329 } 1330 } 1331 } 1332 if ($email_reviewer) { 1333 my $subsystem = get_subsystem_name($i); 1334 push_email_addresses($pvalue, "reviewer:$subsystem"); 1335 } 1336 } elsif ($ptype eq "T") { 1337 push(@scm, $pvalue); 1338 } elsif ($ptype eq "W") { 1339 push(@web, $pvalue); 1340 } elsif ($ptype eq "S") { 1341 push(@status, $pvalue); 1342 } 1343 } 1344 } 1345} 1346 1347sub email_inuse { 1348 my ($name, $address) = @_; 1349 1350 return 1 if (($name eq "") && ($address eq "")); 1351 return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 1352 return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 1353 1354 return 0; 1355} 1356 1357sub push_email_address { 1358 my ($line, $role) = @_; 1359 1360 my ($name, $address) = parse_email($line); 1361 1362 if ($address eq "") { 1363 return 0; 1364 } 1365 1366 if (!$email_remove_duplicates) { 1367 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1368 } elsif (!email_inuse($name, $address)) { 1369 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1370 $email_hash_name{lc($name)}++ if ($name ne ""); 1371 $email_hash_address{lc($address)}++; 1372 } 1373 1374 return 1; 1375} 1376 1377sub push_email_addresses { 1378 my ($address, $role) = @_; 1379 1380 my @address_list = (); 1381 1382 if (rfc822_valid($address)) { 1383 push_email_address($address, $role); 1384 } elsif (@address_list = rfc822_validlist($address)) { 1385 my $array_count = shift(@address_list); 1386 while (my $entry = shift(@address_list)) { 1387 push_email_address($entry, $role); 1388 } 1389 } else { 1390 if (!push_email_address($address, $role)) { 1391 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 1392 } 1393 } 1394} 1395 1396sub add_role { 1397 my ($line, $role) = @_; 1398 1399 my ($name, $address) = parse_email($line); 1400 my $email = format_email($name, $address, $email_usename); 1401 1402 foreach my $entry (@email_to) { 1403 if ($email_remove_duplicates) { 1404 my ($entry_name, $entry_address) = parse_email($entry->[0]); 1405 if (($name eq $entry_name || $address eq $entry_address) 1406 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1407 ) { 1408 if ($entry->[1] eq "") { 1409 $entry->[1] = "$role"; 1410 } else { 1411 $entry->[1] = "$entry->[1],$role"; 1412 } 1413 } 1414 } else { 1415 if ($email eq $entry->[0] 1416 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1417 ) { 1418 if ($entry->[1] eq "") { 1419 $entry->[1] = "$role"; 1420 } else { 1421 $entry->[1] = "$entry->[1],$role"; 1422 } 1423 } 1424 } 1425 } 1426} 1427 1428sub which { 1429 my ($bin) = @_; 1430 1431 foreach my $path (split(/:/, $ENV{PATH})) { 1432 if (-e "$path/$bin") { 1433 return "$path/$bin"; 1434 } 1435 } 1436 1437 return ""; 1438} 1439 1440sub which_conf { 1441 my ($conf) = @_; 1442 1443 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1444 if (-e "$path/$conf") { 1445 return "$path/$conf"; 1446 } 1447 } 1448 1449 return ""; 1450} 1451 1452sub mailmap_email { 1453 my ($line) = @_; 1454 1455 my ($name, $address) = parse_email($line); 1456 my $email = format_email($name, $address, 1); 1457 my $real_name = $name; 1458 my $real_address = $address; 1459 1460 if (exists $mailmap->{names}->{$email} || 1461 exists $mailmap->{addresses}->{$email}) { 1462 if (exists $mailmap->{names}->{$email}) { 1463 $real_name = $mailmap->{names}->{$email}; 1464 } 1465 if (exists $mailmap->{addresses}->{$email}) { 1466 $real_address = $mailmap->{addresses}->{$email}; 1467 } 1468 } else { 1469 if (exists $mailmap->{names}->{$address}) { 1470 $real_name = $mailmap->{names}->{$address}; 1471 } 1472 if (exists $mailmap->{addresses}->{$address}) { 1473 $real_address = $mailmap->{addresses}->{$address}; 1474 } 1475 } 1476 return format_email($real_name, $real_address, 1); 1477} 1478 1479sub mailmap { 1480 my (@addresses) = @_; 1481 1482 my @mapped_emails = (); 1483 foreach my $line (@addresses) { 1484 push(@mapped_emails, mailmap_email($line)); 1485 } 1486 merge_by_realname(@mapped_emails) if ($email_use_mailmap); 1487 return @mapped_emails; 1488} 1489 1490sub merge_by_realname { 1491 my %address_map; 1492 my (@emails) = @_; 1493 1494 foreach my $email (@emails) { 1495 my ($name, $address) = parse_email($email); 1496 if (exists $address_map{$name}) { 1497 $address = $address_map{$name}; 1498 $email = format_email($name, $address, 1); 1499 } else { 1500 $address_map{$name} = $address; 1501 } 1502 } 1503} 1504 1505sub git_execute_cmd { 1506 my ($cmd) = @_; 1507 my @lines = (); 1508 1509 my $output = `$cmd`; 1510 $output =~ s/^\s*//gm; 1511 @lines = split("\n", $output); 1512 1513 return @lines; 1514} 1515 1516sub hg_execute_cmd { 1517 my ($cmd) = @_; 1518 my @lines = (); 1519 1520 my $output = `$cmd`; 1521 @lines = split("\n", $output); 1522 1523 return @lines; 1524} 1525 1526sub extract_formatted_signatures { 1527 my (@signature_lines) = @_; 1528 1529 my @type = @signature_lines; 1530 1531 s/\s*(.*):.*/$1/ for (@type); 1532 1533 # cut -f2- -d":" 1534 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1535 1536## Reformat email addresses (with names) to avoid badly written signatures 1537 1538 foreach my $signer (@signature_lines) { 1539 $signer = deduplicate_email($signer); 1540 } 1541 1542 return (\@type, \@signature_lines); 1543} 1544 1545sub vcs_find_signers { 1546 my ($cmd, $file) = @_; 1547 my $commits; 1548 my @lines = (); 1549 my @signatures = (); 1550 my @authors = (); 1551 my @stats = (); 1552 1553 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1554 1555 my $pattern = $VCS_cmds{"commit_pattern"}; 1556 my $author_pattern = $VCS_cmds{"author_pattern"}; 1557 my $stat_pattern = $VCS_cmds{"stat_pattern"}; 1558 1559 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern 1560 1561 $commits = grep(/$pattern/, @lines); # of commits 1562 1563 @authors = grep(/$author_pattern/, @lines); 1564 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1565 @stats = grep(/$stat_pattern/, @lines); 1566 1567# print("stats: <@stats>\n"); 1568 1569 return (0, \@signatures, \@authors, \@stats) if !@signatures; 1570 1571 save_commits_by_author(@lines) if ($interactive); 1572 save_commits_by_signer(@lines) if ($interactive); 1573 1574 if (!$email_git_penguin_chiefs) { 1575 @signatures = grep(!/${penguin_chiefs}/i, @signatures); 1576 } 1577 1578 my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors); 1579 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1580 1581 return ($commits, $signers_ref, $authors_ref, \@stats); 1582} 1583 1584sub vcs_find_author { 1585 my ($cmd) = @_; 1586 my @lines = (); 1587 1588 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1589 1590 if (!$email_git_penguin_chiefs) { 1591 @lines = grep(!/${penguin_chiefs}/i, @lines); 1592 } 1593 1594 return @lines if !@lines; 1595 1596 my @authors = (); 1597 foreach my $line (@lines) { 1598 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1599 my $author = $1; 1600 my ($name, $address) = parse_email($author); 1601 $author = format_email($name, $address, 1); 1602 push(@authors, $author); 1603 } 1604 } 1605 1606 save_commits_by_author(@lines) if ($interactive); 1607 save_commits_by_signer(@lines) if ($interactive); 1608 1609 return @authors; 1610} 1611 1612sub vcs_save_commits { 1613 my ($cmd) = @_; 1614 my @lines = (); 1615 my @commits = (); 1616 1617 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1618 1619 foreach my $line (@lines) { 1620 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 1621 push(@commits, $1); 1622 } 1623 } 1624 1625 return @commits; 1626} 1627 1628sub vcs_blame { 1629 my ($file) = @_; 1630 my $cmd; 1631 my @commits = (); 1632 1633 return @commits if (!(-f $file)); 1634 1635 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1636 my @all_commits = (); 1637 1638 $cmd = $VCS_cmds{"blame_file_cmd"}; 1639 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1640 @all_commits = vcs_save_commits($cmd); 1641 1642 foreach my $file_range_diff (@range) { 1643 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1644 my $diff_file = $1; 1645 my $diff_start = $2; 1646 my $diff_length = $3; 1647 next if ("$file" ne "$diff_file"); 1648 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1649 push(@commits, $all_commits[$i]); 1650 } 1651 } 1652 } elsif (@range) { 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 $cmd = $VCS_cmds{"blame_range_cmd"}; 1660 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1661 push(@commits, vcs_save_commits($cmd)); 1662 } 1663 } else { 1664 $cmd = $VCS_cmds{"blame_file_cmd"}; 1665 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1666 @commits = vcs_save_commits($cmd); 1667 } 1668 1669 foreach my $commit (@commits) { 1670 $commit =~ s/^\^//g; 1671 } 1672 1673 return @commits; 1674} 1675 1676my $printed_novcs = 0; 1677sub vcs_exists { 1678 %VCS_cmds = %VCS_cmds_git; 1679 return 1 if eval $VCS_cmds{"available"}; 1680 %VCS_cmds = %VCS_cmds_hg; 1681 return 2 if eval $VCS_cmds{"available"}; 1682 %VCS_cmds = (); 1683 if (!$printed_novcs) { 1684 warn("$P: No supported VCS found. Add --nogit to options?\n"); 1685 warn("Using a git repository produces better results.\n"); 1686 warn("Try Linus Torvalds' latest git repository using:\n"); 1687 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n"); 1688 $printed_novcs = 1; 1689 } 1690 return 0; 1691} 1692 1693sub vcs_is_git { 1694 vcs_exists(); 1695 return $vcs_used == 1; 1696} 1697 1698sub vcs_is_hg { 1699 return $vcs_used == 2; 1700} 1701 1702sub interactive_get_maintainers { 1703 my ($list_ref) = @_; 1704 my @list = @$list_ref; 1705 1706 vcs_exists(); 1707 1708 my %selected; 1709 my %authored; 1710 my %signed; 1711 my $count = 0; 1712 my $maintained = 0; 1713 foreach my $entry (@list) { 1714 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i); 1715 $selected{$count} = 1; 1716 $authored{$count} = 0; 1717 $signed{$count} = 0; 1718 $count++; 1719 } 1720 1721 #menu loop 1722 my $done = 0; 1723 my $print_options = 0; 1724 my $redraw = 1; 1725 while (!$done) { 1726 $count = 0; 1727 if ($redraw) { 1728 printf STDERR "\n%1s %2s %-65s", 1729 "*", "#", "email/list and role:stats"; 1730 if ($email_git || 1731 ($email_git_fallback && !$maintained) || 1732 $email_git_blame) { 1733 print STDERR "auth sign"; 1734 } 1735 print STDERR "\n"; 1736 foreach my $entry (@list) { 1737 my $email = $entry->[0]; 1738 my $role = $entry->[1]; 1739 my $sel = ""; 1740 $sel = "*" if ($selected{$count}); 1741 my $commit_author = $commit_author_hash{$email}; 1742 my $commit_signer = $commit_signer_hash{$email}; 1743 my $authored = 0; 1744 my $signed = 0; 1745 $authored++ for (@{$commit_author}); 1746 $signed++ for (@{$commit_signer}); 1747 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1748 printf STDERR "%4d %4d", $authored, $signed 1749 if ($authored > 0 || $signed > 0); 1750 printf STDERR "\n %s\n", $role; 1751 if ($authored{$count}) { 1752 my $commit_author = $commit_author_hash{$email}; 1753 foreach my $ref (@{$commit_author}) { 1754 print STDERR " Author: @{$ref}[1]\n"; 1755 } 1756 } 1757 if ($signed{$count}) { 1758 my $commit_signer = $commit_signer_hash{$email}; 1759 foreach my $ref (@{$commit_signer}) { 1760 print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1761 } 1762 } 1763 1764 $count++; 1765 } 1766 } 1767 my $date_ref = \$email_git_since; 1768 $date_ref = \$email_hg_since if (vcs_is_hg()); 1769 if ($print_options) { 1770 $print_options = 0; 1771 if (vcs_exists()) { 1772 print STDERR <<EOT 1773 1774Version Control options: 1775g use git history [$email_git] 1776gf use git-fallback [$email_git_fallback] 1777b use git blame [$email_git_blame] 1778bs use blame signatures [$email_git_blame_signatures] 1779c# minimum commits [$email_git_min_signatures] 1780%# min percent [$email_git_min_percent] 1781d# history to use [$$date_ref] 1782x# max maintainers [$email_git_max_maintainers] 1783t all signature types [$email_git_all_signature_types] 1784m use .mailmap [$email_use_mailmap] 1785EOT 1786 } 1787 print STDERR <<EOT 1788 1789Additional options: 17900 toggle all 1791tm toggle maintainers 1792tg toggle git entries 1793tl toggle open list entries 1794ts toggle subscriber list entries 1795f emails in file [$file_emails] 1796k keywords in file [$keywords] 1797r remove duplicates [$email_remove_duplicates] 1798p# pattern match depth [$pattern_depth] 1799EOT 1800 } 1801 print STDERR 1802"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1803 1804 my $input = <STDIN>; 1805 chomp($input); 1806 1807 $redraw = 1; 1808 my $rerun = 0; 1809 my @wish = split(/[, ]+/, $input); 1810 foreach my $nr (@wish) { 1811 $nr = lc($nr); 1812 my $sel = substr($nr, 0, 1); 1813 my $str = substr($nr, 1); 1814 my $val = 0; 1815 $val = $1 if $str =~ /^(\d+)$/; 1816 1817 if ($sel eq "y") { 1818 $interactive = 0; 1819 $done = 1; 1820 $output_rolestats = 0; 1821 $output_roles = 0; 1822 last; 1823 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1824 $selected{$nr - 1} = !$selected{$nr - 1}; 1825 } elsif ($sel eq "*" || $sel eq '^') { 1826 my $toggle = 0; 1827 $toggle = 1 if ($sel eq '*'); 1828 for (my $i = 0; $i < $count; $i++) { 1829 $selected{$i} = $toggle; 1830 } 1831 } elsif ($sel eq "0") { 1832 for (my $i = 0; $i < $count; $i++) { 1833 $selected{$i} = !$selected{$i}; 1834 } 1835 } elsif ($sel eq "t") { 1836 if (lc($str) eq "m") { 1837 for (my $i = 0; $i < $count; $i++) { 1838 $selected{$i} = !$selected{$i} 1839 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i); 1840 } 1841 } elsif (lc($str) eq "g") { 1842 for (my $i = 0; $i < $count; $i++) { 1843 $selected{$i} = !$selected{$i} 1844 if ($list[$i]->[1] =~ /^(author|commit|signer)/i); 1845 } 1846 } elsif (lc($str) eq "l") { 1847 for (my $i = 0; $i < $count; $i++) { 1848 $selected{$i} = !$selected{$i} 1849 if ($list[$i]->[1] =~ /^(open list)/i); 1850 } 1851 } elsif (lc($str) eq "s") { 1852 for (my $i = 0; $i < $count; $i++) { 1853 $selected{$i} = !$selected{$i} 1854 if ($list[$i]->[1] =~ /^(subscriber list)/i); 1855 } 1856 } 1857 } elsif ($sel eq "a") { 1858 if ($val > 0 && $val <= $count) { 1859 $authored{$val - 1} = !$authored{$val - 1}; 1860 } elsif ($str eq '*' || $str eq '^') { 1861 my $toggle = 0; 1862 $toggle = 1 if ($str eq '*'); 1863 for (my $i = 0; $i < $count; $i++) { 1864 $authored{$i} = $toggle; 1865 } 1866 } 1867 } elsif ($sel eq "s") { 1868 if ($val > 0 && $val <= $count) { 1869 $signed{$val - 1} = !$signed{$val - 1}; 1870 } elsif ($str eq '*' || $str eq '^') { 1871 my $toggle = 0; 1872 $toggle = 1 if ($str eq '*'); 1873 for (my $i = 0; $i < $count; $i++) { 1874 $signed{$i} = $toggle; 1875 } 1876 } 1877 } elsif ($sel eq "o") { 1878 $print_options = 1; 1879 $redraw = 1; 1880 } elsif ($sel eq "g") { 1881 if ($str eq "f") { 1882 bool_invert(\$email_git_fallback); 1883 } else { 1884 bool_invert(\$email_git); 1885 } 1886 $rerun = 1; 1887 } elsif ($sel eq "b") { 1888 if ($str eq "s") { 1889 bool_invert(\$email_git_blame_signatures); 1890 } else { 1891 bool_invert(\$email_git_blame); 1892 } 1893 $rerun = 1; 1894 } elsif ($sel eq "c") { 1895 if ($val > 0) { 1896 $email_git_min_signatures = $val; 1897 $rerun = 1; 1898 } 1899 } elsif ($sel eq "x") { 1900 if ($val > 0) { 1901 $email_git_max_maintainers = $val; 1902 $rerun = 1; 1903 } 1904 } elsif ($sel eq "%") { 1905 if ($str ne "" && $val >= 0) { 1906 $email_git_min_percent = $val; 1907 $rerun = 1; 1908 } 1909 } elsif ($sel eq "d") { 1910 if (vcs_is_git()) { 1911 $email_git_since = $str; 1912 } elsif (vcs_is_hg()) { 1913 $email_hg_since = $str; 1914 } 1915 $rerun = 1; 1916 } elsif ($sel eq "t") { 1917 bool_invert(\$email_git_all_signature_types); 1918 $rerun = 1; 1919 } elsif ($sel eq "f") { 1920 bool_invert(\$file_emails); 1921 $rerun = 1; 1922 } elsif ($sel eq "r") { 1923 bool_invert(\$email_remove_duplicates); 1924 $rerun = 1; 1925 } elsif ($sel eq "m") { 1926 bool_invert(\$email_use_mailmap); 1927 read_mailmap(); 1928 $rerun = 1; 1929 } elsif ($sel eq "k") { 1930 bool_invert(\$keywords); 1931 $rerun = 1; 1932 } elsif ($sel eq "p") { 1933 if ($str ne "" && $val >= 0) { 1934 $pattern_depth = $val; 1935 $rerun = 1; 1936 } 1937 } elsif ($sel eq "h" || $sel eq "?") { 1938 print STDERR <<EOT 1939 1940Interactive mode allows you to select the various maintainers, submitters, 1941commit signers and mailing lists that could be CC'd on a patch. 1942 1943Any *'d entry is selected. 1944 1945If you have git or hg installed, you can choose to summarize the commit 1946history of files in the patch. Also, each line of the current file can 1947be matched to its commit author and that commits signers with blame. 1948 1949Various knobs exist to control the length of time for active commit 1950tracking, the maximum number of commit authors and signers to add, 1951and such. 1952 1953Enter selections at the prompt until you are satisfied that the selected 1954maintainers are appropriate. You may enter multiple selections separated 1955by either commas or spaces. 1956 1957EOT 1958 } else { 1959 print STDERR "invalid option: '$nr'\n"; 1960 $redraw = 0; 1961 } 1962 } 1963 if ($rerun) { 1964 print STDERR "git-blame can be very slow, please have patience..." 1965 if ($email_git_blame); 1966 goto &get_maintainers; 1967 } 1968 } 1969 1970 #drop not selected entries 1971 $count = 0; 1972 my @new_emailto = (); 1973 foreach my $entry (@list) { 1974 if ($selected{$count}) { 1975 push(@new_emailto, $list[$count]); 1976 } 1977 $count++; 1978 } 1979 return @new_emailto; 1980} 1981 1982sub bool_invert { 1983 my ($bool_ref) = @_; 1984 1985 if ($$bool_ref) { 1986 $$bool_ref = 0; 1987 } else { 1988 $$bool_ref = 1; 1989 } 1990} 1991 1992sub deduplicate_email { 1993 my ($email) = @_; 1994 1995 my $matched = 0; 1996 my ($name, $address) = parse_email($email); 1997 $email = format_email($name, $address, 1); 1998 $email = mailmap_email($email); 1999 2000 return $email if (!$email_remove_duplicates); 2001 2002 ($name, $address) = parse_email($email); 2003 2004 if ($name ne "" && $deduplicate_name_hash{lc($name)}) { 2005 $name = $deduplicate_name_hash{lc($name)}->[0]; 2006 $address = $deduplicate_name_hash{lc($name)}->[1]; 2007 $matched = 1; 2008 } elsif ($deduplicate_address_hash{lc($address)}) { 2009 $name = $deduplicate_address_hash{lc($address)}->[0]; 2010 $address = $deduplicate_address_hash{lc($address)}->[1]; 2011 $matched = 1; 2012 } 2013 if (!$matched) { 2014 $deduplicate_name_hash{lc($name)} = [ $name, $address ]; 2015 $deduplicate_address_hash{lc($address)} = [ $name, $address ]; 2016 } 2017 $email = format_email($name, $address, 1); 2018 $email = mailmap_email($email); 2019 return $email; 2020} 2021 2022sub save_commits_by_author { 2023 my (@lines) = @_; 2024 2025 my @authors = (); 2026 my @commits = (); 2027 my @subjects = (); 2028 2029 foreach my $line (@lines) { 2030 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 2031 my $author = $1; 2032 $author = deduplicate_email($author); 2033 push(@authors, $author); 2034 } 2035 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 2036 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 2037 } 2038 2039 for (my $i = 0; $i < @authors; $i++) { 2040 my $exists = 0; 2041 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 2042 if (@{$ref}[0] eq $commits[$i] && 2043 @{$ref}[1] eq $subjects[$i]) { 2044 $exists = 1; 2045 last; 2046 } 2047 } 2048 if (!$exists) { 2049 push(@{$commit_author_hash{$authors[$i]}}, 2050 [ ($commits[$i], $subjects[$i]) ]); 2051 } 2052 } 2053} 2054 2055sub save_commits_by_signer { 2056 my (@lines) = @_; 2057 2058 my $commit = ""; 2059 my $subject = ""; 2060 2061 foreach my $line (@lines) { 2062 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 2063 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 2064 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 2065 my @signatures = ($line); 2066 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 2067 my @types = @$types_ref; 2068 my @signers = @$signers_ref; 2069 2070 my $type = $types[0]; 2071 my $signer = $signers[0]; 2072 2073 $signer = deduplicate_email($signer); 2074 2075 my $exists = 0; 2076 foreach my $ref(@{$commit_signer_hash{$signer}}) { 2077 if (@{$ref}[0] eq $commit && 2078 @{$ref}[1] eq $subject && 2079 @{$ref}[2] eq $type) { 2080 $exists = 1; 2081 last; 2082 } 2083 } 2084 if (!$exists) { 2085 push(@{$commit_signer_hash{$signer}}, 2086 [ ($commit, $subject, $type) ]); 2087 } 2088 } 2089 } 2090} 2091 2092sub vcs_assign { 2093 my ($role, $divisor, @lines) = @_; 2094 2095 my %hash; 2096 my $count = 0; 2097 2098 return if (@lines <= 0); 2099 2100 if ($divisor <= 0) { 2101 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 2102 $divisor = 1; 2103 } 2104 2105 @lines = mailmap(@lines); 2106 2107 return if (@lines <= 0); 2108 2109 @lines = sort(@lines); 2110 2111 # uniq -c 2112 $hash{$_}++ for @lines; 2113 2114 # sort -rn 2115 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 2116 my $sign_offs = $hash{$line}; 2117 my $percent = $sign_offs * 100 / $divisor; 2118 2119 $percent = 100 if ($percent > 100); 2120 next if (ignore_email_address($line)); 2121 $count++; 2122 last if ($sign_offs < $email_git_min_signatures || 2123 $count > $email_git_max_maintainers || 2124 $percent < $email_git_min_percent); 2125 push_email_address($line, ''); 2126 if ($output_rolestats) { 2127 my $fmt_percent = sprintf("%.0f", $percent); 2128 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 2129 } else { 2130 add_role($line, $role); 2131 } 2132 } 2133} 2134 2135sub vcs_file_signoffs { 2136 my ($file) = @_; 2137 2138 my $authors_ref; 2139 my $signers_ref; 2140 my $stats_ref; 2141 my @authors = (); 2142 my @signers = (); 2143 my @stats = (); 2144 my $commits; 2145 2146 $vcs_used = vcs_exists(); 2147 return if (!$vcs_used); 2148 2149 my $cmd = $VCS_cmds{"find_signers_cmd"}; 2150 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 2151 2152 ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2153 2154 @signers = @{$signers_ref} if defined $signers_ref; 2155 @authors = @{$authors_ref} if defined $authors_ref; 2156 @stats = @{$stats_ref} if defined $stats_ref; 2157 2158# print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n"); 2159 2160 foreach my $signer (@signers) { 2161 $signer = deduplicate_email($signer); 2162 } 2163 2164 vcs_assign("commit_signer", $commits, @signers); 2165 vcs_assign("authored", $commits, @authors); 2166 if ($#authors == $#stats) { 2167 my $stat_pattern = $VCS_cmds{"stat_pattern"}; 2168 $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern 2169 2170 my $added = 0; 2171 my $deleted = 0; 2172 for (my $i = 0; $i <= $#stats; $i++) { 2173 if ($stats[$i] =~ /$stat_pattern/) { 2174 $added += $1; 2175 $deleted += $2; 2176 } 2177 } 2178 my @tmp_authors = uniq(@authors); 2179 foreach my $author (@tmp_authors) { 2180 $author = deduplicate_email($author); 2181 } 2182 @tmp_authors = uniq(@tmp_authors); 2183 my @list_added = (); 2184 my @list_deleted = (); 2185 foreach my $author (@tmp_authors) { 2186 my $auth_added = 0; 2187 my $auth_deleted = 0; 2188 for (my $i = 0; $i <= $#stats; $i++) { 2189 if ($author eq deduplicate_email($authors[$i]) && 2190 $stats[$i] =~ /$stat_pattern/) { 2191 $auth_added += $1; 2192 $auth_deleted += $2; 2193 } 2194 } 2195 for (my $i = 0; $i < $auth_added; $i++) { 2196 push(@list_added, $author); 2197 } 2198 for (my $i = 0; $i < $auth_deleted; $i++) { 2199 push(@list_deleted, $author); 2200 } 2201 } 2202 vcs_assign("added_lines", $added, @list_added); 2203 vcs_assign("removed_lines", $deleted, @list_deleted); 2204 } 2205} 2206 2207sub vcs_file_blame { 2208 my ($file) = @_; 2209 2210 my @signers = (); 2211 my @all_commits = (); 2212 my @commits = (); 2213 my $total_commits; 2214 my $total_lines; 2215 2216 $vcs_used = vcs_exists(); 2217 return if (!$vcs_used); 2218 2219 @all_commits = vcs_blame($file); 2220 @commits = uniq(@all_commits); 2221 $total_commits = @commits; 2222 $total_lines = @all_commits; 2223 2224 if ($email_git_blame_signatures) { 2225 if (vcs_is_hg()) { 2226 my $commit_count; 2227 my $commit_authors_ref; 2228 my $commit_signers_ref; 2229 my $stats_ref; 2230 my @commit_authors = (); 2231 my @commit_signers = (); 2232 my $commit = join(" -r ", @commits); 2233 my $cmd; 2234 2235 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 2236 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 2237 2238 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2239 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; 2240 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; 2241 2242 push(@signers, @commit_signers); 2243 } else { 2244 foreach my $commit (@commits) { 2245 my $commit_count; 2246 my $commit_authors_ref; 2247 my $commit_signers_ref; 2248 my $stats_ref; 2249 my @commit_authors = (); 2250 my @commit_signers = (); 2251 my $cmd; 2252 2253 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 2254 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 2255 2256 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2257 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; 2258 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; 2259 2260 push(@signers, @commit_signers); 2261 } 2262 } 2263 } 2264 2265 if ($from_filename) { 2266 if ($output_rolestats) { 2267 my @blame_signers; 2268 if (vcs_is_hg()) {{ # Double brace for last exit 2269 my $commit_count; 2270 my @commit_signers = (); 2271 @commits = uniq(@commits); 2272 @commits = sort(@commits); 2273 my $commit = join(" -r ", @commits); 2274 my $cmd; 2275 2276 $cmd = $VCS_cmds{"find_commit_author_cmd"}; 2277 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 2278 2279 my @lines = (); 2280 2281 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 2282 2283 if (!$email_git_penguin_chiefs) { 2284 @lines = grep(!/${penguin_chiefs}/i, @lines); 2285 } 2286 2287 last if !@lines; 2288 2289 my @authors = (); 2290 foreach my $line (@lines) { 2291 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 2292 my $author = $1; 2293 $author = deduplicate_email($author); 2294 push(@authors, $author); 2295 } 2296 } 2297 2298 save_commits_by_author(@lines) if ($interactive); 2299 save_commits_by_signer(@lines) if ($interactive); 2300 2301 push(@signers, @authors); 2302 }} 2303 else { 2304 foreach my $commit (@commits) { 2305 my $i; 2306 my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 2307 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 2308 my @author = vcs_find_author($cmd); 2309 next if !@author; 2310 2311 my $formatted_author = deduplicate_email($author[0]); 2312 2313 my $count = grep(/$commit/, @all_commits); 2314 for ($i = 0; $i < $count ; $i++) { 2315 push(@blame_signers, $formatted_author); 2316 } 2317 } 2318 } 2319 if (@blame_signers) { 2320 vcs_assign("authored lines", $total_lines, @blame_signers); 2321 } 2322 } 2323 foreach my $signer (@signers) { 2324 $signer = deduplicate_email($signer); 2325 } 2326 vcs_assign("commits", $total_commits, @signers); 2327 } else { 2328 foreach my $signer (@signers) { 2329 $signer = deduplicate_email($signer); 2330 } 2331 vcs_assign("modified commits", $total_commits, @signers); 2332 } 2333} 2334 2335sub vcs_file_exists { 2336 my ($file) = @_; 2337 2338 my $exists; 2339 2340 my $vcs_used = vcs_exists(); 2341 return 0 if (!$vcs_used); 2342 2343 my $cmd = $VCS_cmds{"file_exists_cmd"}; 2344 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 2345 $cmd .= " 2>&1"; 2346 $exists = &{$VCS_cmds{"execute_cmd"}}($cmd); 2347 2348 return 0 if ($? != 0); 2349 2350 return $exists; 2351} 2352 2353sub vcs_list_files { 2354 my ($file) = @_; 2355 2356 my @lsfiles = (); 2357 2358 my $vcs_used = vcs_exists(); 2359 return 0 if (!$vcs_used); 2360 2361 my $cmd = $VCS_cmds{"list_files_cmd"}; 2362 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 2363 @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd); 2364 2365 return () if ($? != 0); 2366 2367 return @lsfiles; 2368} 2369 2370sub uniq { 2371 my (@parms) = @_; 2372 2373 my %saw; 2374 @parms = grep(!$saw{$_}++, @parms); 2375 return @parms; 2376} 2377 2378sub sort_and_uniq { 2379 my (@parms) = @_; 2380 2381 my %saw; 2382 @parms = sort @parms; 2383 @parms = grep(!$saw{$_}++, @parms); 2384 return @parms; 2385} 2386 2387sub clean_file_emails { 2388 my (@file_emails) = @_; 2389 my @fmt_emails = (); 2390 2391 foreach my $email (@file_emails) { 2392 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 2393 my ($name, $address) = parse_email($email); 2394 if ($name eq '"[,\.]"') { 2395 $name = ""; 2396 } 2397 2398 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 2399 if (@nw > 2) { 2400 my $first = $nw[@nw - 3]; 2401 my $middle = $nw[@nw - 2]; 2402 my $last = $nw[@nw - 1]; 2403 2404 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 2405 (length($first) == 2 && substr($first, -1) eq ".")) || 2406 (length($middle) == 1 || 2407 (length($middle) == 2 && substr($middle, -1) eq "."))) { 2408 $name = "$first $middle $last"; 2409 } else { 2410 $name = "$middle $last"; 2411 } 2412 } 2413 2414 if (substr($name, -1) =~ /[,\.]/) { 2415 $name = substr($name, 0, length($name) - 1); 2416 } elsif (substr($name, -2) =~ /[,\.]"/) { 2417 $name = substr($name, 0, length($name) - 2) . '"'; 2418 } 2419 2420 if (substr($name, 0, 1) =~ /[,\.]/) { 2421 $name = substr($name, 1, length($name) - 1); 2422 } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 2423 $name = '"' . substr($name, 2, length($name) - 2); 2424 } 2425 2426 my $fmt_email = format_email($name, $address, $email_usename); 2427 push(@fmt_emails, $fmt_email); 2428 } 2429 return @fmt_emails; 2430} 2431 2432sub merge_email { 2433 my @lines; 2434 my %saw; 2435 2436 for (@_) { 2437 my ($address, $role) = @$_; 2438 if (!$saw{$address}) { 2439 if ($output_roles) { 2440 push(@lines, "$address ($role)"); 2441 } else { 2442 push(@lines, $address); 2443 } 2444 $saw{$address} = 1; 2445 } 2446 } 2447 2448 return @lines; 2449} 2450 2451sub output { 2452 my (@parms) = @_; 2453 2454 if ($output_multiline) { 2455 foreach my $line (@parms) { 2456 print("${line}\n"); 2457 } 2458 } else { 2459 print(join($output_separator, @parms)); 2460 print("\n"); 2461 } 2462} 2463 2464my $rfc822re; 2465 2466sub make_rfc822re { 2467# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 2468# comment. We must allow for rfc822_lwsp (or comments) after each of these. 2469# This regexp will only work on addresses which have had comments stripped 2470# and replaced with rfc822_lwsp. 2471 2472 my $specials = '()<>@,;:\\\\".\\[\\]'; 2473 my $controls = '\\000-\\037\\177'; 2474 2475 my $dtext = "[^\\[\\]\\r\\\\]"; 2476 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 2477 2478 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 2479 2480# Use zero-width assertion to spot the limit of an atom. A simple 2481# $rfc822_lwsp* causes the regexp engine to hang occasionally. 2482 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 2483 my $word = "(?:$atom|$quoted_string)"; 2484 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 2485 2486 my $sub_domain = "(?:$atom|$domain_literal)"; 2487 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 2488 2489 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 2490 2491 my $phrase = "$word*"; 2492 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 2493 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 2494 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 2495 2496 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 2497 my $address = "(?:$mailbox|$group)"; 2498 2499 return "$rfc822_lwsp*$address"; 2500} 2501 2502sub rfc822_strip_comments { 2503 my $s = shift; 2504# Recursively remove comments, and replace with a single space. The simpler 2505# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 2506# chars in atoms, for example. 2507 2508 while ($s =~ s/^((?:[^"\\]|\\.)* 2509 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 2510 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 2511 return $s; 2512} 2513 2514# valid: returns true if the parameter is an RFC822 valid address 2515# 2516sub rfc822_valid { 2517 my $s = rfc822_strip_comments(shift); 2518 2519 if (!$rfc822re) { 2520 $rfc822re = make_rfc822re(); 2521 } 2522 2523 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 2524} 2525 2526# validlist: In scalar context, returns true if the parameter is an RFC822 2527# valid list of addresses. 2528# 2529# In list context, returns an empty list on failure (an invalid 2530# address was found); otherwise a list whose first element is the 2531# number of addresses found and whose remaining elements are the 2532# addresses. This is needed to disambiguate failure (invalid) 2533# from success with no addresses found, because an empty string is 2534# a valid list. 2535 2536sub rfc822_validlist { 2537 my $s = rfc822_strip_comments(shift); 2538 2539 if (!$rfc822re) { 2540 $rfc822re = make_rfc822re(); 2541 } 2542 # * null list items are valid according to the RFC 2543 # * the '1' business is to aid in distinguishing failure from no results 2544 2545 my @r; 2546 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 2547 $s =~ m/^$rfc822_char*$/) { 2548 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 2549 push(@r, $1); 2550 } 2551 return wantarray ? (scalar(@r), @r) : 1; 2552 } 2553 return wantarray ? () : 0; 2554} 2555