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