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