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