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

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

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