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