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