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