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.23'; 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_list = 1; 25my $email_subscriber_list = 0; 26my $email_git_penguin_chiefs = 0; 27my $email_git = 1; 28my $email_git_blame = 0; 29my $email_git_min_signatures = 1; 30my $email_git_max_maintainers = 5; 31my $email_git_min_percent = 5; 32my $email_git_since = "1-year-ago"; 33my $email_hg_since = "-365"; 34my $email_remove_duplicates = 1; 35my $output_multiline = 1; 36my $output_separator = ", "; 37my $output_roles = 0; 38my $output_rolestats = 0; 39my $scm = 0; 40my $web = 0; 41my $subsystem = 0; 42my $status = 0; 43my $keywords = 1; 44my $from_filename = 0; 45my $pattern_depth = 0; 46my $version = 0; 47my $help = 0; 48 49my $exit = 0; 50 51my @penguin_chief = (); 52push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org"); 53#Andrew wants in on most everything - 2009/01/14 54#push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org"); 55 56my @penguin_chief_names = (); 57foreach my $chief (@penguin_chief) { 58 if ($chief =~ m/^(.*):(.*)/) { 59 my $chief_name = $1; 60 my $chief_addr = $2; 61 push(@penguin_chief_names, $chief_name); 62 } 63} 64my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)"; 65 66# rfc822 email address - preloaded methods go here. 67my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 68my $rfc822_char = '[\\000-\\377]'; 69 70# VCS command support: class-like functions and strings 71 72my %VCS_cmds; 73 74my %VCS_cmds_git = ( 75 "execute_cmd" => \&git_execute_cmd, 76 "available" => '(which("git") ne "") && (-d ".git")', 77 "find_signers_cmd" => "git log --since=\$email_git_since -- \$file", 78 "find_commit_signers_cmd" => "git log -1 \$commit", 79 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file", 80 "blame_file_cmd" => "git blame -l \$file", 81 "commit_pattern" => "^commit [0-9a-f]{40,40}", 82 "blame_commit_pattern" => "^([0-9a-f]+) " 83); 84 85my %VCS_cmds_hg = ( 86 "execute_cmd" => \&hg_execute_cmd, 87 "available" => '(which("hg") ne "") && (-d ".hg")', 88 "find_signers_cmd" => 89 "hg log --date=\$email_hg_since" . 90 " --template='commit {node}\\n{desc}\\n' -- \$file", 91 "find_commit_signers_cmd" => "hg log --template='{desc}\\n' -r \$commit", 92 "blame_range_cmd" => "", # not supported 93 "blame_file_cmd" => "hg blame -c \$file", 94 "commit_pattern" => "^commit [0-9a-f]{40,40}", 95 "blame_commit_pattern" => "^([0-9a-f]+):" 96); 97 98if (!GetOptions( 99 'email!' => \$email, 100 'git!' => \$email_git, 101 'git-blame!' => \$email_git_blame, 102 'git-chief-penguins!' => \$email_git_penguin_chiefs, 103 'git-min-signatures=i' => \$email_git_min_signatures, 104 'git-max-maintainers=i' => \$email_git_max_maintainers, 105 'git-min-percent=i' => \$email_git_min_percent, 106 'git-since=s' => \$email_git_since, 107 'hg-since=s' => \$email_hg_since, 108 'remove-duplicates!' => \$email_remove_duplicates, 109 'm!' => \$email_maintainer, 110 'n!' => \$email_usename, 111 'l!' => \$email_list, 112 's!' => \$email_subscriber_list, 113 'multiline!' => \$output_multiline, 114 'roles!' => \$output_roles, 115 'rolestats!' => \$output_rolestats, 116 'separator=s' => \$output_separator, 117 'subsystem!' => \$subsystem, 118 'status!' => \$status, 119 'scm!' => \$scm, 120 'web!' => \$web, 121 'pattern-depth=i' => \$pattern_depth, 122 'k|keywords!' => \$keywords, 123 'f|file' => \$from_filename, 124 'v|version' => \$version, 125 'h|help' => \$help, 126 )) { 127 die "$P: invalid argument - use --help if necessary\n"; 128} 129 130if ($help != 0) { 131 usage(); 132 exit 0; 133} 134 135if ($version != 0) { 136 print("${P} ${V}\n"); 137 exit 0; 138} 139 140if ($#ARGV < 0) { 141 usage(); 142 die "$P: argument missing: patchfile or -f file please\n"; 143} 144 145if ($output_separator ne ", ") { 146 $output_multiline = 0; 147} 148 149if ($output_rolestats) { 150 $output_roles = 1; 151} 152 153my $selections = $email + $scm + $status + $subsystem + $web; 154if ($selections == 0) { 155 usage(); 156 die "$P: Missing required option: email, scm, status, subsystem or web\n"; 157} 158 159if ($email && 160 ($email_maintainer + $email_list + $email_subscriber_list + 161 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) { 162 usage(); 163 die "$P: Please select at least 1 email option\n"; 164} 165 166if (!top_of_kernel_tree($lk_path)) { 167 die "$P: The current directory does not appear to be " 168 . "a linux kernel source tree.\n"; 169} 170 171## Read MAINTAINERS for type/value pairs 172 173my @typevalue = (); 174my %keyword_hash; 175 176open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n"; 177while (<MAINT>) { 178 my $line = $_; 179 180 if ($line =~ m/^(\C):\s*(.*)/) { 181 my $type = $1; 182 my $value = $2; 183 184 ##Filename pattern matching 185 if ($type eq "F" || $type eq "X") { 186 $value =~ s@\.@\\\.@g; ##Convert . to \. 187 $value =~ s/\*/\.\*/g; ##Convert * to .* 188 $value =~ s/\?/\./g; ##Convert ? to . 189 ##if pattern is a directory and it lacks a trailing slash, add one 190 if ((-d $value)) { 191 $value =~ s@([^/])$@$1/@; 192 } 193 } elsif ($type eq "K") { 194 $keyword_hash{@typevalue} = $value; 195 } 196 push(@typevalue, "$type:$value"); 197 } elsif (!/^(\s)*$/) { 198 $line =~ s/\n$//g; 199 push(@typevalue, $line); 200 } 201} 202close(MAINT); 203 204my %mailmap; 205 206if ($email_remove_duplicates) { 207 open(MAILMAP, "<${lk_path}.mailmap") || warn "$P: Can't open .mailmap\n"; 208 while (<MAILMAP>) { 209 my $line = $_; 210 211 next if ($line =~ m/^\s*#/); 212 next if ($line =~ m/^\s*$/); 213 214 my ($name, $address) = parse_email($line); 215 $line = format_email($name, $address, $email_usename); 216 217 next if ($line =~ m/^\s*$/); 218 219 if (exists($mailmap{$name})) { 220 my $obj = $mailmap{$name}; 221 push(@$obj, $address); 222 } else { 223 my @arr = ($address); 224 $mailmap{$name} = \@arr; 225 } 226 } 227 close(MAILMAP); 228} 229 230## use the filenames on the command line or find the filenames in the patchfiles 231 232my @files = (); 233my @range = (); 234my @keyword_tvi = (); 235 236foreach my $file (@ARGV) { 237 ##if $file is a directory and it lacks a trailing slash, add one 238 if ((-d $file)) { 239 $file =~ s@([^/])$@$1/@; 240 } elsif (!(-f $file)) { 241 die "$P: file '${file}' not found\n"; 242 } 243 if ($from_filename) { 244 push(@files, $file); 245 if (-f $file && $keywords) { 246 open(FILE, "<$file") or die "$P: Can't open ${file}\n"; 247 my $text = do { local($/) ; <FILE> }; 248 foreach my $line (keys %keyword_hash) { 249 if ($text =~ m/$keyword_hash{$line}/x) { 250 push(@keyword_tvi, $line); 251 } 252 } 253 close(FILE); 254 } 255 } else { 256 my $file_cnt = @files; 257 my $lastfile; 258 open(PATCH, "<$file") or die "$P: Can't open ${file}\n"; 259 while (<PATCH>) { 260 my $patch_line = $_; 261 if (m/^\+\+\+\s+(\S+)/) { 262 my $filename = $1; 263 $filename =~ s@^[^/]*/@@; 264 $filename =~ s@\n@@; 265 $lastfile = $filename; 266 push(@files, $filename); 267 } elsif (m/^\@\@ -(\d+),(\d+)/) { 268 if ($email_git_blame) { 269 push(@range, "$lastfile:$1:$2"); 270 } 271 } elsif ($keywords) { 272 foreach my $line (keys %keyword_hash) { 273 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) { 274 push(@keyword_tvi, $line); 275 } 276 } 277 } 278 } 279 close(PATCH); 280 if ($file_cnt == @files) { 281 warn "$P: file '${file}' doesn't appear to be a patch. " 282 . "Add -f to options?\n"; 283 } 284 @files = sort_and_uniq(@files); 285 } 286} 287 288my @email_to = (); 289my @list_to = (); 290my @scm = (); 291my @web = (); 292my @subsystem = (); 293my @status = (); 294 295# Find responsible parties 296 297foreach my $file (@files) { 298 299#Do not match excluded file patterns 300 301 my $exclude = 0; 302 foreach my $line (@typevalue) { 303 if ($line =~ m/^(\C):\s*(.*)/) { 304 my $type = $1; 305 my $value = $2; 306 if ($type eq 'X') { 307 if (file_match_pattern($file, $value)) { 308 $exclude = 1; 309 last; 310 } 311 } 312 } 313 } 314 315 if (!$exclude) { 316 my $tvi = 0; 317 my %hash; 318 foreach my $line (@typevalue) { 319 if ($line =~ m/^(\C):\s*(.*)/) { 320 my $type = $1; 321 my $value = $2; 322 if ($type eq 'F') { 323 if (file_match_pattern($file, $value)) { 324 my $value_pd = ($value =~ tr@/@@); 325 my $file_pd = ($file =~ tr@/@@); 326 $value_pd++ if (substr($value,-1,1) ne "/"); 327 if ($pattern_depth == 0 || 328 (($file_pd - $value_pd) < $pattern_depth)) { 329 $hash{$tvi} = $value_pd; 330 } 331 } 332 } 333 } 334 $tvi++; 335 } 336 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 337 add_categories($line); 338 } 339 } 340 341 if ($email && $email_git) { 342 vcs_file_signoffs($file); 343 } 344 345 if ($email && $email_git_blame) { 346 vcs_file_blame($file); 347 } 348} 349 350if ($keywords) { 351 @keyword_tvi = sort_and_uniq(@keyword_tvi); 352 foreach my $line (@keyword_tvi) { 353 add_categories($line); 354 } 355} 356 357if ($email) { 358 foreach my $chief (@penguin_chief) { 359 if ($chief =~ m/^(.*):(.*)/) { 360 my $email_address; 361 362 $email_address = format_email($1, $2, $email_usename); 363 if ($email_git_penguin_chiefs) { 364 push(@email_to, [$email_address, 'chief penguin']); 365 } else { 366 @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 367 } 368 } 369 } 370} 371 372if ($email || $email_list) { 373 my @to = (); 374 if ($email) { 375 @to = (@to, @email_to); 376 } 377 if ($email_list) { 378 @to = (@to, @list_to); 379 } 380 output(merge_email(@to)); 381} 382 383if ($scm) { 384 @scm = uniq(@scm); 385 output(@scm); 386} 387 388if ($status) { 389 @status = uniq(@status); 390 output(@status); 391} 392 393if ($subsystem) { 394 @subsystem = uniq(@subsystem); 395 output(@subsystem); 396} 397 398if ($web) { 399 @web = uniq(@web); 400 output(@web); 401} 402 403exit($exit); 404 405sub file_match_pattern { 406 my ($file, $pattern) = @_; 407 if (substr($pattern, -1) eq "/") { 408 if ($file =~ m@^$pattern@) { 409 return 1; 410 } 411 } else { 412 if ($file =~ m@^$pattern@) { 413 my $s1 = ($file =~ tr@/@@); 414 my $s2 = ($pattern =~ tr@/@@); 415 if ($s1 == $s2) { 416 return 1; 417 } 418 } 419 } 420 return 0; 421} 422 423sub usage { 424 print <<EOT; 425usage: $P [options] patchfile 426 $P [options] -f file|directory 427version: $V 428 429MAINTAINER field selection options: 430 --email => print email address(es) if any 431 --git => include recent git \*-by: signers 432 --git-chief-penguins => include ${penguin_chiefs} 433 --git-min-signatures => number of signatures required (default: 1) 434 --git-max-maintainers => maximum maintainers to add (default: 5) 435 --git-min-percent => minimum percentage of commits required (default: 5) 436 --git-blame => use git blame to find modified commits for patch or file 437 --git-since => git history to use (default: 1-year-ago) 438 --hg-since => hg history to use (default: -365) 439 --m => include maintainer(s) if any 440 --n => include name 'Full Name <addr\@domain.tld>' 441 --l => include list(s) if any 442 --s => include subscriber only list(s) if any 443 --remove-duplicates => minimize duplicate email names/addresses 444 --roles => show roles (status:subsystem, git-signer, list, etc...) 445 --rolestats => show roles and statistics (commits/total_commits, %) 446 --scm => print SCM tree(s) if any 447 --status => print status if any 448 --subsystem => print subsystem name if any 449 --web => print website(s) if any 450 451Output type options: 452 --separator [, ] => separator for multiple entries on 1 line 453 using --separator also sets --nomultiline if --separator is not [, ] 454 --multiline => print 1 entry per line 455 456Other options: 457 --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 458 --keywords => scan patch for keywords (default: 1 (on)) 459 --version => show version 460 --help => show this help information 461 462Default options: 463 [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates] 464 465Notes: 466 Using "-f directory" may give unexpected results: 467 Used with "--git", git signators for _all_ files in and below 468 directory are examined as git recurses directories. 469 Any specified X: (exclude) pattern matches are _not_ ignored. 470 Used with "--nogit", directory is used as a pattern match, 471 no individual file within the directory or subdirectory 472 is matched. 473 Used with "--git-blame", does not iterate all files in directory 474 Using "--git-blame" is slow and may add old committers and authors 475 that are no longer active maintainers to the output. 476 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 477 other automated tools that expect only ["name"] <email address> 478 may not work because of additional output after <email address>. 479 Using "--rolestats" and "--git-blame" shows the #/total=% commits, 480 not the percentage of the entire file authored. # of commits is 481 not a good measure of amount of code authored. 1 major commit may 482 contain a thousand lines, 5 trivial commits may modify a single line. 483 If git is not installed, but mercurial (hg) is installed and an .hg 484 repository exists, the following options apply to mercurial: 485 --git, 486 --git-min-signatures, --git-max-maintainers, --git-min-percent, and 487 --git-blame 488 Use --hg-since not --git-since to control date selection 489EOT 490} 491 492sub top_of_kernel_tree { 493 my ($lk_path) = @_; 494 495 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 496 $lk_path .= "/"; 497 } 498 if ( (-f "${lk_path}COPYING") 499 && (-f "${lk_path}CREDITS") 500 && (-f "${lk_path}Kbuild") 501 && (-f "${lk_path}MAINTAINERS") 502 && (-f "${lk_path}Makefile") 503 && (-f "${lk_path}README") 504 && (-d "${lk_path}Documentation") 505 && (-d "${lk_path}arch") 506 && (-d "${lk_path}include") 507 && (-d "${lk_path}drivers") 508 && (-d "${lk_path}fs") 509 && (-d "${lk_path}init") 510 && (-d "${lk_path}ipc") 511 && (-d "${lk_path}kernel") 512 && (-d "${lk_path}lib") 513 && (-d "${lk_path}scripts")) { 514 return 1; 515 } 516 return 0; 517} 518 519sub parse_email { 520 my ($formatted_email) = @_; 521 522 my $name = ""; 523 my $address = ""; 524 525 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 526 $name = $1; 527 $address = $2; 528 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 529 $address = $1; 530 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 531 $address = $1; 532 } 533 534 $name =~ s/^\s+|\s+$//g; 535 $name =~ s/^\"|\"$//g; 536 $address =~ s/^\s+|\s+$//g; 537 538 if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars 539 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 540 $name = "\"$name\""; 541 } 542 543 return ($name, $address); 544} 545 546sub format_email { 547 my ($name, $address, $usename) = @_; 548 549 my $formatted_email; 550 551 $name =~ s/^\s+|\s+$//g; 552 $name =~ s/^\"|\"$//g; 553 $address =~ s/^\s+|\s+$//g; 554 555 if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars 556 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 557 $name = "\"$name\""; 558 } 559 560 if ($usename) { 561 if ("$name" eq "") { 562 $formatted_email = "$address"; 563 } else { 564 $formatted_email = "$name <$address>"; 565 } 566 } else { 567 $formatted_email = $address; 568 } 569 570 return $formatted_email; 571} 572 573sub find_starting_index { 574 my ($index) = @_; 575 576 while ($index > 0) { 577 my $tv = $typevalue[$index]; 578 if (!($tv =~ m/^(\C):\s*(.*)/)) { 579 last; 580 } 581 $index--; 582 } 583 584 return $index; 585} 586 587sub find_ending_index { 588 my ($index) = @_; 589 590 while ($index < @typevalue) { 591 my $tv = $typevalue[$index]; 592 if (!($tv =~ m/^(\C):\s*(.*)/)) { 593 last; 594 } 595 $index++; 596 } 597 598 return $index; 599} 600 601sub get_maintainer_role { 602 my ($index) = @_; 603 604 my $i; 605 my $start = find_starting_index($index); 606 my $end = find_ending_index($index); 607 608 my $role; 609 my $subsystem = $typevalue[$start]; 610 if (length($subsystem) > 20) { 611 $subsystem = substr($subsystem, 0, 17); 612 $subsystem =~ s/\s*$//; 613 $subsystem = $subsystem . "..."; 614 } 615 616 for ($i = $start + 1; $i < $end; $i++) { 617 my $tv = $typevalue[$i]; 618 if ($tv =~ m/^(\C):\s*(.*)/) { 619 my $ptype = $1; 620 my $pvalue = $2; 621 if ($ptype eq "S") { 622 $role = $pvalue; 623 } 624 } 625 } 626 627 $role = lc($role); 628 if ($role eq "supported") { 629 $role = "supporter"; 630 } elsif ($role eq "maintained") { 631 $role = "maintainer"; 632 } elsif ($role eq "odd fixes") { 633 $role = "odd fixer"; 634 } elsif ($role eq "orphan") { 635 $role = "orphan minder"; 636 } elsif ($role eq "obsolete") { 637 $role = "obsolete minder"; 638 } elsif ($role eq "buried alive in reporters") { 639 $role = "chief penguin"; 640 } 641 642 return $role . ":" . $subsystem; 643} 644 645sub get_list_role { 646 my ($index) = @_; 647 648 my $i; 649 my $start = find_starting_index($index); 650 my $end = find_ending_index($index); 651 652 my $subsystem = $typevalue[$start]; 653 if (length($subsystem) > 20) { 654 $subsystem = substr($subsystem, 0, 17); 655 $subsystem =~ s/\s*$//; 656 $subsystem = $subsystem . "..."; 657 } 658 659 if ($subsystem eq "THE REST") { 660 $subsystem = ""; 661 } 662 663 return $subsystem; 664} 665 666sub add_categories { 667 my ($index) = @_; 668 669 my $i; 670 my $start = find_starting_index($index); 671 my $end = find_ending_index($index); 672 673 push(@subsystem, $typevalue[$start]); 674 675 for ($i = $start + 1; $i < $end; $i++) { 676 my $tv = $typevalue[$i]; 677 if ($tv =~ m/^(\C):\s*(.*)/) { 678 my $ptype = $1; 679 my $pvalue = $2; 680 if ($ptype eq "L") { 681 my $list_address = $pvalue; 682 my $list_additional = ""; 683 my $list_role = get_list_role($i); 684 685 if ($list_role ne "") { 686 $list_role = ":" . $list_role; 687 } 688 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 689 $list_address = $1; 690 $list_additional = $2; 691 } 692 if ($list_additional =~ m/subscribers-only/) { 693 if ($email_subscriber_list) { 694 push(@list_to, [$list_address, "subscriber list${list_role}"]); 695 } 696 } else { 697 if ($email_list) { 698 push(@list_to, [$list_address, "open list${list_role}"]); 699 } 700 } 701 } elsif ($ptype eq "M") { 702 my ($name, $address) = parse_email($pvalue); 703 if ($name eq "") { 704 if ($i > 0) { 705 my $tv = $typevalue[$i - 1]; 706 if ($tv =~ m/^(\C):\s*(.*)/) { 707 if ($1 eq "P") { 708 $name = $2; 709 $pvalue = format_email($name, $address, $email_usename); 710 } 711 } 712 } 713 } 714 if ($email_maintainer) { 715 my $role = get_maintainer_role($i); 716 push_email_addresses($pvalue, $role); 717 } 718 } elsif ($ptype eq "T") { 719 push(@scm, $pvalue); 720 } elsif ($ptype eq "W") { 721 push(@web, $pvalue); 722 } elsif ($ptype eq "S") { 723 push(@status, $pvalue); 724 } 725 } 726 } 727} 728 729my %email_hash_name; 730my %email_hash_address; 731 732sub email_inuse { 733 my ($name, $address) = @_; 734 735 return 1 if (($name eq "") && ($address eq "")); 736 return 1 if (($name ne "") && exists($email_hash_name{$name})); 737 return 1 if (($address ne "") && exists($email_hash_address{$address})); 738 739 return 0; 740} 741 742sub push_email_address { 743 my ($line, $role) = @_; 744 745 my ($name, $address) = parse_email($line); 746 747 if ($address eq "") { 748 return 0; 749 } 750 751 if (!$email_remove_duplicates) { 752 push(@email_to, [format_email($name, $address, $email_usename), $role]); 753 } elsif (!email_inuse($name, $address)) { 754 push(@email_to, [format_email($name, $address, $email_usename), $role]); 755 $email_hash_name{$name}++; 756 $email_hash_address{$address}++; 757 } 758 759 return 1; 760} 761 762sub push_email_addresses { 763 my ($address, $role) = @_; 764 765 my @address_list = (); 766 767 if (rfc822_valid($address)) { 768 push_email_address($address, $role); 769 } elsif (@address_list = rfc822_validlist($address)) { 770 my $array_count = shift(@address_list); 771 while (my $entry = shift(@address_list)) { 772 push_email_address($entry, $role); 773 } 774 } else { 775 if (!push_email_address($address, $role)) { 776 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 777 } 778 } 779} 780 781sub add_role { 782 my ($line, $role) = @_; 783 784 my ($name, $address) = parse_email($line); 785 my $email = format_email($name, $address, $email_usename); 786 787 foreach my $entry (@email_to) { 788 if ($email_remove_duplicates) { 789 my ($entry_name, $entry_address) = parse_email($entry->[0]); 790 if ($name eq $entry_name || $address eq $entry_address) { 791 if ($entry->[1] eq "") { 792 $entry->[1] = "$role"; 793 } else { 794 $entry->[1] = "$entry->[1],$role"; 795 } 796 } 797 } else { 798 if ($email eq $entry->[0]) { 799 if ($entry->[1] eq "") { 800 $entry->[1] = "$role"; 801 } else { 802 $entry->[1] = "$entry->[1],$role"; 803 } 804 } 805 } 806 } 807} 808 809sub which { 810 my ($bin) = @_; 811 812 foreach my $path (split(/:/, $ENV{PATH})) { 813 if (-e "$path/$bin") { 814 return "$path/$bin"; 815 } 816 } 817 818 return ""; 819} 820 821sub mailmap { 822 my (@lines) = @_; 823 my %hash; 824 825 foreach my $line (@lines) { 826 my ($name, $address) = parse_email($line); 827 if (!exists($hash{$name})) { 828 $hash{$name} = $address; 829 } elsif ($address ne $hash{$name}) { 830 $address = $hash{$name}; 831 $line = format_email($name, $address, $email_usename); 832 } 833 if (exists($mailmap{$name})) { 834 my $obj = $mailmap{$name}; 835 foreach my $map_address (@$obj) { 836 if (($map_address eq $address) && 837 ($map_address ne $hash{$name})) { 838 $line = format_email($name, $hash{$name}, $email_usename); 839 } 840 } 841 } 842 } 843 844 return @lines; 845} 846 847sub git_execute_cmd { 848 my ($cmd) = @_; 849 my @lines = (); 850 851 my $output = `$cmd`; 852 $output =~ s/^\s*//gm; 853 @lines = split("\n", $output); 854 855 return @lines; 856} 857 858sub hg_execute_cmd { 859 my ($cmd) = @_; 860 my @lines = (); 861 862 my $output = `$cmd`; 863 @lines = split("\n", $output); 864 865 return @lines; 866} 867 868sub vcs_find_signers { 869 my ($cmd) = @_; 870 my @lines = (); 871 my $commits; 872 873 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 874 875 my $pattern = $VCS_cmds{"commit_pattern"}; 876 877 $commits = grep(/$pattern/, @lines); # of commits 878 879 @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines); 880 if (!$email_git_penguin_chiefs) { 881 @lines = grep(!/${penguin_chiefs}/i, @lines); 882 } 883 # cut -f2- -d":" 884 s/.*:\s*(.+)\s*/$1/ for (@lines); 885 886## Reformat email addresses (with names) to avoid badly written signatures 887 888 foreach my $line (@lines) { 889 my ($name, $address) = parse_email($line); 890 $line = format_email($name, $address, 1); 891 } 892 893 return ($commits, @lines); 894} 895 896sub vcs_save_commits { 897 my ($cmd) = @_; 898 my @lines = (); 899 my @commits = (); 900 901 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 902 903 foreach my $line (@lines) { 904 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 905 push(@commits, $1); 906 } 907 } 908 909 return @commits; 910} 911 912sub vcs_blame { 913 my ($file) = @_; 914 my $cmd; 915 my @commits = (); 916 917 return @commits if (!(-f $file)); 918 919 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 920 my @all_commits = (); 921 922 $cmd = $VCS_cmds{"blame_file_cmd"}; 923 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 924 @all_commits = vcs_save_commits($cmd); 925 926 foreach my $file_range_diff (@range) { 927 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 928 my $diff_file = $1; 929 my $diff_start = $2; 930 my $diff_length = $3; 931 next if ("$file" ne "$diff_file"); 932 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 933 push(@commits, $all_commits[$i]); 934 } 935 } 936 } elsif (@range) { 937 foreach my $file_range_diff (@range) { 938 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 939 my $diff_file = $1; 940 my $diff_start = $2; 941 my $diff_length = $3; 942 next if ("$file" ne "$diff_file"); 943 $cmd = $VCS_cmds{"blame_range_cmd"}; 944 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 945 push(@commits, vcs_save_commits($cmd)); 946 } 947 } else { 948 $cmd = $VCS_cmds{"blame_file_cmd"}; 949 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 950 @commits = vcs_save_commits($cmd); 951 } 952 953 return @commits; 954} 955 956my $printed_novcs = 0; 957sub vcs_exists { 958 %VCS_cmds = %VCS_cmds_git; 959 return 1 if eval $VCS_cmds{"available"}; 960 %VCS_cmds = %VCS_cmds_hg; 961 return 1 if eval $VCS_cmds{"available"}; 962 %VCS_cmds = (); 963 if (!$printed_novcs) { 964 warn("$P: No supported VCS found. Add --nogit to options?\n"); 965 warn("Using a git repository produces better results.\n"); 966 warn("Try Linus Torvalds' latest git repository using:\n"); 967 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n"); 968 $printed_novcs = 1; 969 } 970 return 0; 971} 972 973sub vcs_assign { 974 my ($role, $divisor, @lines) = @_; 975 976 my %hash; 977 my $count = 0; 978 979 return if (@lines <= 0); 980 981 if ($divisor <= 0) { 982 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 983 $divisor = 1; 984 } 985 986 if ($email_remove_duplicates) { 987 @lines = mailmap(@lines); 988 } 989 990 @lines = sort(@lines); 991 992 # uniq -c 993 $hash{$_}++ for @lines; 994 995 # sort -rn 996 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 997 my $sign_offs = $hash{$line}; 998 my $percent = $sign_offs * 100 / $divisor; 999 1000 $percent = 100 if ($percent > 100); 1001 $count++; 1002 last if ($sign_offs < $email_git_min_signatures || 1003 $count > $email_git_max_maintainers || 1004 $percent < $email_git_min_percent); 1005 push_email_address($line, ''); 1006 if ($output_rolestats) { 1007 my $fmt_percent = sprintf("%.0f", $percent); 1008 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1009 } else { 1010 add_role($line, $role); 1011 } 1012 } 1013} 1014 1015sub vcs_file_signoffs { 1016 my ($file) = @_; 1017 1018 my @signers = (); 1019 my $commits; 1020 1021 return if (!vcs_exists()); 1022 1023 my $cmd = $VCS_cmds{"find_signers_cmd"}; 1024 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1025 1026 ($commits, @signers) = vcs_find_signers($cmd); 1027 vcs_assign("commit_signer", $commits, @signers); 1028} 1029 1030sub vcs_file_blame { 1031 my ($file) = @_; 1032 1033 my @signers = (); 1034 my @commits = (); 1035 my $total_commits; 1036 1037 return if (!vcs_exists()); 1038 1039 @commits = vcs_blame($file); 1040 @commits = uniq(@commits); 1041 $total_commits = @commits; 1042 1043 foreach my $commit (@commits) { 1044 my $commit_count; 1045 my @commit_signers = (); 1046 1047 my $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1048 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1049 1050 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1051 push(@signers, @commit_signers); 1052 } 1053 1054 if ($from_filename) { 1055 vcs_assign("commits", $total_commits, @signers); 1056 } else { 1057 vcs_assign("modified commits", $total_commits, @signers); 1058 } 1059} 1060 1061sub uniq { 1062 my (@parms) = @_; 1063 1064 my %saw; 1065 @parms = grep(!$saw{$_}++, @parms); 1066 return @parms; 1067} 1068 1069sub sort_and_uniq { 1070 my (@parms) = @_; 1071 1072 my %saw; 1073 @parms = sort @parms; 1074 @parms = grep(!$saw{$_}++, @parms); 1075 return @parms; 1076} 1077 1078sub merge_email { 1079 my @lines; 1080 my %saw; 1081 1082 for (@_) { 1083 my ($address, $role) = @$_; 1084 if (!$saw{$address}) { 1085 if ($output_roles) { 1086 push(@lines, "$address ($role)"); 1087 } else { 1088 push(@lines, $address); 1089 } 1090 $saw{$address} = 1; 1091 } 1092 } 1093 1094 return @lines; 1095} 1096 1097sub output { 1098 my (@parms) = @_; 1099 1100 if ($output_multiline) { 1101 foreach my $line (@parms) { 1102 print("${line}\n"); 1103 } 1104 } else { 1105 print(join($output_separator, @parms)); 1106 print("\n"); 1107 } 1108} 1109 1110my $rfc822re; 1111 1112sub make_rfc822re { 1113# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 1114# comment. We must allow for rfc822_lwsp (or comments) after each of these. 1115# This regexp will only work on addresses which have had comments stripped 1116# and replaced with rfc822_lwsp. 1117 1118 my $specials = '()<>@,;:\\\\".\\[\\]'; 1119 my $controls = '\\000-\\037\\177'; 1120 1121 my $dtext = "[^\\[\\]\\r\\\\]"; 1122 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 1123 1124 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 1125 1126# Use zero-width assertion to spot the limit of an atom. A simple 1127# $rfc822_lwsp* causes the regexp engine to hang occasionally. 1128 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 1129 my $word = "(?:$atom|$quoted_string)"; 1130 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 1131 1132 my $sub_domain = "(?:$atom|$domain_literal)"; 1133 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 1134 1135 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 1136 1137 my $phrase = "$word*"; 1138 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 1139 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 1140 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 1141 1142 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 1143 my $address = "(?:$mailbox|$group)"; 1144 1145 return "$rfc822_lwsp*$address"; 1146} 1147 1148sub rfc822_strip_comments { 1149 my $s = shift; 1150# Recursively remove comments, and replace with a single space. The simpler 1151# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 1152# chars in atoms, for example. 1153 1154 while ($s =~ s/^((?:[^"\\]|\\.)* 1155 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 1156 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 1157 return $s; 1158} 1159 1160# valid: returns true if the parameter is an RFC822 valid address 1161# 1162sub rfc822_valid ($) { 1163 my $s = rfc822_strip_comments(shift); 1164 1165 if (!$rfc822re) { 1166 $rfc822re = make_rfc822re(); 1167 } 1168 1169 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 1170} 1171 1172# validlist: In scalar context, returns true if the parameter is an RFC822 1173# valid list of addresses. 1174# 1175# In list context, returns an empty list on failure (an invalid 1176# address was found); otherwise a list whose first element is the 1177# number of addresses found and whose remaining elements are the 1178# addresses. This is needed to disambiguate failure (invalid) 1179# from success with no addresses found, because an empty string is 1180# a valid list. 1181 1182sub rfc822_validlist ($) { 1183 my $s = rfc822_strip_comments(shift); 1184 1185 if (!$rfc822re) { 1186 $rfc822re = make_rfc822re(); 1187 } 1188 # * null list items are valid according to the RFC 1189 # * the '1' business is to aid in distinguishing failure from no results 1190 1191 my @r; 1192 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 1193 $s =~ m/^$rfc822_char*$/) { 1194 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 1195 push(@r, $1); 1196 } 1197 return wantarray ? (scalar(@r), @r) : 1; 1198 } 1199 return wantarray ? () : 0; 1200} 1201