linux/scripts/get_maintainer.pl
<<
>>
Prefs 
   1#!/usr/bin/perl -w
   2# (c) 2007, Joe Perches <joe@perches.com>
   3#           created from checkpatch.pl
   4#
   5# Print selected MAINTAINERS information for
   6# the files modified in a patch or for a file
   7#
   8# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
   9#        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
  10#
  11# Licensed under the terms of the GNU GPL License version 2
  12
  13use strict;
  14
  15my $P = $0;
  16my $V = '0.26';
  17
  18use Getopt::Long qw(:config no_auto_abbrev);
  19
  20my $lk_path = "./";
  21my $email = 1;
  22my $email_usename = 1;
  23my $email_maintainer = 1;
  24my $email_reviewer = 1;
  25my $email_list = 1;
  26my $email_subscriber_list = 0;
  27my $email_git_penguin_chiefs = 0;
  28my $email_git = 0;
  29my $email_git_all_signature_types = 0;
  30my $email_git_blame = 0;
  31my $email_git_blame_signatures = 1;
  32my $email_git_fallback = 1;
  33my $email_git_min_signatures = 1;
  34my $email_git_max_maintainers = 5;
  35my $email_git_min_percent = 5;
  36my $email_git_since = "1-year-ago";
  37my $email_hg_since = "-365";
  38my $interactive = 0;
  39my $email_remove_duplicates = 1;
  40my $email_use_mailmap = 1;
  41my $output_multiline = 1;
  42my $output_separator = ", ";
  43my $output_roles = 0;
  44my $output_rolestats = 1;
  45my $output_section_maxlen = 50;
  46my $scm = 0;
  47my $web = 0;
  48my $subsystem = 0;
  49my $status = 0;
  50my $keywords = 1;
  51my $sections = 0;
  52my $file_emails = 0;
  53my $from_filename = 0;
  54my $pattern_depth = 0;
  55my $version = 0;
  56my $help = 0;
  57
  58my $vcs_used = 0;
  59
  60my $exit = 0;
  61
  62my %commit_author_hash;
  63my %commit_signer_hash;
  64
  65my @penguin_chief = ();
  66push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
  67#Andrew wants in on most everything - 2009/01/14
  68#push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  69
  70my @penguin_chief_names = ();
  71foreach my $chief (@penguin_chief) {
  72    if ($chief =~ m/^(.*):(.*)/) {
  73        my $chief_name = $1;
  74        my $chief_addr = $2;
  75        push(@penguin_chief_names, $chief_name);
  76    }
  77}
  78my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  79
  80# Signature types of people who are either
  81#       a) responsible for the code in question, or
  82#       b) familiar enough with it to give relevant feedback
  83my @signature_tags = ();
  84push(@signature_tags, "Signed-off-by:");
  85push(@signature_tags, "Reviewed-by:");
  86push(@signature_tags, "Acked-by:");
  87
  88my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
  89
  90# rfc822 email address - preloaded methods go here.
  91my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  92my $rfc822_char = '[\\000-\\377]';
  93
  94# VCS command support: class-like functions and strings
  95
  96my %VCS_cmds;
  97
  98my %VCS_cmds_git = (
  99    "execute_cmd" => \&git_execute_cmd,
 100    "available" => '(which("git") ne "") && (-e ".git")',
 101    "find_signers_cmd" =>
 102        "git log --no-color --follow --since=\$email_git_since " .
 103            '--numstat --no-merges ' .
 104            '--format="GitCommit: %H%n' .
 105                      'GitAuthor: %an <%ae>%n' .
 106                      'GitDate: %aD%n' .
 107                      'GitSubject: %s%n' .
 108                      '%b%n"' .
 109            " -- \$file",
 110    "find_commit_signers_cmd" =>
 111        "git log --no-color " .
 112            '--numstat ' .
 113            '--format="GitCommit: %H%n' .
 114                      'GitAuthor: %an <%ae>%n' .
 115                      'GitDate: %aD%n' .
 116                      'GitSubject: %s%n' .
 117                      '%b%n"' .
 118            " -1 \$commit",
 119    "find_commit_author_cmd" =>
 120        "git log --no-color " .
 121            '--numstat ' .
 122            '--format="GitCommit: %H%n' .
 123                      'GitAuthor: %an <%ae>%n' .
 124                      'GitDate: %aD%n' .
 125                      'GitSubject: %s%n"' .
 126            " -1 \$commit",
 127    "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 128    "blame_file_cmd" => "git blame -l \$file",
 129    "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 130    "blame_commit_pattern" => "^([0-9a-f]+) ",
 131    "author_pattern" => "^GitAuthor: (.*)",
 132    "subject_pattern" => "^GitSubject: (.*)",
 133    "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 134);
 135
 136my %VCS_cmds_hg = (
 137    "execute_cmd" => \&hg_execute_cmd,
 138    "available" => '(which("hg") ne "") && (-d ".hg")',
 139    "find_signers_cmd" =>
 140        "hg log --date=\$email_hg_since " .
 141            "--template='HgCommit: {node}\\n" .
 142                        "HgAuthor: {author}\\n" .
 143                        "HgSubject: {desc}\\n'" .
 144            " -- \$file",
 145    "find_commit_signers_cmd" =>
 146        "hg log " .
 147            "--template='HgSubject: {desc}\\n'" .
 148            " -r \$commit",
 149    "find_commit_author_cmd" =>
 150        "hg log " .
 151            "--template='HgCommit: {node}\\n" .
 152                        "HgAuthor: {author}\\n" .
 153                        "HgSubject: {desc|firstline}\\n'" .
 154            " -r \$commit",
 155    "blame_range_cmd" => "",            # not supported
 156    "blame_file_cmd" => "hg blame -n \$file",
 157    "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 158    "blame_commit_pattern" => "^([ 0-9a-f]+):",
 159    "author_pattern" => "^HgAuthor: (.*)",
 160    "subject_pattern" => "^HgSubject: (.*)",
 161    "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 162);
 163
 164my $conf = which_conf(".get_maintainer.conf");
 165if (-f $conf) {
 166    my @conf_args;
 167    open(my $conffile, '<', "$conf")
 168        or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 169
 170    while (<$conffile>) {
 171        my $line = $_;
 172
 173        $line =~ s/\s*\n?$//g;
 174        $line =~ s/^\s*//g;
 175        $line =~ s/\s+/ /g;
 176
 177        next if ($line =~ m/^\s*#/);
 178        next if ($line =~ m/^\s*$/);
 179
 180        my @words = split(" ", $line);
 181        foreach my $word (@words) {
 182            last if ($word =~ m/^#/);
 183            push (@conf_args, $word);
 184        }
 185    }
 186    close($conffile);
 187    unshift(@ARGV, @conf_args) if @conf_args;
 188}
 189
 190my @ignore_emails = ();
 191my $ignore_file = which_conf(".get_maintainer.ignore");
 192if (-f $ignore_file) {
 193    open(my $ignore, '<', "$ignore_file")
 194        or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
 195    while (<$ignore>) {
 196        my $line = $_;
 197
 198        $line =~ s/\s*\n?$//;
 199        $line =~ s/^\s*//;
 200        $line =~ s/\s+$//;
 201        $line =~ s/#.*$//;
 202
 203        next if ($line =~ m/^\s*$/);
 204        if (rfc822_valid($line)) {
 205            push(@ignore_emails, $line);
 206        }
 207    }
 208    close($ignore);
 209}
 210
 211if (!GetOptions(
 212                'email!' => \$email,
 213                'git!' => \$email_git,
 214                'git-all-signature-types!' => \$email_git_all_signature_types,
 215                'git-blame!' => \$email_git_blame,
 216                'git-blame-signatures!' => \$email_git_blame_signatures,
 217                'git-fallback!' => \$email_git_fallback,
 218                'git-chief-penguins!' => \$email_git_penguin_chiefs,
 219                'git-min-signatures=i' => \$email_git_min_signatures,
 220                'git-max-maintainers=i' => \$email_git_max_maintainers,
 221                'git-min-percent=i' => \$email_git_min_percent,
 222                'git-since=s' => \$email_git_since,
 223                'hg-since=s' => \$email_hg_since,
 224                'i|interactive!' => \$interactive,
 225                'remove-duplicates!' => \$email_remove_duplicates,
 226                'mailmap!' => \$email_use_mailmap,
 227                'm!' => \$email_maintainer,
 228                'r!' => \$email_reviewer,
 229                'n!' => \$email_usename,
 230                'l!' => \$email_list,
 231                's!' => \$email_subscriber_list,
 232                'multiline!' => \$output_multiline,
 233                'roles!' => \$output_roles,
 234                'rolestats!' => \$output_rolestats,
 235                'separator=s' => \$output_separator,
 236                'subsystem!' => \$subsystem,
 237                'status!' => \$status,
 238                'scm!' => \$scm,
 239                'web!' => \$web,
 240                'pattern-depth=i' => \$pattern_depth,
 241                'k|keywords!' => \$keywords,
 242                'sections!' => \$sections,
 243                'fe|file-emails!' => \$file_emails,
 244                'f|file' => \$from_filename,
 245                'v|version' => \$version,
 246                'h|help|usage' => \$help,
 247                )) {
 248    die "$P: invalid argument - use --help if necessary\n";
 249}
 250
 251if ($help != 0) {
 252    usage();
 253    exit 0;
 254}
 255
 256if ($version != 0) {
 257    print("${P} ${V}\n");
 258    exit 0;
 259}
 260
 261if (-t STDIN && !@ARGV) {
 262    # We're talking to a terminal, but have no command line arguments.
 263    die "$P: missing patchfile or -f file - use --help if necessary\n";
 264}
 265
 266$output_multiline = 0 if ($output_separator ne ", ");
 267$output_rolestats = 1 if ($interactive);
 268$output_roles = 1 if ($output_rolestats);
 269
 270if ($sections) {
 271    $email = 0;
 272    $email_list = 0;
 273    $scm = 0;
 274    $status = 0;
 275    $subsystem = 0;
 276    $web = 0;
 277    $keywords = 0;
 278    $interactive = 0;
 279} else {
 280    my $selections = $email + $scm + $status + $subsystem + $web;
 281    if ($selections == 0) {
 282        die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 283    }
 284}
 285
 286if ($email &&
 287    ($email_maintainer + $email_reviewer +
 288     $email_list + $email_subscriber_list +
 289     $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 290    die "$P: Please select at least 1 email option\n";
 291}
 292
 293if (!top_of_kernel_tree($lk_path)) {
 294    die "$P: The current directory does not appear to be "
 295        . "a linux kernel source tree.\n";
 296}
 297
 298## Read MAINTAINERS for type/value pairs
 299
 300my @typevalue = ();
 301my %keyword_hash;
 302
 303open (my $maint, '<', "${lk_path}MAINTAINERS")
 304    or die "$P: Can't open MAINTAINERS: $!\n";
 305while (<$maint>) {
 306    my $line = $_;
 307
 308    if ($line =~ m/^([A-Z]):\s*(.*)/) {
 309        my $type = $1;
 310        my $value = $2;
 311
 312        ##Filename pattern matching
 313        if ($type eq "F" || $type eq "X") {
 314            $value =~ s@\.@\\\.@g;       ##Convert . to \.
 315            $value =~ s/\*/\.\*/g;       ##Convert * to .*
 316            $value =~ s/\?/\./g;         ##Convert ? to .
 317            ##if pattern is a directory and it lacks a trailing slash, add one
 318            if ((-d $value)) {
 319                $value =~ s@([^/])$@$1/@;
 320            }
 321        } elsif ($type eq "K") {
 322            $keyword_hash{@typevalue} = $value;
 323        }
 324        push(@typevalue, "$type:$value");
 325    } elsif (!/^(\s)*$/) {
 326        $line =~ s/\n$//g;
 327        push(@typevalue, $line);
 328    }
 329}
 330close($maint);
 331
 332
 333#
 334# Read mail address map
 335#
 336
 337my $mailmap;
 338
 339read_mailmap();
 340
 341sub read_mailmap {
 342    $mailmap = {
 343        names => {},
 344        addresses => {}
 345    };
 346
 347    return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 348
 349    open(my $mailmap_file, '<', "${lk_path}.mailmap")
 350        or warn "$P: Can't open .mailmap: $!\n";
 351
 352    while (<$mailmap_file>) {
 353        s/#.*$//; #strip comments
 354        s/^\s+|\s+$//g; #trim
 355
 356        next if (/^\s*$/); #skip empty lines
 357        #entries have one of the following formats:
 358        # name1 <mail1>
 359        # <mail1> <mail2>
 360        # name1 <mail1> <mail2>
 361        # name1 <mail1> name2 <mail2>
 362        # (see man git-shortlog)
 363
 364        if (/^([^<]+)<([^>]+)>$/) {
 365            my $real_name = $1;
 366            my $address = $2;
 367
 368            $real_name =~ s/\s+$//;
 369            ($real_name, $address) = parse_email("$real_name <$address>");
 370            $mailmap->{names}->{$address} = $real_name;
 371
 372        } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 373            my $real_address = $1;
 374            my $wrong_address = $2;
 375
 376            $mailmap->{addresses}->{$wrong_address} = $real_address;
 377
 378        } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 379            my $real_name = $1;
 380            my $real_address = $2;
 381            my $wrong_address = $3;
 382
 383            $real_name =~ s/\s+$//;
 384            ($real_name, $real_address) =
 385                parse_email("$real_name <$real_address>");
 386            $mailmap->{names}->{$wrong_address} = $real_name;
 387            $mailmap->{addresses}->{$wrong_address} = $real_address;
 388
 389        } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 390            my $real_name = $1;
 391            my $real_address = $2;
 392            my $wrong_name = $3;
 393            my $wrong_address = $4;
 394
 395            $real_name =~ s/\s+$//;
 396            ($real_name, $real_address) =
 397                parse_email("$real_name <$real_address>");
 398
 399            $wrong_name =~ s/\s+$//;
 400            ($wrong_name, $wrong_address) =
 401                parse_email("$wrong_name <$wrong_address>");
 402
 403            my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 404            $mailmap->{names}->{$wrong_email} = $real_name;
 405            $mailmap->{addresses}->{$wrong_email} = $real_address;
 406        }
 407    }
 408    close($mailmap_file);
 409}
 410
 411## use the filenames on the command line or find the filenames in the patchfiles
 412
 413my @files = ();
 414my @range = ();
 415my @keyword_tvi = ();
 416my @file_emails = ();
 417
 418if (!@ARGV) {
 419    push(@ARGV, "&STDIN");
 420}
 421
 422foreach my $file (@ARGV) {
 423    if ($file ne "&STDIN") {
 424        ##if $file is a directory and it lacks a trailing slash, add one
 425        if ((-d $file)) {
 426            $file =~ s@([^/])$@$1/@;
 427        } elsif (!(-f $file)) {
 428            die "$P: file '${file}' not found\n";
 429        }
 430    }
 431    if ($from_filename) {
 432        push(@files, $file);
 433        if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
 434            open(my $f, '<', $file)
 435                or die "$P: Can't open $file: $!\n";
 436            my $text = do { local($/) ; <$f> };
 437            close($f);
 438            if ($keywords) {
 439                foreach my $line (keys %keyword_hash) {
 440                    if ($text =~ m/$keyword_hash{$line}/x) {
 441                        push(@keyword_tvi, $line);
 442                    }
 443                }
 444            }
 445            if ($file_emails) {
 446                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;
 447                push(@file_emails, clean_file_emails(@poss_addr));
 448            }
 449        }
 450    } else {
 451        my $file_cnt = @files;
 452        my $lastfile;
 453
 454        open(my $patch, "< $file")
 455            or die "$P: Can't open $file: $!\n";
 456
 457        # We can check arbitrary information before the patch
 458        # like the commit message, mail headers, etc...
 459        # This allows us to match arbitrary keywords against any part
 460        # of a git format-patch generated file (subject tags, etc...)
 461
 462        my $patch_prefix = "";                  #Parsing the intro
 463
 464        while (<$patch>) {
 465            my $patch_line = $_;
 466            if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 467                my $filename = $1;
 468                $filename =~ s@^[^/]*/@@;
 469                $filename =~ s@\n@@;
 470                $lastfile = $filename;
 471                push(@files, $filename);
 472                $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 473            } elsif (m/^\@\@ -(\d+),(\d+)/) {
 474                if ($email_git_blame) {
 475                    push(@range, "$lastfile:$1:$2");
 476                }
 477            } elsif ($keywords) {
 478                foreach my $line (keys %keyword_hash) {
 479                    if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 480                        push(@keyword_tvi, $line);
 481                    }
 482                }
 483            }
 484        }
 485        close($patch);
 486
 487        if ($file_cnt == @files) {
 488            warn "$P: file '${file}' doesn't appear to be a patch.  "
 489                . "Add -f to options?\n";
 490        }
 491        @files = sort_and_uniq(@files);
 492    }
 493}
 494
 495@file_emails = uniq(@file_emails);
 496
 497my %email_hash_name;
 498my %email_hash_address;
 499my @email_to = ();
 500my %hash_list_to;
 501my @list_to = ();
 502my @scm = ();
 503my @web = ();
 504my @subsystem = ();
 505my @status = ();
 506my %deduplicate_name_hash = ();
 507my %deduplicate_address_hash = ();
 508
 509my @maintainers = get_maintainers();
 510
 511if (@maintainers) {
 512    @maintainers = merge_email(@maintainers);
 513    output(@maintainers);
 514}
 515
 516if ($scm) {
 517    @scm = uniq(@scm);
 518    output(@scm);
 519}
 520
 521if ($status) {
 522    @status = uniq(@status);
 523    output(@status);
 524}
 525
 526if ($subsystem) {
 527    @subsystem = uniq(@subsystem);
 528    output(@subsystem);
 529}
 530
 531if ($web) {
 532    @web = uniq(@web);
 533    output(@web);
 534}
 535
 536exit($exit);
 537
 538sub ignore_email_address {
 539    my ($address) = @_;
 540
 541    foreach my $ignore (@ignore_emails) {
 542        return 1 if ($ignore eq $address);
 543    }
 544
 545    return 0;
 546}
 547
 548sub range_is_maintained {
 549    my ($start, $end) = @_;
 550
 551    for (my $i = $start; $i < $end; $i++) {
 552        my $line = $typevalue[$i];
 553        if ($line =~ m/^([A-Z]):\s*(.*)/) {
 554            my $type = $1;
 555            my $value = $2;
 556            if ($type eq 'S') {
 557                if ($value =~ /(maintain|support)/i) {
 558                    return 1;
 559                }
 560            }
 561        }
 562    }
 563    return 0;
 564}
 565
 566sub range_has_maintainer {
 567    my ($start, $end) = @_;
 568
 569    for (my $i = $start; $i < $end; $i++) {
 570        my $line = $typevalue[$i];
 571        if ($line =~ m/^([A-Z]):\s*(.*)/) {
 572            my $type = $1;
 573            my $value = $2;
 574            if ($type eq 'M') {
 575                return 1;
 576            }
 577        }
 578    }
 579    return 0;
 580}
 581
 582sub get_maintainers {
 583    %email_hash_name = ();
 584    %email_hash_address = ();
 585    %commit_author_hash = ();
 586    %commit_signer_hash = ();
 587    @email_to = ();
 588    %hash_list_to = ();
 589    @list_to = ();
 590    @scm = ();
 591    @web = ();
 592    @subsystem = ();
 593    @status = ();
 594    %deduplicate_name_hash = ();
 595    %deduplicate_address_hash = ();
 596    if ($email_git_all_signature_types) {
 597        $signature_pattern = "(.+?)[Bb][Yy]:";
 598    } else {
 599        $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 600    }
 601
 602    # Find responsible parties
 603
 604    my %exact_pattern_match_hash = ();
 605
 606    foreach my $file (@files) {
 607
 608        my %hash;
 609        my $tvi = find_first_section();
 610        while ($tvi < @typevalue) {
 611            my $start = find_starting_index($tvi);
 612            my $end = find_ending_index($tvi);
 613            my $exclude = 0;
 614            my $i;
 615
 616            #Do not match excluded file patterns
 617
 618            for ($i = $start; $i < $end; $i++) {
 619                my $line = $typevalue[$i];
 620                if ($line =~ m/^([A-Z]):\s*(.*)/) {
 621                    my $type = $1;
 622                    my $value = $2;
 623                    if ($type eq 'X') {
 624                        if (file_match_pattern($file, $value)) {
 625                            $exclude = 1;
 626                            last;
 627                        }
 628                    }
 629                }
 630            }
 631
 632            if (!$exclude) {
 633                for ($i = $start; $i < $end; $i++) {
 634                    my $line = $typevalue[$i];
 635                    if ($line =~ m/^([A-Z]):\s*(.*)/) {
 636                        my $type = $1;
 637                        my $value = $2;
 638                        if ($type eq 'F') {
 639                            if (file_match_pattern($file, $value)) {
 640                                my $value_pd = ($value =~ tr@/@@);
 641                                my $file_pd = ($file  =~ tr@/@@);
 642                                $value_pd++ if (substr($value,-1,1) ne "/");
 643                                $value_pd = -1 if ($value =~ /^\.\*/);
 644                                if ($value_pd >= $file_pd &&
 645                                    range_is_maintained($start, $end) &&
 646                                    range_has_maintainer($start, $end)) {
 647                                    $exact_pattern_match_hash{$file} = 1;
 648                                }
 649                                if ($pattern_depth == 0 ||
 650                                    (($file_pd - $value_pd) < $pattern_depth)) {
 651                                    $hash{$tvi} = $value_pd;
 652                                }
 653                            }
 654                        } elsif ($type eq 'N') {
 655                            if ($file =~ m/$value/x) {
 656                                $hash{$tvi} = 0;
 657                            }
 658                        }
 659                    }
 660                }
 661            }
 662            $tvi = $end + 1;
 663        }
 664
 665        foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 666            add_categories($line);
 667            if ($sections) {
 668                my $i;
 669                my $start = find_starting_index($line);
 670                my $end = find_ending_index($line);
 671                for ($i = $start; $i < $end; $i++) {
 672                    my $line = $typevalue[$i];
 673                    if ($line =~ /^[FX]:/) {            ##Restore file patterns
 674                        $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 675                        $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 676                        $line =~ s/\\\./\./g;           ##Convert \. to .
 677                        $line =~ s/\.\*/\*/g;           ##Convert .* to *
 678                    }
 679                    $line =~ s/^([A-Z]):/$1:\t/g;
 680                    print("$line\n");
 681                }
 682                print("\n");
 683            }
 684        }
 685    }
 686
 687    if ($keywords) {
 688        @keyword_tvi = sort_and_uniq(@keyword_tvi);
 689        foreach my $line (@keyword_tvi) {
 690            add_categories($line);
 691        }
 692    }
 693
 694    foreach my $email (@email_to, @list_to) {
 695        $email->[0] = deduplicate_email($email->[0]);
 696    }
 697
 698    foreach my $file (@files) {
 699        if ($email &&
 700            ($email_git || ($email_git_fallback &&
 701                            !$exact_pattern_match_hash{$file}))) {
 702            vcs_file_signoffs($file);
 703        }
 704        if ($email && $email_git_blame) {
 705            vcs_file_blame($file);
 706        }
 707    }
 708
 709    if ($email) {
 710        foreach my $chief (@penguin_chief) {
 711            if ($chief =~ m/^(.*):(.*)/) {
 712                my $email_address;
 713
 714                $email_address = format_email($1, $2, $email_usename);
 715                if ($email_git_penguin_chiefs) {
 716                    push(@email_to, [$email_address, 'chief penguin']);
 717                } else {
 718                    @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 719                }
 720            }
 721        }
 722
 723        foreach my $email (@file_emails) {
 724            my ($name, $address) = parse_email($email);
 725
 726            my $tmp_email = format_email($name, $address, $email_usename);
 727            push_email_address($tmp_email, '');
 728            add_role($tmp_email, 'in file');
 729        }
 730    }
 731
 732    my @to = ();
 733    if ($email || $email_list) {
 734        if ($email) {
 735            @to = (@to, @email_to);
 736        }
 737        if ($email_list) {
 738            @to = (@to, @list_to);
 739        }
 740    }
 741
 742    if ($interactive) {
 743        @to = interactive_get_maintainers(\@to);
 744    }
 745
 746    return @to;
 747}
 748
 749sub file_match_pattern {
 750    my ($file, $pattern) = @_;
 751    if (substr($pattern, -1) eq "/") {
 752        if ($file =~ m@^$pattern@) {
 753            return 1;
 754        }
 755    } else {
 756        if ($file =~ m@^$pattern@) {
 757            my $s1 = ($file =~ tr@/@@);
 758            my $s2 = ($pattern =~ tr@/@@);
 759            if ($s1 == $s2) {
 760                return 1;
 761            }
 762        }
 763    }
 764    return 0;
 765}
 766
 767sub usage {
 768    print <<EOT;
 769usage: $P [options] patchfile
 770       $P [options] -f file|directory
 771version: $V
 772
 773MAINTAINER field selection options:
 774  --email => print email address(es) if any
 775    --git => include recent git \*-by: signers
 776    --git-all-signature-types => include signers regardless of signature type
 777        or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
 778    --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
 779    --git-chief-penguins => include ${penguin_chiefs}
 780    --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
 781    --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
 782    --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
 783    --git-blame => use git blame to find modified commits for patch or file
 784    --git-since => git history to use (default: $email_git_since)
 785    --hg-since => hg history to use (default: $email_hg_since)
 786    --interactive => display a menu (mostly useful if used with the --git option)
 787    --m => include maintainer(s) if any
 788    --r => include reviewer(s) if any
 789    --n => include name 'Full Name <addr\@domain.tld>'
 790    --l => include list(s) if any
 791    --s => include subscriber only list(s) if any
 792    --remove-duplicates => minimize duplicate email names/addresses
 793    --roles => show roles (status:subsystem, git-signer, list, etc...)
 794    --rolestats => show roles and statistics (commits/total_commits, %)
 795    --file-emails => add email addresses found in -f file (default: 0 (off))
 796  --scm => print SCM tree(s) if any
 797  --status => print status if any
 798  --subsystem => print subsystem name if any
 799  --web => print website(s) if any
 800
 801Output type options:
 802  --separator [, ] => separator for multiple entries on 1 line
 803    using --separator also sets --nomultiline if --separator is not [, ]
 804  --multiline => print 1 entry per line
 805
 806Other options:
 807  --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 808  --keywords => scan patch for keywords (default: $keywords)
 809  --sections => print all of the subsystem sections with pattern matches
 810  --mailmap => use .mailmap file (default: $email_use_mailmap)
 811  --version => show version
 812  --help => show this help information
 813
 814Default options:
 815  [--email --nogit --git-fallback --m --n --l --multiline -pattern-depth=0
 816   --remove-duplicates --rolestats]
 817
 818Notes:
 819  Using "-f directory" may give unexpected results:
 820      Used with "--git", git signators for _all_ files in and below
 821          directory are examined as git recurses directories.
 822          Any specified X: (exclude) pattern matches are _not_ ignored.
 823      Used with "--nogit", directory is used as a pattern match,
 824          no individual file within the directory or subdirectory
 825          is matched.
 826      Used with "--git-blame", does not iterate all files in directory
 827  Using "--git-blame" is slow and may add old committers and authors
 828      that are no longer active maintainers to the output.
 829  Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
 830      other automated tools that expect only ["name"] <email address>
 831      may not work because of additional output after <email address>.
 832  Using "--rolestats" and "--git-blame" shows the #/total=% commits,
 833      not the percentage of the entire file authored.  # of commits is
 834      not a good measure of amount of code authored.  1 major commit may
 835      contain a thousand lines, 5 trivial commits may modify a single line.
 836  If git is not installed, but mercurial (hg) is installed and an .hg
 837      repository exists, the following options apply to mercurial:
 838          --git,
 839          --git-min-signatures, --git-max-maintainers, --git-min-percent, and
 840          --git-blame
 841      Use --hg-since not --git-since to control date selection
 842  File ".get_maintainer.conf", if it exists in the linux kernel source root
 843      directory, can change whatever get_maintainer defaults are desired.
 844      Entries in this file can be any command line argument.
 845      This file is prepended to any additional command line arguments.
 846      Multiple lines and # comments are allowed.
 847EOT
 848}
 849
 850sub top_of_kernel_tree {
 851    my ($lk_path) = @_;
 852
 853    if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 854        $lk_path .= "/";
 855    }
 856    if (   (-f "${lk_path}COPYING")
 857        && (-f "${lk_path}CREDITS")
 858        && (-f "${lk_path}Kbuild")
 859        && (-f "${lk_path}MAINTAINERS")
 860        && (-f "${lk_path}Makefile")
 861        && (-f "${lk_path}README")
 862        && (-d "${lk_path}Documentation")
 863        && (-d "${lk_path}arch")
 864        && (-d "${lk_path}include")
 865        && (-d "${lk_path}drivers")
 866        && (-d "${lk_path}fs")
 867        && (-d "${lk_path}init")
 868        && (-d "${lk_path}ipc")
 869        && (-d "${lk_path}kernel")
 870        && (-d "${lk_path}lib")
 871        && (-d "${lk_path}scripts")) {
 872        return 1;
 873    }
 874    return 0;
 875}
 876
 877sub parse_email {
 878    my ($formatted_email) = @_;
 879
 880    my $name = "";
 881    my $address = "";
 882
 883    if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
 884        $name = $1;
 885        $address = $2;
 886    } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
 887        $address = $1;
 888    } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
 889        $address = $1;
 890    }
 891
 892    $name =~ s/^\s+|\s+$//g;
 893    $name =~ s/^\"|\"$//g;
 894    $address =~ s/^\s+|\s+$//g;
 895
 896    if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 897        $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 898        $name = "\"$name\"";
 899    }
 900
 901    return ($name, $address);
 902}
 903
 904sub format_email {
 905    my ($name, $address, $usename) = @_;
 906
 907    my $formatted_email;
 908
 909    $name =~ s/^\s+|\s+$//g;
 910    $name =~ s/^\"|\"$//g;
 911    $address =~ s/^\s+|\s+$//g;
 912
 913    if ($name =~ /[^\w \-]/i) {          ##has "must quote" chars
 914        $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 915        $name = "\"$name\"";
 916    }
 917
 918    if ($usename) {
 919        if ("$name" eq "") {
 920            $formatted_email = "$address";
 921        } else {
 922            $formatted_email = "$name <$address>";
 923        }
 924    } else {
 925        $formatted_email = $address;
 926    }
 927
 928    return $formatted_email;
 929}
 930
 931sub find_first_section {
 932    my $index = 0;
 933
 934    while ($index < @typevalue) {
 935        my $tv = $typevalue[$index];
 936        if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
 937            last;
 938        }
 939        $index++;
 940    }
 941
 942    return $index;
 943}
 944
 945sub find_starting_index {
 946    my ($index) = @_;
 947
 948    while ($index > 0) {
 949        my $tv = $typevalue[$index];
 950        if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
 951            last;
 952        }
 953        $index--;
 954    }
 955
 956    return $index;
 957}
 958
 959sub find_ending_index {
 960    my ($index) = @_;
 961
 962    while ($index < @typevalue) {
 963        my $tv = $typevalue[$index];
 964        if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
 965            last;
 966        }
 967        $index++;
 968    }
 969
 970    return $index;
 971}
 972
 973sub get_maintainer_role {
 974    my ($index) = @_;
 975
 976    my $i;
 977    my $start = find_starting_index($index);
 978    my $end = find_ending_index($index);
 979
 980    my $role = "unknown";
 981    my $subsystem = $typevalue[$start];
 982    if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
 983        $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
 984        $subsystem =~ s/\s*$//;
 985        $subsystem = $subsystem . "...";
 986    }
 987
 988    for ($i = $start + 1; $i < $end; $i++) {
 989        my $tv = $typevalue[$i];
 990        if ($tv =~ m/^([A-Z]):\s*(.*)/) {
 991            my $ptype = $1;
 992            my $pvalue = $2;
 993            if ($ptype eq "S") {
 994                $role = $pvalue;
 995            }
 996        }
 997    }
 998
 999    $role = lc($role);
1000    if      ($role eq "supported") {

1001        $role = "supporter";
1002    } elsif ($role eq "maintained") {
1003        $role = "maintainer";
1004    } elsif ($role eq "odd fixes") {
1005        $role = "odd fixer";
1006    } elsif ($role eq "orphan") {
1007        $role = "orphan minder";
1008    } elsif ($role eq "obsolete") {
1009        $role = "obsolete minder";
1010    } elsif ($role eq "buried alive in reporters") {
1011        $role = "chief penguin";
1012    }
1013
1014    return $role . ":" . $subsystem;
1015}
1016
1017sub get_list_role {
1018    my ($index) = @_;
1019
1020    my $i;
1021    my $start = find_starting_index($index);
1022    my $end = find_ending_index($index);
1023
1024    my $subsystem = $typevalue[$start];
1025    if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1026        $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1027        $subsystem =~ s/\s*$//;
1028        $subsystem = $subsystem . "...";
1029    }
1030
1031    if ($subsystem eq "THE REST") {
1032        $subsystem = "";
1033    }
1034
1035    return $subsystem;
1036}
1037
1038sub add_categories {
1039    my ($index) = @_;
1040
1041    my $i;
1042    my $start = find_starting_index($index);
1043    my $end = find_ending_index($index);
1044
1045    push(@subsystem, $typevalue[$start]);
1046
1047    for ($i = $start + 1; $i < $end; $i++) {
1048        my $tv = $typevalue[$i];
1049        if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1050            my $ptype = $1;
1051            my $pvalue = $2;
1052            if ($ptype eq "L") {
1053                my $list_address = $pvalue;
1054                my $list_additional = "";
1055                my $list_role = get_list_role($i);
1056
1057                if ($list_role ne "") {
1058                    $list_role = ":" . $list_role;
1059                }
1060                if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1061                    $list_address = $1;
1062                    $list_additional = $2;
1063                }
1064                if ($list_additional =~ m/subscribers-only/) {
1065                    if ($email_subscriber_list) {
1066                        if (!$hash_list_to{lc($list_address)}) {
1067                            $hash_list_to{lc($list_address)} = 1;
1068                            push(@list_to, [$list_address,
1069                                            "subscriber list${list_role}"]);
1070                        }
1071                    }
1072                } else {
1073                    if ($email_list) {
1074                        if (!$hash_list_to{lc($list_address)}) {
1075                            $hash_list_to{lc($list_address)} = 1;
1076                            if ($list_additional =~ m/moderated/) {
1077                                push(@list_to, [$list_address,
1078                                                "moderated list${list_role}"]);
1079                            } else {
1080                                push(@list_to, [$list_address,
1081                                                "open list${list_role}"]);
1082                            }
1083                        }
1084                    }
1085                }
1086            } elsif ($ptype eq "M") {
1087                my ($name, $address) = parse_email($pvalue);
1088                if ($name eq "") {
1089                    if ($i > 0) {
1090                        my $tv = $typevalue[$i - 1];
1091                        if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1092                            if ($1 eq "P") {
1093                                $name = $2;
1094                                $pvalue = format_email($name, $address, $email_usename);
1095                            }
1096                        }
1097                    }
1098                }
1099                if ($email_maintainer) {
1100                    my $role = get_maintainer_role($i);
1101                    push_email_addresses($pvalue, $role);
1102                }
1103            } elsif ($ptype eq "R") {
1104                my ($name, $address) = parse_email($pvalue);
1105                if ($name eq "") {
1106                    if ($i > 0) {
1107                        my $tv = $typevalue[$i - 1];
1108                        if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1109                            if ($1 eq "P") {
1110                                $name = $2;
1111                                $pvalue = format_email($name, $address, $email_usename);
1112                            }
1113                        }
1114                    }
1115                }
1116                if ($email_reviewer) {
1117                    push_email_addresses($pvalue, 'reviewer');
1118                }
1119            } elsif ($ptype eq "T") {
1120                push(@scm, $pvalue);
1121            } elsif ($ptype eq "W") {
1122                push(@web, $pvalue);
1123            } elsif ($ptype eq "S") {
1124                push(@status, $pvalue);
1125            }
1126        }
1127    }
1128}
1129
1130sub email_inuse {
1131    my ($name, $address) = @_;
1132
1133    return 1 if (($name eq "") && ($address eq ""));
1134    return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1135    return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1136
1137    return 0;
1138}
1139
1140sub push_email_address {
1141    my ($line, $role) = @_;
1142
1143    my ($name, $address) = parse_email($line);
1144
1145    if ($address eq "") {
1146        return 0;
1147    }
1148
1149    if (!$email_remove_duplicates) {
1150        push(@email_to, [format_email($name, $address, $email_usename), $role]);
1151    } elsif (!email_inuse($name, $address)) {
1152        push(@email_to, [format_email($name, $address, $email_usename), $role]);
1153        $email_hash_name{lc($name)}++ if ($name ne "");
1154        $email_hash_address{lc($address)}++;
1155    }
1156
1157    return 1;
1158}
1159
1160sub push_email_addresses {
1161    my ($address, $role) = @_;
1162
1163    my @address_list = ();
1164
1165    if (rfc822_valid($address)) {
1166        push_email_address($address, $role);
1167    } elsif (@address_list = rfc822_validlist($address)) {
1168        my $array_count = shift(@address_list);
1169        while (my $entry = shift(@address_list)) {
1170            push_email_address($entry, $role);
1171        }
1172    } else {
1173        if (!push_email_address($address, $role)) {
1174            warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1175        }
1176    }
1177}
1178
1179sub add_role {
1180    my ($line, $role) = @_;
1181
1182    my ($name, $address) = parse_email($line);
1183    my $email = format_email($name, $address, $email_usename);
1184
1185    foreach my $entry (@email_to) {
1186        if ($email_remove_duplicates) {
1187            my ($entry_name, $entry_address) = parse_email($entry->[0]);
1188            if (($name eq $entry_name || $address eq $entry_address)
1189                && ($role eq "" || !($entry->[1] =~ m/$role/))
1190            ) {
1191                if ($entry->[1] eq "") {
1192                    $entry->[1] = "$role";
1193                } else {
1194                    $entry->[1] = "$entry->[1],$role";
1195                }
1196            }
1197        } else {
1198            if ($email eq $entry->[0]
1199                && ($role eq "" || !($entry->[1] =~ m/$role/))
1200            ) {
1201                if ($entry->[1] eq "") {
1202                    $entry->[1] = "$role";
1203                } else {
1204                    $entry->[1] = "$entry->[1],$role";
1205                }
1206            }
1207        }
1208    }
1209}
1210
1211sub which {
1212    my ($bin) = @_;
1213
1214    foreach my $path (split(/:/, $ENV{PATH})) {
1215        if (-e "$path/$bin") {
1216            return "$path/$bin";
1217        }
1218    }
1219
1220    return "";
1221}
1222
1223sub which_conf {
1224    my ($conf) = @_;
1225
1226    foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1227        if (-e "$path/$conf") {
1228            return "$path/$conf";
1229        }
1230    }
1231
1232    return "";
1233}
1234
1235sub mailmap_email {
1236    my ($line) = @_;
1237
1238    my ($name, $address) = parse_email($line);
1239    my $email = format_email($name, $address, 1);
1240    my $real_name = $name;
1241    my $real_address = $address;
1242
1243    if (exists $mailmap->{names}->{$email} ||
1244        exists $mailmap->{addresses}->{$email}) {
1245        if (exists $mailmap->{names}->{$email}) {
1246            $real_name = $mailmap->{names}->{$email};
1247        }
1248        if (exists $mailmap->{addresses}->{$email}) {
1249            $real_address = $mailmap->{addresses}->{$email};
1250        }
1251    } else {
1252        if (exists $mailmap->{names}->{$address}) {
1253            $real_name = $mailmap->{names}->{$address};
1254        }
1255        if (exists $mailmap->{addresses}->{$address}) {
1256            $real_address = $mailmap->{addresses}->{$address};
1257        }
1258    }
1259    return format_email($real_name, $real_address, 1);
1260}
1261
1262sub mailmap {
1263    my (@addresses) = @_;
1264
1265    my @mapped_emails = ();
1266    foreach my $line (@addresses) {
1267        push(@mapped_emails, mailmap_email($line));
1268    }
1269    merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1270    return @mapped_emails;
1271}
1272
1273sub merge_by_realname {
1274    my %address_map;
1275    my (@emails) = @_;
1276
1277    foreach my $email (@emails) {
1278        my ($name, $address) = parse_email($email);
1279        if (exists $address_map{$name}) {
1280            $address = $address_map{$name};
1281            $email = format_email($name, $address, 1);
1282        } else {
1283            $address_map{$name} = $address;
1284        }
1285    }
1286}
1287
1288sub git_execute_cmd {
1289    my ($cmd) = @_;
1290    my @lines = ();
1291
1292    my $output = `$cmd`;
1293    $output =~ s/^\s*//gm;
1294    @lines = split("\n", $output);
1295
1296    return @lines;
1297}
1298
1299sub hg_execute_cmd {
1300    my ($cmd) = @_;
1301    my @lines = ();
1302
1303    my $output = `$cmd`;
1304    @lines = split("\n", $output);
1305
1306    return @lines;
1307}
1308
1309sub extract_formatted_signatures {
1310    my (@signature_lines) = @_;
1311
1312    my @type = @signature_lines;
1313
1314    s/\s*(.*):.*/$1/ for (@type);
1315
1316    # cut -f2- -d":"
1317    s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1318
1319## Reformat email addresses (with names) to avoid badly written signatures
1320
1321    foreach my $signer (@signature_lines) {
1322        $signer = deduplicate_email($signer);
1323    }
1324
1325    return (\@type, \@signature_lines);
1326}
1327
1328sub vcs_find_signers {
1329    my ($cmd, $file) = @_;
1330    my $commits;
1331    my @lines = ();
1332    my @signatures = ();
1333    my @authors = ();
1334    my @stats = ();
1335
1336    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1337
1338    my $pattern = $VCS_cmds{"commit_pattern"};
1339    my $author_pattern = $VCS_cmds{"author_pattern"};
1340    my $stat_pattern = $VCS_cmds{"stat_pattern"};
1341
1342    $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1343
1344    $commits = grep(/$pattern/, @lines);        # of commits
1345
1346    @authors = grep(/$author_pattern/, @lines);
1347    @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1348    @stats = grep(/$stat_pattern/, @lines);
1349
1350#    print("stats: <@stats>\n");
1351
1352    return (0, \@signatures, \@authors, \@stats) if !@signatures;
1353
1354    save_commits_by_author(@lines) if ($interactive);
1355    save_commits_by_signer(@lines) if ($interactive);
1356
1357    if (!$email_git_penguin_chiefs) {
1358        @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1359    }
1360
1361    my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1362    my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1363
1364    return ($commits, $signers_ref, $authors_ref, \@stats);
1365}
1366
1367sub vcs_find_author {
1368    my ($cmd) = @_;
1369    my @lines = ();
1370
1371    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1372
1373    if (!$email_git_penguin_chiefs) {
1374        @lines = grep(!/${penguin_chiefs}/i, @lines);
1375    }
1376
1377    return @lines if !@lines;
1378
1379    my @authors = ();
1380    foreach my $line (@lines) {
1381        if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1382            my $author = $1;
1383            my ($name, $address) = parse_email($author);
1384            $author = format_email($name, $address, 1);
1385            push(@authors, $author);
1386        }
1387    }
1388
1389    save_commits_by_author(@lines) if ($interactive);
1390    save_commits_by_signer(@lines) if ($interactive);
1391
1392    return @authors;
1393}
1394
1395sub vcs_save_commits {
1396    my ($cmd) = @_;
1397    my @lines = ();
1398    my @commits = ();
1399
1400    @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1401
1402    foreach my $line (@lines) {
1403        if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1404            push(@commits, $1);
1405        }
1406    }
1407
1408    return @commits;
1409}
1410
1411sub vcs_blame {
1412    my ($file) = @_;
1413    my $cmd;
1414    my @commits = ();
1415
1416    return @commits if (!(-f $file));
1417
1418    if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1419        my @all_commits = ();
1420
1421        $cmd = $VCS_cmds{"blame_file_cmd"};
1422        $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1423        @all_commits = vcs_save_commits($cmd);
1424
1425        foreach my $file_range_diff (@range) {
1426            next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1427            my $diff_file = $1;
1428            my $diff_start = $2;
1429            my $diff_length = $3;
1430            next if ("$file" ne "$diff_file");
1431            for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1432                push(@commits, $all_commits[$i]);
1433            }
1434        }
1435    } elsif (@range) {
1436        foreach my $file_range_diff (@range) {
1437            next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1438            my $diff_file = $1;
1439            my $diff_start = $2;
1440            my $diff_length = $3;
1441            next if ("$file" ne "$diff_file");
1442            $cmd = $VCS_cmds{"blame_range_cmd"};
1443            $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1444            push(@commits, vcs_save_commits($cmd));
1445        }
1446    } else {
1447        $cmd = $VCS_cmds{"blame_file_cmd"};
1448        $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1449        @commits = vcs_save_commits($cmd);
1450    }
1451
1452    foreach my $commit (@commits) {
1453        $commit =~ s/^\^//g;
1454    }
1455
1456    return @commits;
1457}
1458
1459my $printed_novcs = 0;
1460sub vcs_exists {
1461    %VCS_cmds = %VCS_cmds_git;
1462    return 1 if eval $VCS_cmds{"available"};
1463    %VCS_cmds = %VCS_cmds_hg;
1464    return 2 if eval $VCS_cmds{"available"};
1465    %VCS_cmds = ();
1466    if (!$printed_novcs) {
1467        warn("$P: No supported VCS found.  Add --nogit to options?\n");
1468        warn("Using a git repository produces better results.\n");
1469        warn("Try Linus Torvalds' latest git repository using:\n");
1470        warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1471        $printed_novcs = 1;
1472    }
1473    return 0;
1474}
1475
1476sub vcs_is_git {
1477    vcs_exists();
1478    return $vcs_used == 1;
1479}
1480
1481sub vcs_is_hg {
1482    return $vcs_used == 2;
1483}
1484
1485sub interactive_get_maintainers {
1486    my ($list_ref) = @_;
1487    my @list = @$list_ref;
1488
1489    vcs_exists();
1490
1491    my %selected;
1492    my %authored;
1493    my %signed;
1494    my $count = 0;
1495    my $maintained = 0;
1496    foreach my $entry (@list) {
1497        $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1498        $selected{$count} = 1;
1499        $authored{$count} = 0;
1500        $signed{$count} = 0;
1501        $count++;
1502    }
1503
1504    #menu loop
1505    my $done = 0;
1506    my $print_options = 0;
1507    my $redraw = 1;
1508    while (!$done) {
1509        $count = 0;
1510        if ($redraw) {
1511            printf STDERR "\n%1s %2s %-65s",
1512                          "*", "#", "email/list and role:stats";
1513            if ($email_git ||
1514                ($email_git_fallback && !$maintained) ||
1515                $email_git_blame) {
1516                print STDERR "auth sign";
1517            }
1518            print STDERR "\n";
1519            foreach my $entry (@list) {
1520                my $email = $entry->[0];
1521                my $role = $entry->[1];
1522                my $sel = "";
1523                $sel = "*" if ($selected{$count});
1524                my $commit_author = $commit_author_hash{$email};
1525                my $commit_signer = $commit_signer_hash{$email};
1526                my $authored = 0;
1527                my $signed = 0;
1528                $authored++ for (@{$commit_author});
1529                $signed++ for (@{$commit_signer});
1530                printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1531                printf STDERR "%4d %4d", $authored, $signed
1532                    if ($authored > 0 || $signed > 0);
1533                printf STDERR "\n     %s\n", $role;
1534                if ($authored{$count}) {
1535                    my $commit_author = $commit_author_hash{$email};
1536                    foreach my $ref (@{$commit_author}) {
1537                        print STDERR "     Author: @{$ref}[1]\n";
1538                    }
1539                }
1540                if ($signed{$count}) {
1541                    my $commit_signer = $commit_signer_hash{$email};
1542                    foreach my $ref (@{$commit_signer}) {
1543                        print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1544                    }
1545                }
1546
1547                $count++;
1548            }
1549        }
1550        my $date_ref = \$email_git_since;
1551        $date_ref = \$email_hg_since if (vcs_is_hg());
1552        if ($print_options) {
1553            $print_options = 0;
1554            if (vcs_exists()) {
1555                print STDERR <<EOT
1556
1557Version Control options:
1558g  use git history      [$email_git]
1559gf use git-fallback     [$email_git_fallback]
1560b  use git blame        [$email_git_blame]
1561bs use blame signatures [$email_git_blame_signatures]
1562c# minimum commits      [$email_git_min_signatures]
1563%# min percent          [$email_git_min_percent]
1564d# history to use       [$$date_ref]
1565x# max maintainers      [$email_git_max_maintainers]
1566t  all signature types  [$email_git_all_signature_types]
1567m  use .mailmap         [$email_use_mailmap]
1568EOT
1569            }
1570            print STDERR <<EOT
1571
1572Additional options:
15730  toggle all
1574tm toggle maintainers
1575tg toggle git entries
1576tl toggle open list entries
1577ts toggle subscriber list entries
1578f  emails in file       [$file_emails]
1579k  keywords in file     [$keywords]
1580r  remove duplicates    [$email_remove_duplicates]
1581p# pattern match depth  [$pattern_depth]
1582EOT
1583        }
1584        print STDERR
1585"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1586
1587        my $input = <STDIN>;
1588        chomp($input);
1589
1590        $redraw = 1;
1591        my $rerun = 0;
1592        my @wish = split(/[, ]+/, $input);
1593        foreach my $nr (@wish) {
1594            $nr = lc($nr);
1595            my $sel = substr($nr, 0, 1);
1596            my $str = substr($nr, 1);
1597            my $val = 0;
1598            $val = $1 if $str =~ /^(\d+)$/;
1599
1600            if ($sel eq "y") {
1601                $interactive = 0;
1602                $done = 1;
1603                $output_rolestats = 0;
1604                $output_roles = 0;
1605                last;
1606            } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1607                $selected{$nr - 1} = !$selected{$nr - 1};
1608            } elsif ($sel eq "*" || $sel eq '^') {
1609                my $toggle = 0;
1610                $toggle = 1 if ($sel eq '*');
1611                for (my $i = 0; $i < $count; $i++) {
1612                    $selected{$i} = $toggle;
1613                }
1614            } elsif ($sel eq "0") {
1615                for (my $i = 0; $i < $count; $i++) {
1616                    $selected{$i} = !$selected{$i};
1617                }
1618            } elsif ($sel eq "t") {
1619                if (lc($str) eq "m") {
1620                    for (my $i = 0; $i < $count; $i++) {
1621                        $selected{$i} = !$selected{$i}
1622                            if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1623                    }
1624                } elsif (lc($str) eq "g") {
1625                    for (my $i = 0; $i < $count; $i++) {
1626                        $selected{$i} = !$selected{$i}
1627                            if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1628                    }
1629                } elsif (lc($str) eq "l") {
1630                    for (my $i = 0; $i < $count; $i++) {
1631                        $selected{$i} = !$selected{$i}
1632                            if ($list[$i]->[1] =~ /^(open list)/i);
1633                    }
1634                } elsif (lc($str) eq "s") {
1635                    for (my $i = 0; $i < $count; $i++) {
1636                        $selected{$i} = !$selected{$i}
1637                            if ($list[$i]->[1] =~ /^(subscriber list)/i);
1638                    }
1639                }
1640            } elsif ($sel eq "a") {
1641                if ($val > 0 && $val <= $count) {
1642                    $authored{$val - 1} = !$authored{$val - 1};
1643                } elsif ($str eq '*' || $str eq '^') {
1644                    my $toggle = 0;
1645                    $toggle = 1 if ($str eq '*');
1646                    for (my $i = 0; $i < $count; $i++) {
1647                        $authored{$i} = $toggle;
1648                    }
1649                }
1650            } elsif ($sel eq "s") {
1651                if ($val > 0 && $val <= $count) {
1652                    $signed{$val - 1} = !$signed{$val - 1};
1653                } elsif ($str eq '*' || $str eq '^') {
1654                    my $toggle = 0;
1655                    $toggle = 1 if ($str eq '*');
1656                    for (my $i = 0; $i < $count; $i++) {
1657                        $signed{$i} = $toggle;
1658                    }
1659                }
1660            } elsif ($sel eq "o") {
1661                $print_options = 1;
1662                $redraw = 1;
1663            } elsif ($sel eq "g") {
1664                if ($str eq "f") {
1665                    bool_invert(\$email_git_fallback);
1666                } else {
1667                    bool_invert(\$email_git);
1668                }
1669                $rerun = 1;
1670            } elsif ($sel eq "b") {
1671                if ($str eq "s") {
1672                    bool_invert(\$email_git_blame_signatures);
1673                } else {
1674                    bool_invert(\$email_git_blame);
1675                }
1676                $rerun = 1;
1677            } elsif ($sel eq "c") {
1678                if ($val > 0) {
1679                    $email_git_min_signatures = $val;
1680                    $rerun = 1;
1681                }
1682            } elsif ($sel eq "x") {
1683                if ($val > 0) {
1684                    $email_git_max_maintainers = $val;
1685                    $rerun = 1;
1686                }
1687            } elsif ($sel eq "%") {
1688                if ($str ne "" && $val >= 0) {
1689                    $email_git_min_percent = $val;
1690                    $rerun = 1;
1691                }
1692            } elsif ($sel eq "d") {
1693                if (vcs_is_git()) {
1694                    $email_git_since = $str;
1695                } elsif (vcs_is_hg()) {
1696                    $email_hg_since = $str;
1697                }
1698                $rerun = 1;
1699            } elsif ($sel eq "t") {
1700                bool_invert(\$email_git_all_signature_types);
1701                $rerun = 1;
1702            } elsif ($sel eq "f") {
1703                bool_invert(\$file_emails);
1704                $rerun = 1;
1705            } elsif ($sel eq "r") {
1706                bool_invert(\$email_remove_duplicates);
1707                $rerun = 1;
1708            } elsif ($sel eq "m") {
1709                bool_invert(\$email_use_mailmap);
1710                read_mailmap();
1711                $rerun = 1;
1712            } elsif ($sel eq "k") {
1713                bool_invert(\$keywords);
1714                $rerun = 1;
1715            } elsif ($sel eq "p") {
1716                if ($str ne "" && $val >= 0) {
1717                    $pattern_depth = $val;
1718                    $rerun = 1;
1719                }
1720            } elsif ($sel eq "h" || $sel eq "?") {
1721                print STDERR <<EOT
1722
1723Interactive mode allows you to select the various maintainers, submitters,
1724commit signers and mailing lists that could be CC'd on a patch.
1725
1726Any *'d entry is selected.
1727
1728If you have git or hg installed, you can choose to summarize the commit
1729history of files in the patch.  Also, each line of the current file can
1730be matched to its commit author and that commits signers with blame.
1731
1732Various knobs exist to control the length of time for active commit
1733tracking, the maximum number of commit authors and signers to add,
1734and such.
1735
1736Enter selections at the prompt until you are satisfied that the selected
1737maintainers are appropriate.  You may enter multiple selections separated
1738by either commas or spaces.
1739
1740EOT
1741            } else {
1742                print STDERR "invalid option: '$nr'\n";
1743                $redraw = 0;
1744            }
1745        }
1746        if ($rerun) {
1747            print STDERR "git-blame can be very slow, please have patience..."
1748                if ($email_git_blame);
1749            goto &get_maintainers;
1750        }
1751    }
1752
1753    #drop not selected entries
1754    $count = 0;
1755    my @new_emailto = ();
1756    foreach my $entry (@list) {
1757        if ($selected{$count}) {
1758            push(@new_emailto, $list[$count]);
1759        }
1760        $count++;
1761    }
1762    return @new_emailto;
1763}
1764
1765sub bool_invert {
1766    my ($bool_ref) = @_;
1767
1768    if ($$bool_ref) {
1769        $$bool_ref = 0;
1770    } else {
1771        $$bool_ref = 1;
1772    }
1773}
1774
1775sub deduplicate_email {
1776    my ($email) = @_;
1777
1778    my $matched = 0;
1779    my ($name, $address) = parse_email($email);
1780    $email = format_email($name, $address, 1);
1781    $email = mailmap_email($email);
1782
1783    return $email if (!$email_remove_duplicates);
1784
1785    ($name, $address) = parse_email($email);
1786
1787    if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
1788        $name = $deduplicate_name_hash{lc($name)}->[0];
1789        $address = $deduplicate_name_hash{lc($name)}->[1];
1790        $matched = 1;
1791    } elsif ($deduplicate_address_hash{lc($address)}) {
1792        $name = $deduplicate_address_hash{lc($address)}->[0];
1793        $address = $deduplicate_address_hash{lc($address)}->[1];
1794        $matched = 1;
1795    }
1796    if (!$matched) {
1797        $deduplicate_name_hash{lc($name)} = [ $name, $address ];
1798        $deduplicate_address_hash{lc($address)} = [ $name, $address ];
1799    }
1800    $email = format_email($name, $address, 1);
1801    $email = mailmap_email($email);
1802    return $email;
1803}
1804
1805sub save_commits_by_author {
1806    my (@lines) = @_;
1807
1808    my @authors = ();
1809    my @commits = ();
1810    my @subjects = ();
1811
1812    foreach my $line (@lines) {
1813        if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1814            my $author = $1;
1815            $author = deduplicate_email($author);
1816            push(@authors, $author);
1817        }
1818        push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1819        push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1820    }
1821
1822    for (my $i = 0; $i < @authors; $i++) {
1823        my $exists = 0;
1824        foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
1825            if (@{$ref}[0] eq $commits[$i] &&
1826                @{$ref}[1] eq $subjects[$i]) {
1827                $exists = 1;
1828                last;
1829            }
1830        }
1831        if (!$exists) {
1832            push(@{$commit_author_hash{$authors[$i]}},
1833                 [ ($commits[$i], $subjects[$i]) ]);
1834        }
1835    }
1836}
1837
1838sub save_commits_by_signer {
1839    my (@lines) = @_;
1840
1841    my $commit = "";
1842    my $subject = "";
1843
1844    foreach my $line (@lines) {
1845        $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
1846        $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
1847        if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
1848            my @signatures = ($line);
1849            my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1850            my @types = @$types_ref;
1851            my @signers = @$signers_ref;
1852
1853            my $type = $types[0];
1854            my $signer = $signers[0];
1855
1856            $signer = deduplicate_email($signer);
1857
1858            my $exists = 0;
1859            foreach my $ref(@{$commit_signer_hash{$signer}}) {
1860                if (@{$ref}[0] eq $commit &&
1861                    @{$ref}[1] eq $subject &&
1862                    @{$ref}[2] eq $type) {
1863                    $exists = 1;
1864                    last;
1865                }
1866            }
1867            if (!$exists) {
1868                push(@{$commit_signer_hash{$signer}},
1869                     [ ($commit, $subject, $type) ]);
1870            }
1871        }
1872    }
1873}
1874
1875sub vcs_assign {
1876    my ($role, $divisor, @lines) = @_;
1877
1878    my %hash;
1879    my $count = 0;
1880
1881    return if (@lines <= 0);
1882
1883    if ($divisor <= 0) {
1884        warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
1885        $divisor = 1;
1886    }
1887
1888    @lines = mailmap(@lines);
1889
1890    return if (@lines <= 0);
1891
1892    @lines = sort(@lines);
1893
1894    # uniq -c
1895    $hash{$_}++ for @lines;
1896
1897    # sort -rn
1898    foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
1899        my $sign_offs = $hash{$line};
1900        my $percent = $sign_offs * 100 / $divisor;
1901
1902        $percent = 100 if ($percent > 100);
1903        next if (ignore_email_address($line));
1904        $count++;
1905        last if ($sign_offs < $email_git_min_signatures ||
1906                 $count > $email_git_max_maintainers ||
1907                 $percent < $email_git_min_percent);
1908        push_email_address($line, '');
1909        if ($output_rolestats) {
1910            my $fmt_percent = sprintf("%.0f", $percent);
1911            add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
1912        } else {
1913            add_role($line, $role);
1914        }
1915    }
1916}
1917
1918sub vcs_file_signoffs {
1919    my ($file) = @_;
1920
1921    my $authors_ref;
1922    my $signers_ref;
1923    my $stats_ref;
1924    my @authors = ();
1925    my @signers = ();
1926    my @stats = ();
1927    my $commits;
1928
1929    $vcs_used = vcs_exists();
1930    return if (!$vcs_used);
1931
1932    my $cmd = $VCS_cmds{"find_signers_cmd"};
1933    $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
1934
1935    ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
1936
1937    @signers = @{$signers_ref} if defined $signers_ref;
1938    @authors = @{$authors_ref} if defined $authors_ref;
1939    @stats = @{$stats_ref} if defined $stats_ref;
1940
1941#    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
1942
1943    foreach my $signer (@signers) {
1944        $signer = deduplicate_email($signer);
1945    }
1946
1947    vcs_assign("commit_signer", $commits, @signers);
1948    vcs_assign("authored", $commits, @authors);
1949    if ($#authors == $#stats) {
1950        my $stat_pattern = $VCS_cmds{"stat_pattern"};
1951        $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
1952
1953        my $added = 0;
1954        my $deleted = 0;
1955        for (my $i = 0; $i <= $#stats; $i++) {
1956            if ($stats[$i] =~ /$stat_pattern/) {
1957                $added += $1;
1958                $deleted += $2;
1959            }
1960        }
1961        my @tmp_authors = uniq(@authors);
1962        foreach my $author (@tmp_authors) {
1963            $author = deduplicate_email($author);
1964        }
1965        @tmp_authors = uniq(@tmp_authors);
1966        my @list_added = ();
1967        my @list_deleted = ();
1968        foreach my $author (@tmp_authors) {
1969            my $auth_added = 0;
1970            my $auth_deleted = 0;
1971            for (my $i = 0; $i <= $#stats; $i++) {
1972                if ($author eq deduplicate_email($authors[$i]) &&
1973                    $stats[$i] =~ /$stat_pattern/) {
1974                    $auth_added += $1;
1975                    $auth_deleted += $2;
1976                }
1977            }
1978            for (my $i = 0; $i < $auth_added; $i++) {
1979                push(@list_added, $author);
1980            }
1981            for (my $i = 0; $i < $auth_deleted; $i++) {
1982                push(@list_deleted, $author);
1983            }
1984        }
1985        vcs_assign("added_lines", $added, @list_added);
1986        vcs_assign("removed_lines", $deleted, @list_deleted);
1987    }
1988}
1989
1990sub vcs_file_blame {
1991    my ($file) = @_;
1992
1993    my @signers = ();
1994    my @all_commits = ();
1995    my @commits = ();
1996    my $total_commits;
1997    my $total_lines;
1998
1999    $vcs_used = vcs_exists();
2000    return if (!$vcs_used);

2001
2002    @all_commits = vcs_blame($file);
2003    @commits = uniq(@all_commits);
2004    $total_commits = @commits;
2005    $total_lines = @all_commits;
2006
2007    if ($email_git_blame_signatures) {
2008        if (vcs_is_hg()) {
2009            my $commit_count;
2010            my $commit_authors_ref;
2011            my $commit_signers_ref;
2012            my $stats_ref;
2013            my @commit_authors = ();
2014            my @commit_signers = ();
2015            my $commit = join(" -r ", @commits);
2016            my $cmd;
2017
2018            $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2019            $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2020
2021            ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2022            @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2023            @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2024
2025            push(@signers, @commit_signers);
2026        } else {
2027            foreach my $commit (@commits) {
2028                my $commit_count;
2029                my $commit_authors_ref;
2030                my $commit_signers_ref;
2031                my $stats_ref;
2032                my @commit_authors = ();
2033                my @commit_signers = ();
2034                my $cmd;
2035
2036                $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2037                $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2038
2039                ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2040                @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2041                @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2042
2043                push(@signers, @commit_signers);
2044            }
2045        }
2046    }
2047
2048    if ($from_filename) {
2049        if ($output_rolestats) {
2050            my @blame_signers;
2051            if (vcs_is_hg()) {{         # Double brace for last exit
2052                my $commit_count;
2053                my @commit_signers = ();
2054                @commits = uniq(@commits);
2055                @commits = sort(@commits);
2056                my $commit = join(" -r ", @commits);
2057                my $cmd;
2058
2059                $cmd = $VCS_cmds{"find_commit_author_cmd"};
2060                $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2061
2062                my @lines = ();
2063
2064                @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2065
2066                if (!$email_git_penguin_chiefs) {
2067                    @lines = grep(!/${penguin_chiefs}/i, @lines);
2068                }
2069
2070                last if !@lines;
2071
2072                my @authors = ();
2073                foreach my $line (@lines) {
2074                    if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2075                        my $author = $1;
2076                        $author = deduplicate_email($author);
2077                        push(@authors, $author);
2078                    }
2079                }
2080
2081                save_commits_by_author(@lines) if ($interactive);
2082                save_commits_by_signer(@lines) if ($interactive);
2083
2084                push(@signers, @authors);
2085            }}
2086            else {
2087                foreach my $commit (@commits) {
2088                    my $i;
2089                    my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2090                    $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2091                    my @author = vcs_find_author($cmd);
2092                    next if !@author;
2093
2094                    my $formatted_author = deduplicate_email($author[0]);
2095
2096                    my $count = grep(/$commit/, @all_commits);
2097                    for ($i = 0; $i < $count ; $i++) {
2098                        push(@blame_signers, $formatted_author);
2099                    }
2100                }
2101            }
2102            if (@blame_signers) {
2103                vcs_assign("authored lines", $total_lines, @blame_signers);
2104            }
2105        }
2106        foreach my $signer (@signers) {
2107            $signer = deduplicate_email($signer);
2108        }
2109        vcs_assign("commits", $total_commits, @signers);
2110    } else {
2111        foreach my $signer (@signers) {
2112            $signer = deduplicate_email($signer);
2113        }
2114        vcs_assign("modified commits", $total_commits, @signers);
2115    }
2116}
2117
2118sub uniq {
2119    my (@parms) = @_;
2120
2121    my %saw;
2122    @parms = grep(!$saw{$_}++, @parms);
2123    return @parms;
2124}
2125
2126sub sort_and_uniq {
2127    my (@parms) = @_;
2128
2129    my %saw;
2130    @parms = sort @parms;
2131    @parms = grep(!$saw{$_}++, @parms);
2132    return @parms;
2133}
2134
2135sub clean_file_emails {
2136    my (@file_emails) = @_;
2137    my @fmt_emails = ();
2138
2139    foreach my $email (@file_emails) {
2140        $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2141        my ($name, $address) = parse_email($email);
2142        if ($name eq '"[,\.]"') {
2143            $name = "";
2144        }
2145
2146        my @nw = split(/[^A-Za-z�-�\'\,\.\+-]/, $name);
2147        if (@nw > 2) {
2148            my $first = $nw[@nw - 3];
2149            my $middle = $nw[@nw - 2];
2150            my $last = $nw[@nw - 1];
2151
2152            if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
2153                 (length($first) == 2 && substr($first, -1) eq ".")) ||
2154                (length($middle) == 1 ||
2155                 (length($middle) == 2 && substr($middle, -1) eq "."))) {
2156                $name = "$first $middle $last";
2157            } else {
2158                $name = "$middle $last";
2159            }
2160        }
2161
2162        if (substr($name, -1) =~ /[,\.]/) {
2163            $name = substr($name, 0, length($name) - 1);
2164        } elsif (substr($name, -2) =~ /[,\.]"/) {
2165            $name = substr($name, 0, length($name) - 2) . '"';
2166        }
2167
2168        if (substr($name, 0, 1) =~ /[,\.]/) {
2169            $name = substr($name, 1, length($name) - 1);
2170        } elsif (substr($name, 0, 2) =~ /"[,\.]/) {
2171            $name = '"' . substr($name, 2, length($name) - 2);
2172        }
2173
2174        my $fmt_email = format_email($name, $address, $email_usename);
2175        push(@fmt_emails, $fmt_email);
2176    }
2177    return @fmt_emails;
2178}
2179
2180sub merge_email {
2181    my @lines;
2182    my %saw;
2183
2184    for (@_) {
2185        my ($address, $role) = @$_;
2186        if (!$saw{$address}) {
2187            if ($output_roles) {
2188                push(@lines, "$address ($role)");
2189            } else {
2190                push(@lines, $address);
2191            }
2192            $saw{$address} = 1;
2193        }
2194    }
2195
2196    return @lines;
2197}
2198
2199sub output {
2200    my (@parms) = @_;
2201
2202    if ($output_multiline) {
2203        foreach my $line (@parms) {
2204            print("${line}\n");
2205        }
2206    } else {
2207        print(join($output_separator, @parms));
2208        print("\n");
2209    }
2210}
2211
2212my $rfc822re;
2213
2214sub make_rfc822re {
2215#   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2216#   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2217#   This regexp will only work on addresses which have had comments stripped
2218#   and replaced with rfc822_lwsp.
2219
2220    my $specials = '()<>@,;:\\\\".\\[\\]';
2221    my $controls = '\\000-\\037\\177';
2222
2223    my $dtext = "[^\\[\\]\\r\\\\]";
2224    my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2225
2226    my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2227
2228#   Use zero-width assertion to spot the limit of an atom.  A simple
2229#   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2230    my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2231    my $word = "(?:$atom|$quoted_string)";
2232    my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2233
2234    my $sub_domain = "(?:$atom|$domain_literal)";
2235    my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2236
2237    my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2238
2239    my $phrase = "$word*";
2240    my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2241    my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2242    my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2243
2244    my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2245    my $address = "(?:$mailbox|$group)";
2246
2247    return "$rfc822_lwsp*$address";
2248}
2249
2250sub rfc822_strip_comments {
2251    my $s = shift;
2252#   Recursively remove comments, and replace with a single space.  The simpler
2253#   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2254#   chars in atoms, for example.
2255
2256    while ($s =~ s/^((?:[^"\\]|\\.)*
2257                    (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2258                    \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2259    return $s;
2260}
2261
2262#   valid: returns true if the parameter is an RFC822 valid address
2263#
2264sub rfc822_valid {
2265    my $s = rfc822_strip_comments(shift);
2266
2267    if (!$rfc822re) {
2268        $rfc822re = make_rfc822re();
2269    }
2270
2271    return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2272}
2273
2274#   validlist: In scalar context, returns true if the parameter is an RFC822
2275#              valid list of addresses.
2276#
2277#              In list context, returns an empty list on failure (an invalid
2278#              address was found); otherwise a list whose first element is the
2279#              number of addresses found and whose remaining elements are the
2280#              addresses.  This is needed to disambiguate failure (invalid)
2281#              from success with no addresses found, because an empty string is
2282#              a valid list.
2283
2284sub rfc822_validlist {
2285    my $s = rfc822_strip_comments(shift);
2286
2287    if (!$rfc822re) {
2288        $rfc822re = make_rfc822re();
2289    }
2290    # * null list items are valid according to the RFC
2291    # * the '1' business is to aid in distinguishing failure from no results
2292
2293    my @r;
2294    if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2295        $s =~ m/^$rfc822_char*$/) {
2296        while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2297            push(@r, $1);
2298        }
2299        return wantarray ? (scalar(@r), @r) : 1;
2300    }
2301    return wantarray ? () : 0;
2302}
2303
Hosted by Missing Link Electronics. The original LXR software by the LXR community, this experimental version by lxr@linux.no.