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