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