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