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