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