SAFE public projects git trees. - safe/jmp/linux-2.6/blob - scripts/get_maintainer.pl

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