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