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 foreach my $file (@files) { 655 if ($email && 656 ($email_git || ($email_git_fallback && 657 !$exact_pattern_match_hash{$file}))) { 658 vcs_file_signoffs($file); 659 } 660 if ($email && $email_git_blame) { 661 vcs_file_blame($file); 662 } 663 } 664 665 if ($email) { 666 foreach my $chief (@penguin_chief) { 667 if ($chief =~ m/^(.*):(.*)/) { 668 my $email_address; 669 670 $email_address = format_email($1, $2, $email_usename); 671 if ($email_git_penguin_chiefs) { 672 push(@email_to, [$email_address, 'chief penguin']); 673 } else { 674 @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 675 } 676 } 677 } 678 679 foreach my $email (@file_emails) { 680 my ($name, $address) = parse_email($email); 681 682 my $tmp_email = format_email($name, $address, $email_usename); 683 push_email_address($tmp_email, ''); 684 add_role($tmp_email, 'in file'); 685 } 686 } 687 688 my @to = (); 689 if ($email || $email_list) { 690 if ($email) { 691 @to = (@to, @email_to); 692 } 693 if ($email_list) { 694 @to = (@to, @list_to); 695 } 696 } 697 698 if ($interactive) { 699 @to = interactive_get_maintainers(\@to); 700 } 701 702 return @to; 703} 704 705sub file_match_pattern { 706 my ($file, $pattern) = @_; 707 if (substr($pattern, -1) eq "/") { 708 if ($file =~ m@^$pattern@) { 709 return 1; 710 } 711 } else { 712 if ($file =~ m@^$pattern@) { 713 my $s1 = ($file =~ tr@/@@); 714 my $s2 = ($pattern =~ tr@/@@); 715 if ($s1 == $s2) { 716 return 1; 717 } 718 } 719 } 720 return 0; 721} 722 723sub usage { 724 print <<EOT; 725usage: $P [options] patchfile 726 $P [options] -f file|directory 727version: $V 728 729MAINTAINER field selection options: 730 --email => print email address(es) if any 731 --git => include recent git \*-by: signers 732 --git-all-signature-types => include signers regardless of signature type 733 or use only ${signature_pattern} signers (default: $email_git_all_signature_types) 734 --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback) 735 --git-chief-penguins => include ${penguin_chiefs} 736 --git-min-signatures => number of signatures required (default: $email_git_min_signatures) 737 --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers) 738 --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent) 739 --git-blame => use git blame to find modified commits for patch or file 740 --git-since => git history to use (default: $email_git_since) 741 --hg-since => hg history to use (default: $email_hg_since) 742 --interactive => display a menu (mostly useful if used with the --git option) 743 --m => include maintainer(s) if any 744 --n => include name 'Full Name <addr\@domain.tld>' 745 --l => include list(s) if any 746 --s => include subscriber only list(s) if any 747 --remove-duplicates => minimize duplicate email names/addresses 748 --roles => show roles (status:subsystem, git-signer, list, etc...) 749 --rolestats => show roles and statistics (commits/total_commits, %) 750 --file-emails => add email addresses found in -f file (default: 0 (off)) 751 --scm => print SCM tree(s) if any 752 --status => print status if any 753 --subsystem => print subsystem name if any 754 --web => print website(s) if any 755 756Output type options: 757 --separator [, ] => separator for multiple entries on 1 line 758 using --separator also sets --nomultiline if --separator is not [, ] 759 --multiline => print 1 entry per line 760 761Other options: 762 --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 763 --keywords => scan patch for keywords (default: $keywords) 764 --sections => print all of the subsystem sections with pattern matches 765 --mailmap => use .mailmap file (default: $email_use_mailmap) 766 --version => show version 767 --help => show this help information 768 769Default options: 770 [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0 771 --remove-duplicates --rolestats] 772 773Notes: 774 Using "-f directory" may give unexpected results: 775 Used with "--git", git signators for _all_ files in and below 776 directory are examined as git recurses directories. 777 Any specified X: (exclude) pattern matches are _not_ ignored. 778 Used with "--nogit", directory is used as a pattern match, 779 no individual file within the directory or subdirectory 780 is matched. 781 Used with "--git-blame", does not iterate all files in directory 782 Using "--git-blame" is slow and may add old committers and authors 783 that are no longer active maintainers to the output. 784 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 785 other automated tools that expect only ["name"] <email address> 786 may not work because of additional output after <email address>. 787 Using "--rolestats" and "--git-blame" shows the #/total=% commits, 788 not the percentage of the entire file authored. # of commits is 789 not a good measure of amount of code authored. 1 major commit may 790 contain a thousand lines, 5 trivial commits may modify a single line. 791 If git is not installed, but mercurial (hg) is installed and an .hg 792 repository exists, the following options apply to mercurial: 793 --git, 794 --git-min-signatures, --git-max-maintainers, --git-min-percent, and 795 --git-blame 796 Use --hg-since not --git-since to control date selection 797 File ".get_maintainer.conf", if it exists in the QEMU source root 798 directory, can change whatever get_maintainer defaults are desired. 799 Entries in this file can be any command line argument. 800 This file is prepended to any additional command line arguments. 801 Multiple lines and # comments are allowed. 802EOT 803} 804 805sub top_of_tree { 806 my ($lk_path) = @_; 807 808 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 809 $lk_path .= "/"; 810 } 811 if ( (-f "${lk_path}COPYING") 812 && (-f "${lk_path}MAINTAINERS") 813 && (-f "${lk_path}Makefile") 814 && (-d "${lk_path}docs") 815 && (-f "${lk_path}VERSION") 816 && (-f "${lk_path}vl.c")) { 817 return 1; 818 } 819 return 0; 820} 821 822sub parse_email { 823 my ($formatted_email) = @_; 824 825 my $name = ""; 826 my $address = ""; 827 828 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 829 $name = $1; 830 $address = $2; 831 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 832 $address = $1; 833 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 834 $address = $1; 835 } 836 837 $name =~ s/^\s+|\s+$//g; 838 $name =~ s/^\"|\"$//g; 839 $address =~ s/^\s+|\s+$//g; 840 841 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 842 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 843 $name = "\"$name\""; 844 } 845 846 return ($name, $address); 847} 848 849sub format_email { 850 my ($name, $address, $usename) = @_; 851 852 my $formatted_email; 853 854 $name =~ s/^\s+|\s+$//g; 855 $name =~ s/^\"|\"$//g; 856 $address =~ s/^\s+|\s+$//g; 857 858 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 859 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 860 $name = "\"$name\""; 861 } 862 863 if ($usename) { 864 if ("$name" eq "") { 865 $formatted_email = "$address"; 866 } else { 867 $formatted_email = "$name <$address>"; 868 } 869 } else { 870 $formatted_email = $address; 871 } 872 873 return $formatted_email; 874} 875 876sub find_first_section { 877 my $index = 0; 878 879 while ($index < @typevalue) { 880 my $tv = $typevalue[$index]; 881 if (($tv =~ m/^(\C):\s*(.*)/)) { 882 last; 883 } 884 $index++; 885 } 886 887 return $index; 888} 889 890sub find_starting_index { 891 my ($index) = @_; 892 893 while ($index > 0) { 894 my $tv = $typevalue[$index]; 895 if (!($tv =~ m/^(\C):\s*(.*)/)) { 896 last; 897 } 898 $index--; 899 } 900 901 return $index; 902} 903 904sub find_ending_index { 905 my ($index) = @_; 906 907 while ($index < @typevalue) { 908 my $tv = $typevalue[$index]; 909 if (!($tv =~ m/^(\C):\s*(.*)/)) { 910 last; 911 } 912 $index++; 913 } 914 915 return $index; 916} 917 918sub get_maintainer_role { 919 my ($index) = @_; 920 921 my $i; 922 my $start = find_starting_index($index); 923 my $end = find_ending_index($index); 924 925 my $role = "unknown"; 926 my $subsystem = $typevalue[$start]; 927 if (length($subsystem) > 20) { 928 $subsystem = substr($subsystem, 0, 17); 929 $subsystem =~ s/\s*$//; 930 $subsystem = $subsystem . "..."; 931 } 932 933 for ($i = $start + 1; $i < $end; $i++) { 934 my $tv = $typevalue[$i]; 935 if ($tv =~ m/^(\C):\s*(.*)/) { 936 my $ptype = $1; 937 my $pvalue = $2; 938 if ($ptype eq "S") { 939 $role = $pvalue; 940 } 941 } 942 } 943 944 $role = lc($role); 945 if ($role eq "supported") { 946 $role = "supporter"; 947 } elsif ($role eq "maintained") { 948 $role = "maintainer"; 949 } elsif ($role eq "odd fixes") { 950 $role = "odd fixer"; 951 } elsif ($role eq "orphan") { 952 $role = "orphan minder"; 953 } elsif ($role eq "obsolete") { 954 $role = "obsolete minder"; 955 } elsif ($role eq "buried alive in reporters") { 956 $role = "chief penguin"; 957 } 958 959 return $role . ":" . $subsystem; 960} 961 962sub get_list_role { 963 my ($index) = @_; 964 965 my $i; 966 my $start = find_starting_index($index); 967 my $end = find_ending_index($index); 968 969 my $subsystem = $typevalue[$start]; 970 if (length($subsystem) > 20) { 971 $subsystem = substr($subsystem, 0, 17); 972 $subsystem =~ s/\s*$//; 973 $subsystem = $subsystem . "..."; 974 } 975 976 if ($subsystem eq "THE REST") { 977 $subsystem = ""; 978 } 979 980 return $subsystem; 981} 982 983sub add_categories { 984 my ($index) = @_; 985 986 my $i; 987 my $start = find_starting_index($index); 988 my $end = find_ending_index($index); 989 990 push(@subsystem, $typevalue[$start]); 991 992 for ($i = $start + 1; $i < $end; $i++) { 993 my $tv = $typevalue[$i]; 994 if ($tv =~ m/^(\C):\s*(.*)/) { 995 my $ptype = $1; 996 my $pvalue = $2; 997 if ($ptype eq "L") { 998 my $list_address = $pvalue; 999 my $list_additional = ""; 1000 my $list_role = get_list_role($i); 1001 1002 if ($list_role ne "") { 1003 $list_role = ":" . $list_role; 1004 } 1005 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 1006 $list_address = $1; 1007 $list_additional = $2; 1008 } 1009 if ($list_additional =~ m/subscribers-only/) { 1010 if ($email_subscriber_list) { 1011 if (!$hash_list_to{lc($list_address)}) { 1012 $hash_list_to{lc($list_address)} = 1; 1013 push(@list_to, [$list_address, 1014 "subscriber list${list_role}"]); 1015 } 1016 } 1017 } else { 1018 if ($email_list) { 1019 if (!$hash_list_to{lc($list_address)}) { 1020 $hash_list_to{lc($list_address)} = 1; 1021 if ($list_additional =~ m/moderated/) { 1022 push(@list_to, [$list_address, 1023 "moderated list${list_role}"]); 1024 } else { 1025 push(@list_to, [$list_address, 1026 "open list${list_role}"]); 1027 } 1028 } 1029 } 1030 } 1031 } elsif ($ptype eq "M") { 1032 my ($name, $address) = parse_email($pvalue); 1033 if ($name eq "") { 1034 if ($i > 0) { 1035 my $tv = $typevalue[$i - 1]; 1036 if ($tv =~ m/^(\C):\s*(.*)/) { 1037 if ($1 eq "P") { 1038 $name = $2; 1039 $pvalue = format_email($name, $address, $email_usename); 1040 } 1041 } 1042 } 1043 } 1044 if ($email_maintainer) { 1045 my $role = get_maintainer_role($i); 1046 push_email_addresses($pvalue, $role); 1047 } 1048 } elsif ($ptype eq "T") { 1049 push(@scm, $pvalue); 1050 } elsif ($ptype eq "W") { 1051 push(@web, $pvalue); 1052 } elsif ($ptype eq "S") { 1053 push(@status, $pvalue); 1054 } 1055 } 1056 } 1057} 1058 1059sub email_inuse { 1060 my ($name, $address) = @_; 1061 1062 return 1 if (($name eq "") && ($address eq "")); 1063 return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 1064 return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 1065 1066 return 0; 1067} 1068 1069sub push_email_address { 1070 my ($line, $role) = @_; 1071 1072 my ($name, $address) = parse_email($line); 1073 1074 if ($address eq "") { 1075 return 0; 1076 } 1077 1078 if (!$email_remove_duplicates) { 1079 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1080 } elsif (!email_inuse($name, $address)) { 1081 push(@email_to, [format_email($name, $address, $email_usename), $role]); 1082 $email_hash_name{lc($name)}++ if ($name ne ""); 1083 $email_hash_address{lc($address)}++; 1084 } 1085 1086 return 1; 1087} 1088 1089sub push_email_addresses { 1090 my ($address, $role) = @_; 1091 1092 my @address_list = (); 1093 1094 if (rfc822_valid($address)) { 1095 push_email_address($address, $role); 1096 } elsif (@address_list = rfc822_validlist($address)) { 1097 my $array_count = shift(@address_list); 1098 while (my $entry = shift(@address_list)) { 1099 push_email_address($entry, $role); 1100 } 1101 } else { 1102 if (!push_email_address($address, $role)) { 1103 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 1104 } 1105 } 1106} 1107 1108sub add_role { 1109 my ($line, $role) = @_; 1110 1111 my ($name, $address) = parse_email($line); 1112 my $email = format_email($name, $address, $email_usename); 1113 1114 foreach my $entry (@email_to) { 1115 if ($email_remove_duplicates) { 1116 my ($entry_name, $entry_address) = parse_email($entry->[0]); 1117 if (($name eq $entry_name || $address eq $entry_address) 1118 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1119 ) { 1120 if ($entry->[1] eq "") { 1121 $entry->[1] = "$role"; 1122 } else { 1123 $entry->[1] = "$entry->[1],$role"; 1124 } 1125 } 1126 } else { 1127 if ($email eq $entry->[0] 1128 && ($role eq "" || !($entry->[1] =~ m/$role/)) 1129 ) { 1130 if ($entry->[1] eq "") { 1131 $entry->[1] = "$role"; 1132 } else { 1133 $entry->[1] = "$entry->[1],$role"; 1134 } 1135 } 1136 } 1137 } 1138} 1139 1140sub which { 1141 my ($bin) = @_; 1142 1143 foreach my $path (split(/:/, $ENV{PATH})) { 1144 if (-e "$path/$bin") { 1145 return "$path/$bin"; 1146 } 1147 } 1148 1149 return ""; 1150} 1151 1152sub which_conf { 1153 my ($conf) = @_; 1154 1155 foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1156 if (-e "$path/$conf") { 1157 return "$path/$conf"; 1158 } 1159 } 1160 1161 return ""; 1162} 1163 1164sub mailmap_email { 1165 my ($line) = @_; 1166 1167 my ($name, $address) = parse_email($line); 1168 my $email = format_email($name, $address, 1); 1169 my $real_name = $name; 1170 my $real_address = $address; 1171 1172 if (exists $mailmap->{names}->{$email} || 1173 exists $mailmap->{addresses}->{$email}) { 1174 if (exists $mailmap->{names}->{$email}) { 1175 $real_name = $mailmap->{names}->{$email}; 1176 } 1177 if (exists $mailmap->{addresses}->{$email}) { 1178 $real_address = $mailmap->{addresses}->{$email}; 1179 } 1180 } else { 1181 if (exists $mailmap->{names}->{$address}) { 1182 $real_name = $mailmap->{names}->{$address}; 1183 } 1184 if (exists $mailmap->{addresses}->{$address}) { 1185 $real_address = $mailmap->{addresses}->{$address}; 1186 } 1187 } 1188 return format_email($real_name, $real_address, 1); 1189} 1190 1191sub mailmap { 1192 my (@addresses) = @_; 1193 1194 my @mapped_emails = (); 1195 foreach my $line (@addresses) { 1196 push(@mapped_emails, mailmap_email($line)); 1197 } 1198 merge_by_realname(@mapped_emails) if ($email_use_mailmap); 1199 return @mapped_emails; 1200} 1201 1202sub merge_by_realname { 1203 my %address_map; 1204 my (@emails) = @_; 1205 1206 foreach my $email (@emails) { 1207 my ($name, $address) = parse_email($email); 1208 if (exists $address_map{$name}) { 1209 $address = $address_map{$name}; 1210 $email = format_email($name, $address, 1); 1211 } else { 1212 $address_map{$name} = $address; 1213 } 1214 } 1215} 1216 1217sub git_execute_cmd { 1218 my ($cmd) = @_; 1219 my @lines = (); 1220 1221 my $output = `$cmd`; 1222 $output =~ s/^\s*//gm; 1223 @lines = split("\n", $output); 1224 1225 return @lines; 1226} 1227 1228sub hg_execute_cmd { 1229 my ($cmd) = @_; 1230 my @lines = (); 1231 1232 my $output = `$cmd`; 1233 @lines = split("\n", $output); 1234 1235 return @lines; 1236} 1237 1238sub extract_formatted_signatures { 1239 my (@signature_lines) = @_; 1240 1241 my @type = @signature_lines; 1242 1243 s/\s*(.*):.*/$1/ for (@type); 1244 1245 # cut -f2- -d":" 1246 s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1247 1248## Reformat email addresses (with names) to avoid badly written signatures 1249 1250 foreach my $signer (@signature_lines) { 1251 $signer = deduplicate_email($signer); 1252 } 1253 1254 return (\@type, \@signature_lines); 1255} 1256 1257sub vcs_find_signers { 1258 my ($cmd) = @_; 1259 my $commits; 1260 my @lines = (); 1261 my @signatures = (); 1262 1263 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1264 1265 my $pattern = $VCS_cmds{"commit_pattern"}; 1266 1267 $commits = grep(/$pattern/, @lines); # of commits 1268 1269 @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1270 1271 return (0, @signatures) if !@signatures; 1272 1273 save_commits_by_author(@lines) if ($interactive); 1274 save_commits_by_signer(@lines) if ($interactive); 1275 1276 if (!$email_git_penguin_chiefs) { 1277 @signatures = grep(!/${penguin_chiefs}/i, @signatures); 1278 } 1279 1280 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1281 1282 return ($commits, @$signers_ref); 1283} 1284 1285sub vcs_find_author { 1286 my ($cmd) = @_; 1287 my @lines = (); 1288 1289 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1290 1291 if (!$email_git_penguin_chiefs) { 1292 @lines = grep(!/${penguin_chiefs}/i, @lines); 1293 } 1294 1295 return @lines if !@lines; 1296 1297 my @authors = (); 1298 foreach my $line (@lines) { 1299 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1300 my $author = $1; 1301 my ($name, $address) = parse_email($author); 1302 $author = format_email($name, $address, 1); 1303 push(@authors, $author); 1304 } 1305 } 1306 1307 save_commits_by_author(@lines) if ($interactive); 1308 save_commits_by_signer(@lines) if ($interactive); 1309 1310 return @authors; 1311} 1312 1313sub vcs_save_commits { 1314 my ($cmd) = @_; 1315 my @lines = (); 1316 my @commits = (); 1317 1318 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1319 1320 foreach my $line (@lines) { 1321 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 1322 push(@commits, $1); 1323 } 1324 } 1325 1326 return @commits; 1327} 1328 1329sub vcs_blame { 1330 my ($file) = @_; 1331 my $cmd; 1332 my @commits = (); 1333 1334 return @commits if (!(-f $file)); 1335 1336 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1337 my @all_commits = (); 1338 1339 $cmd = $VCS_cmds{"blame_file_cmd"}; 1340 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1341 @all_commits = vcs_save_commits($cmd); 1342 1343 foreach my $file_range_diff (@range) { 1344 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1345 my $diff_file = $1; 1346 my $diff_start = $2; 1347 my $diff_length = $3; 1348 next if ("$file" ne "$diff_file"); 1349 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1350 push(@commits, $all_commits[$i]); 1351 } 1352 } 1353 } elsif (@range) { 1354 foreach my $file_range_diff (@range) { 1355 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1356 my $diff_file = $1; 1357 my $diff_start = $2; 1358 my $diff_length = $3; 1359 next if ("$file" ne "$diff_file"); 1360 $cmd = $VCS_cmds{"blame_range_cmd"}; 1361 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1362 push(@commits, vcs_save_commits($cmd)); 1363 } 1364 } else { 1365 $cmd = $VCS_cmds{"blame_file_cmd"}; 1366 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1367 @commits = vcs_save_commits($cmd); 1368 } 1369 1370 foreach my $commit (@commits) { 1371 $commit =~ s/^\^//g; 1372 } 1373 1374 return @commits; 1375} 1376 1377my $printed_novcs = 0; 1378sub vcs_exists { 1379 %VCS_cmds = %VCS_cmds_git; 1380 return 1 if eval $VCS_cmds{"available"}; 1381 %VCS_cmds = %VCS_cmds_hg; 1382 return 2 if eval $VCS_cmds{"available"}; 1383 %VCS_cmds = (); 1384 if (!$printed_novcs) { 1385 warn("$P: No supported VCS found. Add --nogit to options?\n"); 1386 warn("Using a git repository produces better results.\n"); 1387 warn("Try latest git repository using:\n"); 1388 warn("git clone git://git.qemu-project.org/qemu.git\n"); 1389 $printed_novcs = 1; 1390 } 1391 return 0; 1392} 1393 1394sub vcs_is_git { 1395 vcs_exists(); 1396 return $vcs_used == 1; 1397} 1398 1399sub vcs_is_hg { 1400 return $vcs_used == 2; 1401} 1402 1403sub interactive_get_maintainers { 1404 my ($list_ref) = @_; 1405 my @list = @$list_ref; 1406 1407 vcs_exists(); 1408 1409 my %selected; 1410 my %authored; 1411 my %signed; 1412 my $count = 0; 1413 my $maintained = 0; 1414 foreach my $entry (@list) { 1415 $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i); 1416 $selected{$count} = 1; 1417 $authored{$count} = 0; 1418 $signed{$count} = 0; 1419 $count++; 1420 } 1421 1422 #menu loop 1423 my $done = 0; 1424 my $print_options = 0; 1425 my $redraw = 1; 1426 while (!$done) { 1427 $count = 0; 1428 if ($redraw) { 1429 printf STDERR "\n%1s %2s %-65s", 1430 "*", "#", "email/list and role:stats"; 1431 if ($email_git || 1432 ($email_git_fallback && !$maintained) || 1433 $email_git_blame) { 1434 print STDERR "auth sign"; 1435 } 1436 print STDERR "\n"; 1437 foreach my $entry (@list) { 1438 my $email = $entry->[0]; 1439 my $role = $entry->[1]; 1440 my $sel = ""; 1441 $sel = "*" if ($selected{$count}); 1442 my $commit_author = $commit_author_hash{$email}; 1443 my $commit_signer = $commit_signer_hash{$email}; 1444 my $authored = 0; 1445 my $signed = 0; 1446 $authored++ for (@{$commit_author}); 1447 $signed++ for (@{$commit_signer}); 1448 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1449 printf STDERR "%4d %4d", $authored, $signed 1450 if ($authored > 0 || $signed > 0); 1451 printf STDERR "\n %s\n", $role; 1452 if ($authored{$count}) { 1453 my $commit_author = $commit_author_hash{$email}; 1454 foreach my $ref (@{$commit_author}) { 1455 print STDERR " Author: @{$ref}[1]\n"; 1456 } 1457 } 1458 if ($signed{$count}) { 1459 my $commit_signer = $commit_signer_hash{$email}; 1460 foreach my $ref (@{$commit_signer}) { 1461 print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1462 } 1463 } 1464 1465 $count++; 1466 } 1467 } 1468 my $date_ref = \$email_git_since; 1469 $date_ref = \$email_hg_since if (vcs_is_hg()); 1470 if ($print_options) { 1471 $print_options = 0; 1472 if (vcs_exists()) { 1473 print STDERR <<EOT 1474 1475Version Control options: 1476g use git history [$email_git] 1477gf use git-fallback [$email_git_fallback] 1478b use git blame [$email_git_blame] 1479bs use blame signatures [$email_git_blame_signatures] 1480c# minimum commits [$email_git_min_signatures] 1481%# min percent [$email_git_min_percent] 1482d# history to use [$$date_ref] 1483x# max maintainers [$email_git_max_maintainers] 1484t all signature types [$email_git_all_signature_types] 1485m use .mailmap [$email_use_mailmap] 1486EOT 1487 } 1488 print STDERR <<EOT 1489 1490Additional options: 14910 toggle all 1492tm toggle maintainers 1493tg toggle git entries 1494tl toggle open list entries 1495ts toggle subscriber list entries 1496f emails in file [$file_emails] 1497k keywords in file [$keywords] 1498r remove duplicates [$email_remove_duplicates] 1499p# pattern match depth [$pattern_depth] 1500EOT 1501 } 1502 print STDERR 1503"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1504 1505 my $input = <STDIN>; 1506 chomp($input); 1507 1508 $redraw = 1; 1509 my $rerun = 0; 1510 my @wish = split(/[, ]+/, $input); 1511 foreach my $nr (@wish) { 1512 $nr = lc($nr); 1513 my $sel = substr($nr, 0, 1); 1514 my $str = substr($nr, 1); 1515 my $val = 0; 1516 $val = $1 if $str =~ /^(\d+)$/; 1517 1518 if ($sel eq "y") { 1519 $interactive = 0; 1520 $done = 1; 1521 $output_rolestats = 0; 1522 $output_roles = 0; 1523 last; 1524 } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1525 $selected{$nr - 1} = !$selected{$nr - 1}; 1526 } elsif ($sel eq "*" || $sel eq '^') { 1527 my $toggle = 0; 1528 $toggle = 1 if ($sel eq '*'); 1529 for (my $i = 0; $i < $count; $i++) { 1530 $selected{$i} = $toggle; 1531 } 1532 } elsif ($sel eq "0") { 1533 for (my $i = 0; $i < $count; $i++) { 1534 $selected{$i} = !$selected{$i}; 1535 } 1536 } elsif ($sel eq "t") { 1537 if (lc($str) eq "m") { 1538 for (my $i = 0; $i < $count; $i++) { 1539 $selected{$i} = !$selected{$i} 1540 if ($list[$i]->[1] =~ /^(maintainer|supporter)/i); 1541 } 1542 } elsif (lc($str) eq "g") { 1543 for (my $i = 0; $i < $count; $i++) { 1544 $selected{$i} = !$selected{$i} 1545 if ($list[$i]->[1] =~ /^(author|commit|signer)/i); 1546 } 1547 } elsif (lc($str) eq "l") { 1548 for (my $i = 0; $i < $count; $i++) { 1549 $selected{$i} = !$selected{$i} 1550 if ($list[$i]->[1] =~ /^(open list)/i); 1551 } 1552 } elsif (lc($str) eq "s") { 1553 for (my $i = 0; $i < $count; $i++) { 1554 $selected{$i} = !$selected{$i} 1555 if ($list[$i]->[1] =~ /^(subscriber list)/i); 1556 } 1557 } 1558 } elsif ($sel eq "a") { 1559 if ($val > 0 && $val <= $count) { 1560 $authored{$val - 1} = !$authored{$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 $authored{$i} = $toggle; 1566 } 1567 } 1568 } elsif ($sel eq "s") { 1569 if ($val > 0 && $val <= $count) { 1570 $signed{$val - 1} = !$signed{$val - 1}; 1571 } elsif ($str eq '*' || $str eq '^') { 1572 my $toggle = 0; 1573 $toggle = 1 if ($str eq '*'); 1574 for (my $i = 0; $i < $count; $i++) { 1575 $signed{$i} = $toggle; 1576 } 1577 } 1578 } elsif ($sel eq "o") { 1579 $print_options = 1; 1580 $redraw = 1; 1581 } elsif ($sel eq "g") { 1582 if ($str eq "f") { 1583 bool_invert(\$email_git_fallback); 1584 } else { 1585 bool_invert(\$email_git); 1586 } 1587 $rerun = 1; 1588 } elsif ($sel eq "b") { 1589 if ($str eq "s") { 1590 bool_invert(\$email_git_blame_signatures); 1591 } else { 1592 bool_invert(\$email_git_blame); 1593 } 1594 $rerun = 1; 1595 } elsif ($sel eq "c") { 1596 if ($val > 0) { 1597 $email_git_min_signatures = $val; 1598 $rerun = 1; 1599 } 1600 } elsif ($sel eq "x") { 1601 if ($val > 0) { 1602 $email_git_max_maintainers = $val; 1603 $rerun = 1; 1604 } 1605 } elsif ($sel eq "%") { 1606 if ($str ne "" && $val >= 0) { 1607 $email_git_min_percent = $val; 1608 $rerun = 1; 1609 } 1610 } elsif ($sel eq "d") { 1611 if (vcs_is_git()) { 1612 $email_git_since = $str; 1613 } elsif (vcs_is_hg()) { 1614 $email_hg_since = $str; 1615 } 1616 $rerun = 1; 1617 } elsif ($sel eq "t") { 1618 bool_invert(\$email_git_all_signature_types); 1619 $rerun = 1; 1620 } elsif ($sel eq "f") { 1621 bool_invert(\$file_emails); 1622 $rerun = 1; 1623 } elsif ($sel eq "r") { 1624 bool_invert(\$email_remove_duplicates); 1625 $rerun = 1; 1626 } elsif ($sel eq "m") { 1627 bool_invert(\$email_use_mailmap); 1628 read_mailmap(); 1629 $rerun = 1; 1630 } elsif ($sel eq "k") { 1631 bool_invert(\$keywords); 1632 $rerun = 1; 1633 } elsif ($sel eq "p") { 1634 if ($str ne "" && $val >= 0) { 1635 $pattern_depth = $val; 1636 $rerun = 1; 1637 } 1638 } elsif ($sel eq "h" || $sel eq "?") { 1639 print STDERR <<EOT 1640 1641Interactive mode allows you to select the various maintainers, submitters, 1642commit signers and mailing lists that could be CC'd on a patch. 1643 1644Any *'d entry is selected. 1645 1646If you have git or hg installed, you can choose to summarize the commit 1647history of files in the patch. Also, each line of the current file can 1648be matched to its commit author and that commits signers with blame. 1649 1650Various knobs exist to control the length of time for active commit 1651tracking, the maximum number of commit authors and signers to add, 1652and such. 1653 1654Enter selections at the prompt until you are satisfied that the selected 1655maintainers are appropriate. You may enter multiple selections separated 1656by either commas or spaces. 1657 1658EOT 1659 } else { 1660 print STDERR "invalid option: '$nr'\n"; 1661 $redraw = 0; 1662 } 1663 } 1664 if ($rerun) { 1665 print STDERR "git-blame can be very slow, please have patience..." 1666 if ($email_git_blame); 1667 goto &get_maintainers; 1668 } 1669 } 1670 1671 #drop not selected entries 1672 $count = 0; 1673 my @new_emailto = (); 1674 foreach my $entry (@list) { 1675 if ($selected{$count}) { 1676 push(@new_emailto, $list[$count]); 1677 } 1678 $count++; 1679 } 1680 return @new_emailto; 1681} 1682 1683sub bool_invert { 1684 my ($bool_ref) = @_; 1685 1686 if ($$bool_ref) { 1687 $$bool_ref = 0; 1688 } else { 1689 $$bool_ref = 1; 1690 } 1691} 1692 1693sub deduplicate_email { 1694 my ($email) = @_; 1695 1696 my $matched = 0; 1697 my ($name, $address) = parse_email($email); 1698 $email = format_email($name, $address, 1); 1699 $email = mailmap_email($email); 1700 1701 return $email if (!$email_remove_duplicates); 1702 1703 ($name, $address) = parse_email($email); 1704 1705 if ($name ne "" && $deduplicate_name_hash{lc($name)}) { 1706 $name = $deduplicate_name_hash{lc($name)}->[0]; 1707 $address = $deduplicate_name_hash{lc($name)}->[1]; 1708 $matched = 1; 1709 } elsif ($deduplicate_address_hash{lc($address)}) { 1710 $name = $deduplicate_address_hash{lc($address)}->[0]; 1711 $address = $deduplicate_address_hash{lc($address)}->[1]; 1712 $matched = 1; 1713 } 1714 if (!$matched) { 1715 $deduplicate_name_hash{lc($name)} = [ $name, $address ]; 1716 $deduplicate_address_hash{lc($address)} = [ $name, $address ]; 1717 } 1718 $email = format_email($name, $address, 1); 1719 $email = mailmap_email($email); 1720 return $email; 1721} 1722 1723sub save_commits_by_author { 1724 my (@lines) = @_; 1725 1726 my @authors = (); 1727 my @commits = (); 1728 my @subjects = (); 1729 1730 foreach my $line (@lines) { 1731 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1732 my $author = $1; 1733 $author = deduplicate_email($author); 1734 push(@authors, $author); 1735 } 1736 push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1737 push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1738 } 1739 1740 for (my $i = 0; $i < @authors; $i++) { 1741 my $exists = 0; 1742 foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 1743 if (@{$ref}[0] eq $commits[$i] && 1744 @{$ref}[1] eq $subjects[$i]) { 1745 $exists = 1; 1746 last; 1747 } 1748 } 1749 if (!$exists) { 1750 push(@{$commit_author_hash{$authors[$i]}}, 1751 [ ($commits[$i], $subjects[$i]) ]); 1752 } 1753 } 1754} 1755 1756sub save_commits_by_signer { 1757 my (@lines) = @_; 1758 1759 my $commit = ""; 1760 my $subject = ""; 1761 1762 foreach my $line (@lines) { 1763 $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1764 $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1765 if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 1766 my @signatures = ($line); 1767 my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1768 my @types = @$types_ref; 1769 my @signers = @$signers_ref; 1770 1771 my $type = $types[0]; 1772 my $signer = $signers[0]; 1773 1774 $signer = deduplicate_email($signer); 1775 1776 my $exists = 0; 1777 foreach my $ref(@{$commit_signer_hash{$signer}}) { 1778 if (@{$ref}[0] eq $commit && 1779 @{$ref}[1] eq $subject && 1780 @{$ref}[2] eq $type) { 1781 $exists = 1; 1782 last; 1783 } 1784 } 1785 if (!$exists) { 1786 push(@{$commit_signer_hash{$signer}}, 1787 [ ($commit, $subject, $type) ]); 1788 } 1789 } 1790 } 1791} 1792 1793sub vcs_assign { 1794 my ($role, $divisor, @lines) = @_; 1795 1796 my %hash; 1797 my $count = 0; 1798 1799 return if (@lines <= 0); 1800 1801 if ($divisor <= 0) { 1802 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 1803 $divisor = 1; 1804 } 1805 1806 @lines = mailmap(@lines); 1807 1808 return if (@lines <= 0); 1809 1810 @lines = sort(@lines); 1811 1812 # uniq -c 1813 $hash{$_}++ for @lines; 1814 1815 # sort -rn 1816 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 1817 my $sign_offs = $hash{$line}; 1818 my $percent = $sign_offs * 100 / $divisor; 1819 1820 $percent = 100 if ($percent > 100); 1821 $count++; 1822 last if ($sign_offs < $email_git_min_signatures || 1823 $count > $email_git_max_maintainers || 1824 $percent < $email_git_min_percent); 1825 push_email_address($line, ''); 1826 if ($output_rolestats) { 1827 my $fmt_percent = sprintf("%.0f", $percent); 1828 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1829 } else { 1830 add_role($line, $role); 1831 } 1832 } 1833} 1834 1835sub vcs_file_signoffs { 1836 my ($file) = @_; 1837 1838 my @signers = (); 1839 my $commits; 1840 1841 $vcs_used = vcs_exists(); 1842 return if (!$vcs_used); 1843 1844 my $cmd = $VCS_cmds{"find_signers_cmd"}; 1845 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1846 1847 ($commits, @signers) = vcs_find_signers($cmd); 1848 1849 foreach my $signer (@signers) { 1850 $signer = deduplicate_email($signer); 1851 } 1852 1853 vcs_assign("commit_signer", $commits, @signers); 1854} 1855 1856sub vcs_file_blame { 1857 my ($file) = @_; 1858 1859 my @signers = (); 1860 my @all_commits = (); 1861 my @commits = (); 1862 my $total_commits; 1863 my $total_lines; 1864 1865 $vcs_used = vcs_exists(); 1866 return if (!$vcs_used); 1867 1868 @all_commits = vcs_blame($file); 1869 @commits = uniq(@all_commits); 1870 $total_commits = @commits; 1871 $total_lines = @all_commits; 1872 1873 if ($email_git_blame_signatures) { 1874 if (vcs_is_hg()) { 1875 my $commit_count; 1876 my @commit_signers = (); 1877 my $commit = join(" -r ", @commits); 1878 my $cmd; 1879 1880 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1881 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1882 1883 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1884 1885 push(@signers, @commit_signers); 1886 } else { 1887 foreach my $commit (@commits) { 1888 my $commit_count; 1889 my @commit_signers = (); 1890 my $cmd; 1891 1892 $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1893 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1894 1895 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1896 1897 push(@signers, @commit_signers); 1898 } 1899 } 1900 } 1901 1902 if ($from_filename) { 1903 if ($output_rolestats) { 1904 my @blame_signers; 1905 if (vcs_is_hg()) {{ # Double brace for last exit 1906 my $commit_count; 1907 my @commit_signers = (); 1908 @commits = uniq(@commits); 1909 @commits = sort(@commits); 1910 my $commit = join(" -r ", @commits); 1911 my $cmd; 1912 1913 $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1914 $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1915 1916 my @lines = (); 1917 1918 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1919 1920 if (!$email_git_penguin_chiefs) { 1921 @lines = grep(!/${penguin_chiefs}/i, @lines); 1922 } 1923 1924 last if !@lines; 1925 1926 my @authors = (); 1927 foreach my $line (@lines) { 1928 if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1929 my $author = $1; 1930 $author = deduplicate_email($author); 1931 push(@authors, $author); 1932 } 1933 } 1934 1935 save_commits_by_author(@lines) if ($interactive); 1936 save_commits_by_signer(@lines) if ($interactive); 1937 1938 push(@signers, @authors); 1939 }} 1940 else { 1941 foreach my $commit (@commits) { 1942 my $i; 1943 my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1944 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1945 my @author = vcs_find_author($cmd); 1946 next if !@author; 1947 1948 my $formatted_author = deduplicate_email($author[0]); 1949 1950 my $count = grep(/$commit/, @all_commits); 1951 for ($i = 0; $i < $count ; $i++) { 1952 push(@blame_signers, $formatted_author); 1953 } 1954 } 1955 } 1956 if (@blame_signers) { 1957 vcs_assign("authored lines", $total_lines, @blame_signers); 1958 } 1959 } 1960 foreach my $signer (@signers) { 1961 $signer = deduplicate_email($signer); 1962 } 1963 vcs_assign("commits", $total_commits, @signers); 1964 } else { 1965 foreach my $signer (@signers) { 1966 $signer = deduplicate_email($signer); 1967 } 1968 vcs_assign("modified commits", $total_commits, @signers); 1969 } 1970} 1971 1972sub uniq { 1973 my (@parms) = @_; 1974 1975 my %saw; 1976 @parms = grep(!$saw{$_}++, @parms); 1977 return @parms; 1978} 1979 1980sub sort_and_uniq { 1981 my (@parms) = @_; 1982 1983 my %saw; 1984 @parms = sort @parms; 1985 @parms = grep(!$saw{$_}++, @parms); 1986 return @parms; 1987} 1988 1989sub clean_file_emails { 1990 my (@file_emails) = @_; 1991 my @fmt_emails = (); 1992 1993 foreach my $email (@file_emails) { 1994 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 1995 my ($name, $address) = parse_email($email); 1996 if ($name eq '"[,\.]"') { 1997 $name = ""; 1998 } 1999 2000 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 2001 if (@nw > 2) { 2002 my $first = $nw[@nw - 3]; 2003 my $middle = $nw[@nw - 2]; 2004 my $last = $nw[@nw - 1]; 2005 2006 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 2007 (length($first) == 2 && substr($first, -1) eq ".")) || 2008 (length($middle) == 1 || 2009 (length($middle) == 2 && substr($middle, -1) eq "."))) { 2010 $name = "$first $middle $last"; 2011 } else { 2012 $name = "$middle $last"; 2013 } 2014 } 2015 2016 if (substr($name, -1) =~ /[,\.]/) { 2017 $name = substr($name, 0, length($name) - 1); 2018 } elsif (substr($name, -2) =~ /[,\.]"/) { 2019 $name = substr($name, 0, length($name) - 2) . '"'; 2020 } 2021 2022 if (substr($name, 0, 1) =~ /[,\.]/) { 2023 $name = substr($name, 1, length($name) - 1); 2024 } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 2025 $name = '"' . substr($name, 2, length($name) - 2); 2026 } 2027 2028 my $fmt_email = format_email($name, $address, $email_usename); 2029 push(@fmt_emails, $fmt_email); 2030 } 2031 return @fmt_emails; 2032} 2033 2034sub merge_email { 2035 my @lines; 2036 my %saw; 2037 2038 for (@_) { 2039 my ($address, $role) = @$_; 2040 if (!$saw{$address}) { 2041 if ($output_roles) { 2042 push(@lines, "$address ($role)"); 2043 } else { 2044 push(@lines, $address); 2045 } 2046 $saw{$address} = 1; 2047 } 2048 } 2049 2050 return @lines; 2051} 2052 2053sub output { 2054 my (@parms) = @_; 2055 2056 if ($output_multiline) { 2057 foreach my $line (@parms) { 2058 print("${line}\n"); 2059 } 2060 } else { 2061 print(join($output_separator, @parms)); 2062 print("\n"); 2063 } 2064} 2065 2066my $rfc822re; 2067 2068sub make_rfc822re { 2069# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 2070# comment. We must allow for rfc822_lwsp (or comments) after each of these. 2071# This regexp will only work on addresses which have had comments stripped 2072# and replaced with rfc822_lwsp. 2073 2074 my $specials = '()<>@,;:\\\\".\\[\\]'; 2075 my $controls = '\\000-\\037\\177'; 2076 2077 my $dtext = "[^\\[\\]\\r\\\\]"; 2078 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 2079 2080 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 2081 2082# Use zero-width assertion to spot the limit of an atom. A simple 2083# $rfc822_lwsp* causes the regexp engine to hang occasionally. 2084 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 2085 my $word = "(?:$atom|$quoted_string)"; 2086 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 2087 2088 my $sub_domain = "(?:$atom|$domain_literal)"; 2089 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 2090 2091 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 2092 2093 my $phrase = "$word*"; 2094 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 2095 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 2096 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 2097 2098 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 2099 my $address = "(?:$mailbox|$group)"; 2100 2101 return "$rfc822_lwsp*$address"; 2102} 2103 2104sub rfc822_strip_comments { 2105 my $s = shift; 2106# Recursively remove comments, and replace with a single space. The simpler 2107# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 2108# chars in atoms, for example. 2109 2110 while ($s =~ s/^((?:[^"\\]|\\.)* 2111 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 2112 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 2113 return $s; 2114} 2115 2116# valid: returns true if the parameter is an RFC822 valid address 2117# 2118sub rfc822_valid { 2119 my $s = rfc822_strip_comments(shift); 2120 2121 if (!$rfc822re) { 2122 $rfc822re = make_rfc822re(); 2123 } 2124 2125 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 2126} 2127 2128# validlist: In scalar context, returns true if the parameter is an RFC822 2129# valid list of addresses. 2130# 2131# In list context, returns an empty list on failure (an invalid 2132# address was found); otherwise a list whose first element is the 2133# number of addresses found and whose remaining elements are the 2134# addresses. This is needed to disambiguate failure (invalid) 2135# from success with no addresses found, because an empty string is 2136# a valid list. 2137 2138sub rfc822_validlist { 2139 my $s = rfc822_strip_comments(shift); 2140 2141 if (!$rfc822re) { 2142 $rfc822re = make_rfc822re(); 2143 } 2144 # * null list items are valid according to the RFC 2145 # * the '1' business is to aid in distinguishing failure from no results 2146 2147 my @r; 2148 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 2149 $s =~ m/^$rfc822_char*$/) { 2150 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 2151 push(@r, $1); 2152 } 2153 return wantarray ? (scalar(@r), @r) : 1; 2154 } 2155 return wantarray ? () : 0; 2156} 2157