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