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