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