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