1#!/usr/bin/env perl 2# (c) 2007, Joe Perches <joe@perches.com> 3# created from checkpatch.pl 4# 5# Print selected MAINTAINERS information for 6# the files modified in a patch or for a file 7# 8# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 9# perl scripts/get_maintainer.pl [OPTIONS] -f <file> 10# 11# Licensed under the terms of the GNU GPL License version 2 12 13use strict; 14use warnings; 15 16my $P = $0; 17my $V = '0.26'; 18 19use Getopt::Long qw(:config no_auto_abbrev); 20 21my $lk_path = "./"; 22my $email = 1; 23my $email_usename = 1; 24my $email_maintainer = 1; 25my $email_reviewer = 1; 26my $email_list = 1; 27my $email_subscriber_list = 0; 28my $email_git = 0; 29my $email_git_all_signature_types = 0; 30my $email_git_blame = 0; 31my $email_git_blame_signatures = 1; 32my $email_git_fallback = 1; 33my $email_git_min_signatures = 1; 34my $email_git_max_maintainers = 5; 35my $email_git_min_percent = 5; 36my $email_git_since = "1-year-ago"; 37my $email_hg_since = "-365"; 38my $interactive = 0; 39my $email_remove_duplicates = 1; 40my $email_use_mailmap = 1; 41my $output_multiline = 1; 42my $output_separator = ", "; 43my $output_roles = 0; 44my $output_rolestats = 1; 45my $scm = 0; 46my $web = 0; 47my $subsystem = 0; 48my $status = 0; 49my $keywords = 1; 50my $sections = 0; 51my $file_emails = 0; 52my $from_filename = 0; 53my $pattern_depth = 0; 54my $version = 0; 55my $help = 0; 56 57my $vcs_used = 0; 58 59my $exit = 0; 60 61my %commit_author_hash; 62my %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 67my @signature_tags = (); 68push(@signature_tags, "Signed-off-by:"); 69push(@signature_tags, "Reviewed-by:"); 70push(@signature_tags, "Acked-by:"); 71 72my $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 73 74# rfc822 email address - preloaded methods go here. 75my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 76my $rfc822_char = '[\\000-\\377]'; 77 78# VCS command support: class-like functions and strings 79 80my %VCS_cmds; 81 82my %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 116my %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 143my $conf = which_conf(".get_maintainer.conf"); 144if (-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 169if (!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 208if ($help != 0) { 209 usage(); 210 exit 0; 211} 212 213if ($version != 0) { 214 print("${P} ${V}\n"); 215 exit 0; 216} 217 218if (-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 227if ($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 243if ($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 250if (!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 257my @typevalue = (); 258my %keyword_hash; 259 260open (my $maint, '<', "${lk_path}MAINTAINERS") 261 or die "$P: Can't open MAINTAINERS: $!\n"; 262while (<$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} 287close($maint); 288 289 290# 291# Read mail address map 292# 293 294my $mailmap; 295 296read_mailmap(); 297 298sub 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 370my @files = (); 371my @range = (); 372my @keyword_tvi = (); 373my @file_emails = (); 374 375if (!@ARGV) { 376 push(@ARGV, "&STDIN"); 377} 378 379foreach 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 454my %email_hash_name; 455my %email_hash_address; 456my @email_to = (); 457my %hash_list_to; 458my @list_to = (); 459my @scm = (); 460my @web = (); 461my @subsystem = (); 462my @status = (); 463my %deduplicate_name_hash = (); 464my %deduplicate_address_hash = (); 465 466my @maintainers = get_maintainers(); 467 468if (@maintainers) { 469 @maintainers = merge_email(@maintainers); 470 output(@maintainers); 471} 472 473if ($scm) { 474 @scm = uniq(@scm); 475 output(@scm); 476} 477 478if ($status) { 479 @status = uniq(@status); 480 output(@status); 481} 482 483if ($subsystem) { 484 @subsystem = uniq(@subsystem); 485 output(@subsystem); 486} 487 488if ($web) { 489 @web = uniq(@web); 490 output(@web); 491} 492 493exit($exit); 494 495sub 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 513sub 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 529sub 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 687sub 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 705sub usage { 706 print <<EOT; 707usage: $P [options] patchfile 708 $P [options] -f file|directory 709version: $V 710 711MAINTAINER 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 738Output 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 743Other 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 751Default options: 752 [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0 753 --remove-duplicates --rolestats] 754 755Notes: 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. 784EOT 785} 786 787sub 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}system/")) { 800 return 1; 801 } 802 return 0; 803} 804 805sub 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 832sub 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 859sub 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 873sub 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 887sub 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 901sub 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 =~ s/[()]//g; 911 $subsystem = $subsystem . "..."; 912 } 913 return $subsystem; 914} 915 916sub get_maintainer_role { 917 my ($index) = @_; 918 919 my $i; 920 my $start = find_starting_index($index); 921 my $end = find_ending_index($index); 922 923 my $role = "unknown"; 924 my $subsystem = get_subsystem_name($index); 925 926 for ($i = $start + 1; $i < $end; $i++) { 927 my $tv = $typevalue[$i]; 928 if ($tv =~ m/^(.):\s*(.*)/) { 929 my $ptype = $1; 930 my $pvalue = $2; 931 if ($ptype eq "S") { 932 $role = $pvalue; 933 } 934 } 935 } 936 937 $role = lc($role); 938 if ($role eq "supported") { 939 $role = "supporter"; 940 } elsif ($role eq "maintained") { 941 $role = "maintainer"; 942 } elsif ($role eq "odd fixes") { 943 $role = "odd fixer"; 944 } elsif ($role eq "orphan") { 945 $role = "orphan minder"; 946 } elsif ($role eq "obsolete") { 947 $role = "obsolete minder"; 948 } elsif ($role eq "buried alive in reporters") { 949 $role = "chief penguin"; 950 } 951 952 return $role . ":" . $subsystem; 953} 954 955sub get_list_role { 956 my ($index) = @_; 957 958 my $subsystem = get_subsystem_name($index); 959 960 if ($subsystem eq "THE REST") { 961 $subsystem = ""; 962 } 963 964 return $subsystem; 965} 966 967sub add_categories { 968 my ($index) = @_; 969 970 my $i; 971 my $start = find_starting_index($index); 972 my $end = find_ending_index($index); 973 974 push(@subsystem, $typevalue[$start]); 975 976 for ($i = $start + 1; $i < $end; $i++) { 977 my $tv = $typevalue[$i]; 978 if ($tv =~ m/^(.):\s*(.*)/) { 979 my $ptype = $1; 980 my $pvalue = $2; 981 if ($ptype eq "L") { 982 my $list_address = $pvalue; 983 my $list_additional = ""; 984 my $list_role = get_list_role($i); 985 986 if ($list_role ne "") { 987 $list_role = ":" . $list_role; 988 } 989 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 990 $list_address = $1; 991 $list_additional = $2; 992 } 993 if ($list_additional =~ m/subscribers-only/) { 994 if ($email_subscriber_list) { 995 if (!$hash_list_to{lc($list_address)}) { 996 $hash_list_to{lc($list_address)} = 1; 997 push(@list_to, [$list_address, 998 "subscriber list${list_role}"]); 999 } 1000 } 1001 } else { 1002 if ($email_list) { 1003 if (!$hash_list_to{lc($list_address)}) { 1004 $hash_list_to{lc($list_address)} = 1; 1005 if ($list_additional =~ m/moderated/) { 1006 push(@list_to, [$list_address, 1007 "moderated list${list_role}"]); 1008 } else { 1009 push(@list_to, [$list_address, 1010 "open list${list_role}"]); 1011 } 1012 } 1013 } 1014 } 1015 } elsif ($ptype eq "M") { 1016 my ($name, $address) = parse_email($pvalue); 1017 if ($name eq "") { 1018 if ($i > 0) { 1019 my $tv = $typevalue[$i - 1]; 1020 if ($tv =~ m/^(.):\s*(.*)/) { 1021 if ($1 eq "P") { 1022 $name = $2; 1023 $pvalue = format_email($name, $address, $email_usename); 1024 } 1025 } 1026 } 1027 } 1028 if ($email_maintainer) { 1029 my $role = get_maintainer_role($i); 1030 push_email_addresses($pvalue, $role); 1031 } 1032 } elsif ($ptype eq "R") { 1033 my ($name, $address) = parse_email($pvalue); 1034 if ($name eq "") { 1035 if ($i > 0) { 1036 my $tv = $typevalue[$i - 1]; 1037 if ($tv =~ m/^(.):\s*(.*)/) { 1038 if ($1 eq "P") { 1039 $name = $2; 1040 $pvalue = format_email($name, $address, $email_usename); 1041 } 1042 } 1043 } 1044 } 1045 if ($email_reviewer) { 1046 my $subsystem = get_subsystem_name($i); 1047 push_email_addresses($pvalue, "reviewer:$subsystem"); 1048 } 1049 } elsif ($ptype eq "T") { 1050 push(@scm, $pvalue); 1051 } elsif ($ptype eq "W") { 1052 push(@web, $pvalue); 1053 } elsif ($ptype eq "S") { 1054 push(@status, $pvalue); 1055 } 1056 } 1057 } 1058} 1059 1060sub email_inuse { 1061 my ($name, $address) = @_; 1062 1063 return 1 if (($name eq "") && ($address eq "")); 1064 return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 1065 return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 1066 1067 return 0; 1068} 1069 1070sub push_email_address { 1071 my ($line, $role) = @_; 1072 1073 my ($name, $address) = parse_email($line); 1074 1075 if ($address eq "") { 1076 return 0; 1077 } 1078 1079 if (!$email_remove_duplicates) { 1080 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1081 } elsif (!email_inuse($name, $address)) { 1082 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1083 $email_hash_name{lc($name)}++ if ($name ne ""); 1084 $email_hash_address{lc($address)}++; 1085 } 1086 1087 return 1; 1088} 1089 1090sub push_email_addresses { 1091 my ($address, $role) = @_; 1092 1093 my @address_list = (); 1094 1095 if (rfc822_valid($address)) { 1096 push_email_address($address, $role); 1097 } elsif (@address_list = rfc822_validlist($address)) { 1098 my $array_count = shift(@address_list); 1099 while (my $entry = shift(@address_list)) { 1100 push_email_address($entry, $role); 1101 } 1102 } else { 1103 if (!push_email_address($address, $role)) { 1104 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 1105 } 1106 } 1107} 1108 1109sub add_role { 1110 my ($line, $role) = @_; 1111 1112 my ($name, $address) = parse_email($line); 1113 my $email = format_email($name, $address, $email_usename); 1114 1115 foreach my $entry (@email_to) { 1116 if ($email_remove_duplicates) { 1117 my ($entry_name, $entry_address) = parse_email($entry->[0]); 1118 if (($name eq $entry_name || $address eq $entry_address) 1119 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1120 ) { 1121 if ($entry->[1] eq "") { 1122 $entry->[1] = "$role"; 1123 } else { 1124 $entry->[1] = "$entry->[1],$role"; 1125 } 1126 } 1127 } else { 1128 if ($email eq $entry->[0] 1129 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1130 ) { 1131 if ($entry->[1] eq "") { 1132 $entry->[1] = "$role"; 1133 } else { 1134 $entry->[1] = "$entry->[1],$role"; 1135 } 1136 } 1137 } 1138 } 1139} 1140 1141sub which { 1142 my ($bin) = @_; 1143 1144 foreach my $path (split(/:/, $ENV{PATH})) { 1145 if (-e "$path/$bin") { 1146 return "$path/$bin"; 1147 } 1148 } 1149 1150 return ""; 1151} 1152 1153sub which_conf { 1154 my ($conf) = @_; 1155 1156 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1157 if (-e "$path/$conf") { 1158 return "$path/$conf"; 1159 } 1160 } 1161 1162 return ""; 1163} 1164 1165sub mailmap_email { 1166 my ($line) = @_; 1167 1168 my ($name, $address) = parse_email($line); 1169 my $email = format_email($name, $address, 1); 1170 my $real_name = $name; 1171 my $real_address = $address; 1172 1173 if (exists $mailmap->{names}->{$email} || 1174 exists $mailmap->{addresses}->{$email}) { 1175 if (exists $mailmap->{names}->{$email}) { 1176 $real_name = $mailmap->{names}->{$email}; 1177 } 1178 if (exists $mailmap->{addresses}->{$email}) { 1179 $real_address = $mailmap->{addresses}->{$email}; 1180 } 1181 } else { 1182 if (exists $mailmap->{names}->{$address}) { 1183 $real_name = $mailmap->{names}->{$address}; 1184 } 1185 if (exists $mailmap->{addresses}->{$address}) { 1186 $real_address = $mailmap->{addresses}->{$address}; 1187 } 1188 } 1189 return format_email($real_name, $real_address, 1); 1190} 1191 1192sub mailmap { 1193 my (@addresses) = @_; 1194 1195 my @mapped_emails = (); 1196 foreach my $line (@addresses) { 1197 push(@mapped_emails, mailmap_email($line)); 1198 } 1199 merge_by_realname(@mapped_emails) if ($email_use_mailmap); 1200 return @mapped_emails; 1201} 1202 1203sub merge_by_realname { 1204 my %address_map; 1205 my (@emails) = @_; 1206 1207 foreach my $email (@emails) { 1208 my ($name, $address) = parse_email($email); 1209 if (exists $address_map{$name}) { 1210 $address = $address_map{$name}; 1211 $email = format_email($name, $address, 1); 1212 } else { 1213 $address_map{$name} = $address; 1214 } 1215 } 1216} 1217 1218sub git_execute_cmd { 1219 my ($cmd) = @_; 1220 my @lines = (); 1221 1222 my $output = `$cmd`; 1223 $output =~ s/^\s*//gm; 1224 @lines = split("\n", $output); 1225 1226 return @lines; 1227} 1228 1229sub hg_execute_cmd { 1230 my ($cmd) = @_; 1231 my @lines = (); 1232 1233 my $output = `$cmd`; 1234 @lines = split("\n", $output); 1235 1236 return @lines; 1237} 1238 1239sub extract_formatted_signatures { 1240 my (@signature_lines) = @_; 1241 1242 my @type = @signature_lines; 1243 1244 s/\s*(.*):.*/$1/ for (@type); 1245 1246 # cut -f2- -d":" 1247 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1248 1249## Reformat email addresses (with names) to avoid badly written signatures 1250 1251 foreach my $signer (@signature_lines) { 1252 $signer = deduplicate_email($signer); 1253 } 1254 1255 return (\@type, \@signature_lines); 1256} 1257 1258sub vcs_find_signers { 1259 my ($cmd) = @_; 1260 my $commits; 1261 my @lines = (); 1262 my @signatures = (); 1263 1264 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1265 1266 my $pattern = $VCS_cmds{"commit_pattern"}; 1267 1268 $commits = grep(/$pattern/, @lines); # of commits 1269 1270 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1271 1272 return (0, @signatures) if !@signatures; 1273 1274 save_commits_by_author(@lines) if ($interactive); 1275 save_commits_by_signer(@lines) if ($interactive); 1276 1277 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1278 1279 return ($commits, @$signers_ref); 1280} 1281 1282sub vcs_find_author { 1283 my ($cmd) = @_; 1284 my @lines = (); 1285 1286 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1287 1288 return @lines if !@lines; 1289 1290 my @authors = (); 1291 foreach my $line (@lines) { 1292 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1293 my $author = $1; 1294 my ($name, $address) = parse_email($author); 1295 $author = format_email($name, $address, 1); 1296 push(@authors, $author); 1297 } 1298 } 1299 1300 save_commits_by_author(@lines) if ($interactive); 1301 save_commits_by_signer(@lines) if ($interactive); 1302 1303 return @authors; 1304} 1305 1306sub vcs_save_commits { 1307 my ($cmd) = @_; 1308 my @lines = (); 1309 my @commits = (); 1310 1311 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1312 1313 foreach my $line (@lines) { 1314 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 1315 push(@commits, $1); 1316 } 1317 } 1318 1319 return @commits; 1320} 1321 1322sub vcs_blame { 1323 my ($file) = @_; 1324 my $cmd; 1325 my @commits = (); 1326 1327 return @commits if (!(-f $file)); 1328 1329 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1330 my @all_commits = (); 1331 1332 $cmd = $VCS_cmds{"blame_file_cmd"}; 1333 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1334 @all_commits = vcs_save_commits($cmd); 1335 1336 foreach my $file_range_diff (@range) { 1337 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1338 my $diff_file = $1; 1339 my $diff_start = $2; 1340 my $diff_length = $3; 1341 next if ("$file" ne "$diff_file"); 1342 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1343 push(@commits, $all_commits[$i]); 1344 } 1345 } 1346 } elsif (@range) { 1347 foreach my $file_range_diff (@range) { 1348 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1349 my $diff_file = $1; 1350 my $diff_start = $2; 1351 my $diff_length = $3; 1352 next if ("$file" ne "$diff_file"); 1353 $cmd = $VCS_cmds{"blame_range_cmd"}; 1354 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1355 push(@commits, vcs_save_commits($cmd)); 1356 } 1357 } else { 1358 $cmd = $VCS_cmds{"blame_file_cmd"}; 1359 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1360 @commits = vcs_save_commits($cmd); 1361 } 1362 1363 foreach my $commit (@commits) { 1364 $commit =~ s/^\^//g; 1365 } 1366 1367 return @commits; 1368} 1369 1370my $printed_novcs = 0; 1371sub vcs_exists { 1372 %VCS_cmds = %VCS_cmds_git; 1373 return 1 if eval $VCS_cmds{"available"}; 1374 %VCS_cmds = %VCS_cmds_hg; 1375 return 2 if eval $VCS_cmds{"available"}; 1376 %VCS_cmds = (); 1377 if (!$printed_novcs) { 1378 warn("$P: No supported VCS found. Add --nogit to options?\n"); 1379 warn("Using a git repository produces better results.\n"); 1380 warn("Try latest git repository using:\n"); 1381 warn("git clone https://gitlab.com/qemu-project/qemu.git\n"); 1382 $printed_novcs = 1; 1383 } 1384 return 0; 1385} 1386 1387sub vcs_is_git { 1388 vcs_exists(); 1389 return $vcs_used == 1; 1390} 1391 1392sub vcs_is_hg { 1393 return $vcs_used == 2; 1394} 1395 1396sub interactive_get_maintainers { 1397 my ($list_ref) = @_; 1398 my @list = @$list_ref; 1399 1400 vcs_exists(); 1401 1402 my %selected; 1403 my %authored; 1404 my %signed; 1405 my $count = 0; 1406 my $maintained = 0; 1407 foreach my $entry (@list) { 1408 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i); 1409 $selected{$count} = 1; 1410 $authored{$count} = 0; 1411 $signed{$count} = 0; 1412 $count++; 1413 } 1414 1415 #menu loop 1416 my $done = 0; 1417 my $print_options = 0; 1418 my $redraw = 1; 1419 while (!$done) { 1420 $count = 0; 1421 if ($redraw) { 1422 printf STDERR "\n%1s %2s %-65s", 1423 "*", "#", "email/list and role:stats"; 1424 if ($email_git || 1425 ($email_git_fallback && !$maintained) || 1426 $email_git_blame) { 1427 print STDERR "auth sign"; 1428 } 1429 print STDERR "\n"; 1430 foreach my $entry (@list) { 1431 my $email = $entry->[0]; 1432 my $role = $entry->[1]; 1433 my $sel = ""; 1434 $sel = "*" if ($selected{$count}); 1435 my $commit_author = $commit_author_hash{$email}; 1436 my $commit_signer = $commit_signer_hash{$email}; 1437 my $authored = 0; 1438 my $signed = 0; 1439 $authored++ for (@{$commit_author}); 1440 $signed++ for (@{$commit_signer}); 1441 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1442 printf STDERR "%4d %4d", $authored, $signed 1443 if ($authored > 0 || $signed > 0); 1444 printf STDERR "\n %s\n", $role; 1445 if ($authored{$count}) { 1446 my $commit_author = $commit_author_hash{$email}; 1447 foreach my $ref (@{$commit_author}) { 1448 print STDERR " Author: @{$ref}[1]\n"; 1449 } 1450 } 1451 if ($signed{$count}) { 1452 my $commit_signer = $commit_signer_hash{$email}; 1453 foreach my $ref (@{$commit_signer}) { 1454 print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1455 } 1456 } 1457 1458 $count++; 1459 } 1460 } 1461 my $date_ref = \$email_git_since; 1462 $date_ref = \$email_hg_since if (vcs_is_hg()); 1463 if ($print_options) { 1464 $print_options = 0; 1465 if (vcs_exists()) { 1466 print STDERR <<EOT 1467 1468Version Control options: 1469g use git history [$email_git] 1470gf use git-fallback [$email_git_fallback] 1471b use git blame [$email_git_blame] 1472bs use blame signatures [$email_git_blame_signatures] 1473c# minimum commits [$email_git_min_signatures] 1474%# min percent [$email_git_min_percent] 1475d# history to use [$$date_ref] 1476x# max maintainers [$email_git_max_maintainers] 1477t all signature types [$email_git_all_signature_types] 1478m use .mailmap [$email_use_mailmap] 1479EOT 1480 } 1481 print STDERR <<EOT 1482 1483Additional options: 14840 toggle all 1485tm toggle maintainers 1486tg toggle git entries 1487tl toggle open list entries 1488ts toggle subscriber list entries 1489f emails in file [$file_emails] 1490k keywords in file [$keywords] 1491r remove duplicates [$email_remove_duplicates] 1492p# pattern match depth [$pattern_depth] 1493EOT 1494 } 1495 print STDERR 1496"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1497 1498 my $input = <STDIN>; 1499 chomp($input); 1500 1501 $redraw = 1; 1502 my $rerun = 0; 1503 my @wish = split(/[, ]+/, $input); 1504 foreach my $nr (@wish) { 1505 $nr = lc($nr); 1506 my $sel = substr($nr, 0, 1); 1507 my $str = substr($nr, 1); 1508 my $val = 0; 1509 $val = $1 if $str =~ /^(\d+)$/; 1510 1511 if ($sel eq "y") { 1512 $interactive = 0; 1513 $done = 1; 1514 $output_rolestats = 0; 1515 $output_roles = 0; 1516 last; 1517 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1518 $selected{$nr - 1} = !$selected{$nr - 1}; 1519 } elsif ($sel eq "*" || $sel eq '^') { 1520 my $toggle = 0; 1521 $toggle = 1 if ($sel eq '*'); 1522 for (my $i = 0; $i < $count; $i++) { 1523 $selected{$i} = $toggle; 1524 } 1525 } elsif ($sel eq "0") { 1526 for (my $i = 0; $i < $count; $i++) { 1527 $selected{$i} = !$selected{$i}; 1528 } 1529 } elsif ($sel eq "t") { 1530 if (lc($str) eq "m") { 1531 for (my $i = 0; $i < $count; $i++) { 1532 $selected{$i} = !$selected{$i} 1533 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i); 1534 } 1535 } elsif (lc($str) eq "g") { 1536 for (my $i = 0; $i < $count; $i++) { 1537 $selected{$i} = !$selected{$i} 1538 if ($list[$i]->[1] =~ /^(author|commit|signer)/i); 1539 } 1540 } elsif (lc($str) eq "l") { 1541 for (my $i = 0; $i < $count; $i++) { 1542 $selected{$i} = !$selected{$i} 1543 if ($list[$i]->[1] =~ /^(open list)/i); 1544 } 1545 } elsif (lc($str) eq "s") { 1546 for (my $i = 0; $i < $count; $i++) { 1547 $selected{$i} = !$selected{$i} 1548 if ($list[$i]->[1] =~ /^(subscriber list)/i); 1549 } 1550 } 1551 } elsif ($sel eq "a") { 1552 if ($val > 0 && $val <= $count) { 1553 $authored{$val - 1} = !$authored{$val - 1}; 1554 } elsif ($str eq '*' || $str eq '^') { 1555 my $toggle = 0; 1556 $toggle = 1 if ($str eq '*'); 1557 for (my $i = 0; $i < $count; $i++) { 1558 $authored{$i} = $toggle; 1559 } 1560 } 1561 } elsif ($sel eq "s") { 1562 if ($val > 0 && $val <= $count) { 1563 $signed{$val - 1} = !$signed{$val - 1}; 1564 } elsif ($str eq '*' || $str eq '^') { 1565 my $toggle = 0; 1566 $toggle = 1 if ($str eq '*'); 1567 for (my $i = 0; $i < $count; $i++) { 1568 $signed{$i} = $toggle; 1569 } 1570 } 1571 } elsif ($sel eq "o") { 1572 $print_options = 1; 1573 $redraw = 1; 1574 } elsif ($sel eq "g") { 1575 if ($str eq "f") { 1576 bool_invert(\$email_git_fallback); 1577 } else { 1578 bool_invert(\$email_git); 1579 } 1580 $rerun = 1; 1581 } elsif ($sel eq "b") { 1582 if ($str eq "s") { 1583 bool_invert(\$email_git_blame_signatures); 1584 } else { 1585 bool_invert(\$email_git_blame); 1586 } 1587 $rerun = 1; 1588 } elsif ($sel eq "c") { 1589 if ($val > 0) { 1590 $email_git_min_signatures = $val; 1591 $rerun = 1; 1592 } 1593 } elsif ($sel eq "x") { 1594 if ($val > 0) { 1595 $email_git_max_maintainers = $val; 1596 $rerun = 1; 1597 } 1598 } elsif ($sel eq "%") { 1599 if ($str ne "" && $val >= 0) { 1600 $email_git_min_percent = $val; 1601 $rerun = 1; 1602 } 1603 } elsif ($sel eq "d") { 1604 if (vcs_is_git()) { 1605 $email_git_since = $str; 1606 } elsif (vcs_is_hg()) { 1607 $email_hg_since = $str; 1608 } 1609 $rerun = 1; 1610 } elsif ($sel eq "t") { 1611 bool_invert(\$email_git_all_signature_types); 1612 $rerun = 1; 1613 } elsif ($sel eq "f") { 1614 bool_invert(\$file_emails); 1615 $rerun = 1; 1616 } elsif ($sel eq "r") { 1617 bool_invert(\$email_remove_duplicates); 1618 $rerun = 1; 1619 } elsif ($sel eq "m") { 1620 bool_invert(\$email_use_mailmap); 1621 read_mailmap(); 1622 $rerun = 1; 1623 } elsif ($sel eq "k") { 1624 bool_invert(\$keywords); 1625 $rerun = 1; 1626 } elsif ($sel eq "p") { 1627 if ($str ne "" && $val >= 0) { 1628 $pattern_depth = $val; 1629 $rerun = 1; 1630 } 1631 } elsif ($sel eq "h" || $sel eq "?") { 1632 print STDERR <<EOT 1633 1634Interactive mode allows you to select the various maintainers, submitters, 1635commit signers and mailing lists that could be CC'd on a patch. 1636 1637Any *'d entry is selected. 1638 1639If you have git or hg installed, you can choose to summarize the commit 1640history of files in the patch. Also, each line of the current file can 1641be matched to its commit author and that commits signers with blame. 1642 1643Various knobs exist to control the length of time for active commit 1644tracking, the maximum number of commit authors and signers to add, 1645and such. 1646 1647Enter selections at the prompt until you are satisfied that the selected 1648maintainers are appropriate. You may enter multiple selections separated 1649by either commas or spaces. 1650 1651EOT 1652 } else { 1653 print STDERR "invalid option: '$nr'\n"; 1654 $redraw = 0; 1655 } 1656 } 1657 if ($rerun) { 1658 print STDERR "git-blame can be very slow, please have patience..." 1659 if ($email_git_blame); 1660 goto &get_maintainers; 1661 } 1662 } 1663 1664 #drop not selected entries 1665 $count = 0; 1666 my @new_emailto = (); 1667 foreach my $entry (@list) { 1668 if ($selected{$count}) { 1669 push(@new_emailto, $list[$count]); 1670 } 1671 $count++; 1672 } 1673 return @new_emailto; 1674} 1675 1676sub bool_invert { 1677 my ($bool_ref) = @_; 1678 1679 if ($$bool_ref) { 1680 $$bool_ref = 0; 1681 } else { 1682 $$bool_ref = 1; 1683 } 1684} 1685 1686sub deduplicate_email { 1687 my ($email) = @_; 1688 1689 my $matched = 0; 1690 my ($name, $address) = parse_email($email); 1691 $email = format_email($name, $address, 1); 1692 $email = mailmap_email($email); 1693 1694 return $email if (!$email_remove_duplicates); 1695 1696 ($name, $address) = parse_email($email); 1697 1698 if ($name ne "" && $deduplicate_name_hash{lc($name)}) { 1699 $name = $deduplicate_name_hash{lc($name)}->[0]; 1700 $address = $deduplicate_name_hash{lc($name)}->[1]; 1701 $matched = 1; 1702 } elsif ($deduplicate_address_hash{lc($address)}) { 1703 $name = $deduplicate_address_hash{lc($address)}->[0]; 1704 $address = $deduplicate_address_hash{lc($address)}->[1]; 1705 $matched = 1; 1706 } 1707 if (!$matched) { 1708 $deduplicate_name_hash{lc($name)} = [ $name, $address ]; 1709 $deduplicate_address_hash{lc($address)} = [ $name, $address ]; 1710 } 1711 $email = format_email($name, $address, 1); 1712 $email = mailmap_email($email); 1713 return $email; 1714} 1715 1716sub save_commits_by_author { 1717 my (@lines) = @_; 1718 1719 my @authors = (); 1720 my @commits = (); 1721 my @subjects = (); 1722 1723 foreach my $line (@lines) { 1724 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1725 my $author = $1; 1726 $author = deduplicate_email($author); 1727 push(@authors, $author); 1728 } 1729 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1730 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1731 } 1732 1733 for (my $i = 0; $i < @authors; $i++) { 1734 my $exists = 0; 1735 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 1736 if (@{$ref}[0] eq $commits[$i] && 1737 @{$ref}[1] eq $subjects[$i]) { 1738 $exists = 1; 1739 last; 1740 } 1741 } 1742 if (!$exists) { 1743 push(@{$commit_author_hash{$authors[$i]}}, 1744 [ ($commits[$i], $subjects[$i]) ]); 1745 } 1746 } 1747} 1748 1749sub save_commits_by_signer { 1750 my (@lines) = @_; 1751 1752 my $commit = ""; 1753 my $subject = ""; 1754 1755 foreach my $line (@lines) { 1756 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1757 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1758 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 1759 my @signatures = ($line); 1760 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1761 my @types = @$types_ref; 1762 my @signers = @$signers_ref; 1763 1764 my $type = $types[0]; 1765 my $signer = $signers[0]; 1766 1767 $signer = deduplicate_email($signer); 1768 1769 my $exists = 0; 1770 foreach my $ref(@{$commit_signer_hash{$signer}}) { 1771 if (@{$ref}[0] eq $commit && 1772 @{$ref}[1] eq $subject && 1773 @{$ref}[2] eq $type) { 1774 $exists = 1; 1775 last; 1776 } 1777 } 1778 if (!$exists) { 1779 push(@{$commit_signer_hash{$signer}}, 1780 [ ($commit, $subject, $type) ]); 1781 } 1782 } 1783 } 1784} 1785 1786sub vcs_assign { 1787 my ($role, $divisor, @lines) = @_; 1788 1789 my %hash; 1790 my $count = 0; 1791 1792 return if (@lines <= 0); 1793 1794 if ($divisor <= 0) { 1795 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 1796 $divisor = 1; 1797 } 1798 1799 @lines = mailmap(@lines); 1800 1801 return if (@lines <= 0); 1802 1803 @lines = sort(@lines); 1804 1805 # uniq -c 1806 $hash{$_}++ for @lines; 1807 1808 # sort -rn 1809 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 1810 my $sign_offs = $hash{$line}; 1811 my $percent = $sign_offs * 100 / $divisor; 1812 1813 $percent = 100 if ($percent > 100); 1814 $count++; 1815 last if ($sign_offs < $email_git_min_signatures || 1816 $count > $email_git_max_maintainers || 1817 $percent < $email_git_min_percent); 1818 push_email_address($line, ''); 1819 if ($output_rolestats) { 1820 my $fmt_percent = sprintf("%.0f", $percent); 1821 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1822 } else { 1823 add_role($line, $role); 1824 } 1825 } 1826} 1827 1828sub vcs_file_signoffs { 1829 my ($file) = @_; 1830 1831 my @signers = (); 1832 my $commits; 1833 1834 $vcs_used = vcs_exists(); 1835 return if (!$vcs_used); 1836 1837 my $cmd = $VCS_cmds{"find_signers_cmd"}; 1838 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1839 1840 ($commits, @signers) = vcs_find_signers($cmd); 1841 1842 foreach my $signer (@signers) { 1843 $signer = deduplicate_email($signer); 1844 } 1845 1846 vcs_assign("commit_signer", $commits, @signers); 1847} 1848 1849sub vcs_file_blame { 1850 my ($file) = @_; 1851 1852 my @signers = (); 1853 my @all_commits = (); 1854 my @commits = (); 1855 my $total_commits; 1856 my $total_lines; 1857 1858 $vcs_used = vcs_exists(); 1859 return if (!$vcs_used); 1860 1861 @all_commits = vcs_blame($file); 1862 @commits = uniq(@all_commits); 1863 $total_commits = @commits; 1864 $total_lines = @all_commits; 1865 1866 if ($email_git_blame_signatures) { 1867 if (vcs_is_hg()) { 1868 my $commit_count; 1869 my @commit_signers = (); 1870 my $commit = join(" -r ", @commits); 1871 my $cmd; 1872 1873 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1874 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1875 1876 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1877 1878 push(@signers, @commit_signers); 1879 } else { 1880 foreach my $commit (@commits) { 1881 my $commit_count; 1882 my @commit_signers = (); 1883 my $cmd; 1884 1885 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1886 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1887 1888 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1889 1890 push(@signers, @commit_signers); 1891 } 1892 } 1893 } 1894 1895 if ($from_filename) { 1896 if ($output_rolestats) { 1897 my @blame_signers; 1898 if (vcs_is_hg()) {{ # Double brace for last exit 1899 my $commit_count; 1900 my @commit_signers = (); 1901 @commits = uniq(@commits); 1902 @commits = sort(@commits); 1903 my $commit = join(" -r ", @commits); 1904 my $cmd; 1905 1906 $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1907 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1908 1909 my @lines = (); 1910 1911 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1912 1913 last if !@lines; 1914 1915 my @authors = (); 1916 foreach my $line (@lines) { 1917 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1918 my $author = $1; 1919 $author = deduplicate_email($author); 1920 push(@authors, $author); 1921 } 1922 } 1923 1924 save_commits_by_author(@lines) if ($interactive); 1925 save_commits_by_signer(@lines) if ($interactive); 1926 1927 push(@signers, @authors); 1928 }} 1929 else { 1930 foreach my $commit (@commits) { 1931 my $i; 1932 my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1933 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1934 my @author = vcs_find_author($cmd); 1935 next if !@author; 1936 1937 my $formatted_author = deduplicate_email($author[0]); 1938 1939 my $count = grep(/$commit/, @all_commits); 1940 for ($i = 0; $i < $count ; $i++) { 1941 push(@blame_signers, $formatted_author); 1942 } 1943 } 1944 } 1945 if (@blame_signers) { 1946 vcs_assign("authored lines", $total_lines, @blame_signers); 1947 } 1948 } 1949 foreach my $signer (@signers) { 1950 $signer = deduplicate_email($signer); 1951 } 1952 vcs_assign("commits", $total_commits, @signers); 1953 } else { 1954 foreach my $signer (@signers) { 1955 $signer = deduplicate_email($signer); 1956 } 1957 vcs_assign("modified commits", $total_commits, @signers); 1958 } 1959} 1960 1961sub uniq { 1962 my (@parms) = @_; 1963 1964 my %saw; 1965 @parms = grep(!$saw{$_}++, @parms); 1966 return @parms; 1967} 1968 1969sub sort_and_uniq { 1970 my (@parms) = @_; 1971 1972 my %saw; 1973 @parms = sort @parms; 1974 @parms = grep(!$saw{$_}++, @parms); 1975 return @parms; 1976} 1977 1978sub clean_file_emails { 1979 my (@file_emails) = @_; 1980 my @fmt_emails = (); 1981 1982 foreach my $email (@file_emails) { 1983 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 1984 my ($name, $address) = parse_email($email); 1985 if ($name eq '"[,\.]"') { 1986 $name = ""; 1987 } 1988 1989 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 1990 if (@nw > 2) { 1991 my $first = $nw[@nw - 3]; 1992 my $middle = $nw[@nw - 2]; 1993 my $last = $nw[@nw - 1]; 1994 1995 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 1996 (length($first) == 2 && substr($first, -1) eq ".")) || 1997 (length($middle) == 1 || 1998 (length($middle) == 2 && substr($middle, -1) eq "."))) { 1999 $name = "$first $middle $last"; 2000 } else { 2001 $name = "$middle $last"; 2002 } 2003 } 2004 2005 if (substr($name, -1) =~ /[,\.]/) { 2006 $name = substr($name, 0, length($name) - 1); 2007 } elsif (substr($name, -2) =~ /[,\.]"/) { 2008 $name = substr($name, 0, length($name) - 2) . '"'; 2009 } 2010 2011 if (substr($name, 0, 1) =~ /[,\.]/) { 2012 $name = substr($name, 1, length($name) - 1); 2013 } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 2014 $name = '"' . substr($name, 2, length($name) - 2); 2015 } 2016 2017 my $fmt_email = format_email($name, $address, $email_usename); 2018 push(@fmt_emails, $fmt_email); 2019 } 2020 return @fmt_emails; 2021} 2022 2023sub merge_email { 2024 my @lines; 2025 my %saw; 2026 2027 for (@_) { 2028 my ($address, $role) = @$_; 2029 if (!$saw{$address}) { 2030 if ($output_roles) { 2031 push(@lines, "$address ($role)"); 2032 } else { 2033 push(@lines, $address); 2034 } 2035 $saw{$address} = 1; 2036 } 2037 } 2038 2039 return @lines; 2040} 2041 2042sub output { 2043 my (@parms) = @_; 2044 2045 if ($output_multiline) { 2046 foreach my $line (@parms) { 2047 print("${line}\n"); 2048 } 2049 } else { 2050 print(join($output_separator, @parms)); 2051 print("\n"); 2052 } 2053} 2054 2055my $rfc822re; 2056 2057sub make_rfc822re { 2058# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 2059# comment. We must allow for rfc822_lwsp (or comments) after each of these. 2060# This regexp will only work on addresses which have had comments stripped 2061# and replaced with rfc822_lwsp. 2062 2063 my $specials = '()<>@,;:\\\\".\\[\\]'; 2064 my $controls = '\\000-\\037\\177'; 2065 2066 my $dtext = "[^\\[\\]\\r\\\\]"; 2067 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 2068 2069 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 2070 2071# Use zero-width assertion to spot the limit of an atom. A simple 2072# $rfc822_lwsp* causes the regexp engine to hang occasionally. 2073 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 2074 my $word = "(?:$atom|$quoted_string)"; 2075 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 2076 2077 my $sub_domain = "(?:$atom|$domain_literal)"; 2078 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 2079 2080 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 2081 2082 my $phrase = "$word*"; 2083 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 2084 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 2085 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 2086 2087 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 2088 my $address = "(?:$mailbox|$group)"; 2089 2090 return "$rfc822_lwsp*$address"; 2091} 2092 2093sub rfc822_strip_comments { 2094 my $s = shift; 2095# Recursively remove comments, and replace with a single space. The simpler 2096# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 2097# chars in atoms, for example. 2098 2099 while ($s =~ s/^((?:[^"\\]|\\.)* 2100 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 2101 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 2102 return $s; 2103} 2104 2105# valid: returns true if the parameter is an RFC822 valid address 2106# 2107sub rfc822_valid { 2108 my $s = rfc822_strip_comments(shift); 2109 2110 if (!$rfc822re) { 2111 $rfc822re = make_rfc822re(); 2112 } 2113 2114 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 2115} 2116 2117# validlist: In scalar context, returns true if the parameter is an RFC822 2118# valid list of addresses. 2119# 2120# In list context, returns an empty list on failure (an invalid 2121# address was found); otherwise a list whose first element is the 2122# number of addresses found and whose remaining elements are the 2123# addresses. This is needed to disambiguate failure (invalid) 2124# from success with no addresses found, because an empty string is 2125# a valid list. 2126 2127sub rfc822_validlist { 2128 my $s = rfc822_strip_comments(shift); 2129 2130 if (!$rfc822re) { 2131 $rfc822re = make_rfc822re(); 2132 } 2133 # * null list items are valid according to the RFC 2134 # * the '1' business is to aid in distinguishing failure from no results 2135 2136 my @r; 2137 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 2138 $s =~ m/^$rfc822_char*$/) { 2139 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 2140 push(@r, $1); 2141 } 2142 return wantarray ? (scalar(@r), @r) : 1; 2143 } 2144 return wantarray ? () : 0; 2145} 2146