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