LXR linux/scripts/get

   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.21';
  17
  18use Getopt::Long qw(:config no_auto_abbrev);
  19
  20my $lk_path = "./";
  21my $email = 1;
  22my $email_usename = 1;
  23my $email_maintainer = 1;
  24my $email_list = 1;
  25my $email_subscriber_list = 0;
  26my $email_git = 1;
  27my $email_git_penguin_chiefs = 0;
  28my $email_git_min_signatures = 1;
  29my $email_git_max_maintainers = 5;
  30my $email_git_min_percent = 5;
  31my $email_git_since = "1-year-ago";
  32my $email_git_blame = 0;
  33my $email_remove_duplicates = 1;
  34my $output_multiline = 1;
  35my $output_separator = ", ";
  36my $scm = 0;
  37my $web = 0;
  38my $subsystem = 0;
  39my $status = 0;
  40my $keywords = 1;
  41my $from_filename = 0;
  42my $pattern_depth = 0;
  43my $version = 0;
  44my $help = 0;
  45
  46my $exit = 0;
  47
  48my @penguin_chief = ();
  49push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
  50#Andrew wants in on most everything - 2009/01/14
  51#push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
  52
  53my @penguin_chief_names = ();
  54foreach my $chief (@penguin_chief) {
  55    if ($chief =~ m/^(.*):(.*)/) {
  56        my $chief_name = $1;
  57        my $chief_addr = $2;
  58        push(@penguin_chief_names, $chief_name);
  59    }
  60}
  61my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
  62
  63# rfc822 email address - preloaded methods go here.
  64my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  65my $rfc822_char = '[\\000-\\377]';
  66
  67if (!GetOptions(
  68                'email!' => \$email,
  69                'git!' => \$email_git,
  70                'git-chief-penguins!' => \$email_git_penguin_chiefs,
  71                'git-min-signatures=i' => \$email_git_min_signatures,
  72                'git-max-maintainers=i' => \$email_git_max_maintainers,
  73                'git-min-percent=i' => \$email_git_min_percent,
  74                'git-since=s' => \$email_git_since,
  75                'git-blame!' => \$email_git_blame,
  76                'remove-duplicates!' => \$email_remove_duplicates,
  77                'm!' => \$email_maintainer,
  78                'n!' => \$email_usename,
  79                'l!' => \$email_list,
  80                's!' => \$email_subscriber_list,
  81                'multiline!' => \$output_multiline,
  82                'separator=s' => \$output_separator,
  83                'subsystem!' => \$subsystem,
  84                'status!' => \$status,
  85                'scm!' => \$scm,
  86                'web!' => \$web,
  87                'pattern-depth=i' => \$pattern_depth,
  88                'k|keywords!' => \$keywords,
  89                'f|file' => \$from_filename,
  90                'v|version' => \$version,
  91                'h|help' => \$help,
  92                )) {
  93    usage();
  94    die "$P: invalid argument\n";
  95}
  96
  97if ($help != 0) {
  98    usage();
  99    exit 0;
 100}
 101
 102if ($version != 0) {
 103    print("${P} ${V}\n");
 104    exit 0;
 105}
 106
 107if ($#ARGV < 0) {
 108    usage();
 109    die "$P: argument missing: patchfile or -f file please\n";
 110}
 111
 112if ($output_separator ne ", ") {
 113    $output_multiline = 0;
 114}
 115
 116my $selections = $email + $scm + $status + $subsystem + $web;
 117if ($selections == 0) {
 118    usage();
 119    die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 120}
 121
 122if ($email &&
 123    ($email_maintainer + $email_list + $email_subscriber_list +
 124     $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 125    usage();
 126    die "$P: Please select at least 1 email option\n";
 127}
 128
 129if (!top_of_kernel_tree($lk_path)) {
 130    die "$P: The current directory does not appear to be "
 131        . "a linux kernel source tree.\n";
 132}
 133
 134## Read MAINTAINERS for type/value pairs
 135
 136my @typevalue = ();
 137my %keyword_hash;
 138
 139open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
 140while (<MAINT>) {
 141    my $line = $_;
 142
 143    if ($line =~ m/^(\C):\s*(.*)/) {
 144        my $type = $1;
 145        my $value = $2;
 146
 147        ##Filename pattern matching
 148        if ($type eq "F" || $type eq "X") {
 149            $value =~ s@\.@\\\.@g;       ##Convert . to \.
 150            $value =~ s/\*/\.\*/g;       ##Convert * to .*
 151            $value =~ s/\?/\./g;         ##Convert ? to .
 152            ##if pattern is a directory and it lacks a trailing slash, add one
 153            if ((-d $value)) {
 154                $value =~ s@([^/])$@$1/@;
 155            }
 156        } elsif ($type eq "K") {
 157            $keyword_hash{@typevalue} = $value;
 158        }
 159        push(@typevalue, "$type:$value");
 160    } elsif (!/^(\s)*$/) {
 161        $line =~ s/\n$//g;
 162        push(@typevalue, $line);
 163    }
 164}
 165close(MAINT);
 166
 167my %mailmap;
 168
 169if ($email_remove_duplicates) {
 170    open(MAILMAP, "<${lk_path}.mailmap") || warn "$P: Can't open .mailmap\n";
 171    while (<MAILMAP>) {
 172        my $line = $_;
 173
 174        next if ($line =~ m/^\s*#/);
 175        next if ($line =~ m/^\s*$/);
 176
 177        my ($name, $address) = parse_email($line);
 178        $line = format_email($name, $address);
 179
 180        next if ($line =~ m/^\s*$/);
 181
 182        if (exists($mailmap{$name})) {
 183            my $obj = $mailmap{$name};
 184            push(@$obj, $address);
 185        } else {
 186            my @arr = ($address);
 187            $mailmap{$name} = \@arr;
 188        }
 189    }
 190    close(MAILMAP);
 191}
 192
 193## use the filenames on the command line or find the filenames in the patchfiles
 194
 195my @files = ();
 196my @range = ();
 197my @keyword_tvi = ();
 198
 199foreach my $file (@ARGV) {
 200    ##if $file is a directory and it lacks a trailing slash, add one
 201    if ((-d $file)) {
 202        $file =~ s@([^/])$@$1/@;
 203    } elsif (!(-f $file)) {
 204        die "$P: file '${file}' not found\n";
 205    }
 206    if ($from_filename) {
 207        push(@files, $file);
 208        if (-f $file && $keywords) {
 209            open(FILE, "<$file") or die "$P: Can't open ${file}\n";
 210            while (<FILE>) {
 211                my $patch_line = $_;
 212                foreach my $line (keys %keyword_hash) {
 213                    if ($patch_line =~ m/^.*$keyword_hash{$line}/x) {
 214                        push(@keyword_tvi, $line);
 215                    }
 216                }
 217            }
 218            close(FILE);
 219        }
 220    } else {
 221        my $file_cnt = @files;
 222        my $lastfile;
 223        open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
 224        while (<PATCH>) {
 225            my $patch_line = $_;
 226            if (m/^\+\+\+\s+(\S+)/) {
 227                my $filename = $1;
 228                $filename =~ s@^[^/]*/@@;
 229                $filename =~ s@\n@@;
 230                $lastfile = $filename;
 231                push(@files, $filename);
 232            } elsif (m/^\@\@ -(\d+),(\d+)/) {
 233                if ($email_git_blame) {
 234                    push(@range, "$lastfile:$1:$2");
 235                }
 236            } elsif ($keywords) {
 237                foreach my $line (keys %keyword_hash) {
 238                    if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
 239                        push(@keyword_tvi, $line);
 240                    }
 241                }
 242            }
 243        }
 244        close(PATCH);
 245        if ($file_cnt == @files) {
 246            warn "$P: file '${file}' doesn't appear to be a patch.  "
 247                . "Add -f to options?\n";
 248        }
 249        @files = sort_and_uniq(@files);
 250    }
 251}
 252
 253my @email_to = ();
 254my @list_to = ();
 255my @scm = ();
 256my @web = ();
 257my @subsystem = ();
 258my @status = ();
 259
 260# Find responsible parties
 261
 262foreach my $file (@files) {
 263
 264#Do not match excluded file patterns
 265
 266    my $exclude = 0;
 267    foreach my $line (@typevalue) {
 268        if ($line =~ m/^(\C):\s*(.*)/) {
 269            my $type = $1;
 270            my $value = $2;
 271            if ($type eq 'X') {
 272                if (file_match_pattern($file, $value)) {
 273                    $exclude = 1;
 274                    last;
 275                }
 276            }
 277        }
 278    }
 279
 280    if (!$exclude) {
 281        my $tvi = 0;
 282        my %hash;
 283        foreach my $line (@typevalue) {
 284            if ($line =~ m/^(\C):\s*(.*)/) {
 285                my $type = $1;
 286                my $value = $2;
 287                if ($type eq 'F') {
 288                    if (file_match_pattern($file, $value)) {
 289                        my $value_pd = ($value =~ tr@/@@);
 290                        my $file_pd = ($file  =~ tr@/@@);
 291                        $value_pd++ if (substr($value,-1,1) ne "/");
 292                        if ($pattern_depth == 0 ||
 293                            (($file_pd - $value_pd) < $pattern_depth)) {
 294                            $hash{$tvi} = $value_pd;
 295                        }
 296                    }
 297                }
 298            }
 299            $tvi++;
 300        }
 301        foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 302            add_categories($line);
 303        }
 304    }
 305
 306    if ($email && $email_git) {
 307        recent_git_signoffs($file);
 308    }
 309
 310    if ($email && $email_git_blame) {
 311        git_assign_blame($file);
 312    }
 313}
 314
 315if ($keywords) {
 316    @keyword_tvi = sort_and_uniq(@keyword_tvi);
 317    foreach my $line (@keyword_tvi) {
 318        add_categories($line);
 319    }
 320}
 321
 322if ($email) {
 323    foreach my $chief (@penguin_chief) {
 324        if ($chief =~ m/^(.*):(.*)/) {
 325            my $email_address;
 326
 327            $email_address = format_email($1, $2);
 328            if ($email_git_penguin_chiefs) {
 329                push(@email_to, $email_address);
 330            } else {
 331                @email_to = grep(!/${email_address}/, @email_to);
 332            }
 333        }
 334    }
 335}
 336
 337if ($email || $email_list) {
 338    my @to = ();
 339    if ($email) {
 340        @to = (@to, @email_to);
 341    }
 342    if ($email_list) {
 343        @to = (@to, @list_to);
 344    }
 345    output(uniq(@to));
 346}
 347
 348if ($scm) {
 349    @scm = uniq(@scm);
 350    output(@scm);
 351}
 352
 353if ($status) {
 354    @status = uniq(@status);
 355    output(@status);
 356}
 357
 358if ($subsystem) {
 359    @subsystem = uniq(@subsystem);
 360    output(@subsystem);
 361}
 362
 363if ($web) {
 364    @web = uniq(@web);
 365    output(@web);
 366}
 367
 368exit($exit);
 369
 370sub file_match_pattern {
 371    my ($file, $pattern) = @_;
 372    if (substr($pattern, -1) eq "/") {
 373        if ($file =~ m@^$pattern@) {
 374            return 1;
 375        }
 376    } else {
 377        if ($file =~ m@^$pattern@) {
 378            my $s1 = ($file =~ tr@/@@);
 379            my $s2 = ($pattern =~ tr@/@@);
 380            if ($s1 == $s2) {
 381                return 1;
 382            }
 383        }
 384    }
 385    return 0;
 386}
 387
 388sub usage {
 389    print <<EOT;
 390usage: $P [options] patchfile
 391       $P [options] -f file|directory
 392version: $V
 393
 394MAINTAINER field selection options:
 395  --email => print email address(es) if any
 396    --git => include recent git \*-by: signers
 397    --git-chief-penguins => include ${penguin_chiefs}
 398    --git-min-signatures => number of signatures required (default: 1)
 399    --git-max-maintainers => maximum maintainers to add (default: 5)
 400    --git-min-percent => minimum percentage of commits required (default: 5)
 401    --git-since => git history to use (default: 1-year-ago)
 402    --git-blame => use git blame to find modified commits for patch or file
 403    --m => include maintainer(s) if any
 404    --n => include name 'Full Name <addr\@domain.tld>'
 405    --l => include list(s) if any
 406    --s => include subscriber only list(s) if any
 407    --remove-duplicates => minimize duplicate email names/addresses
 408  --scm => print SCM tree(s) if any
 409  --status => print status if any
 410  --subsystem => print subsystem name if any
 411  --web => print website(s) if any
 412
 413Output type options:
 414  --separator [, ] => separator for multiple entries on 1 line
 415    using --separator also sets --nomultiline if --separator is not [, ]
 416  --multiline => print 1 entry per line
 417
 418Other options:
 419  --pattern-depth => Number of pattern directory traversals (default: 0 (all))
 420  --keywords => scan patch for keywords (default: 1 (on))
 421  --version => show version
 422  --help => show this help information
 423
 424Default options:
 425  [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
 426
 427Notes:
 428  Using "-f directory" may give unexpected results:
 429      Used with "--git", git signators for _all_ files in and below
 430          directory are examined as git recurses directories.
 431          Any specified X: (exclude) pattern matches are _not_ ignored.
 432      Used with "--nogit", directory is used as a pattern match,
 433         no individual file within the directory or subdirectory
 434         is matched.
 435      Used with "--git-blame", does not iterate all files in directory
 436  Using "--git-blame" is slow and may add old committers and authors
 437      that are no longer active maintainers to the output.
 438EOT
 439}
 440
 441sub top_of_kernel_tree {
 442        my ($lk_path) = @_;
 443
 444        if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 445            $lk_path .= "/";
 446        }
 447        if (   (-f "${lk_path}COPYING")
 448            && (-f "${lk_path}CREDITS")
 449            && (-f "${lk_path}Kbuild")
 450            && (-f "${lk_path}MAINTAINERS")
 451            && (-f "${lk_path}Makefile")
 452            && (-f "${lk_path}README")
 453            && (-d "${lk_path}Documentation")
 454            && (-d "${lk_path}arch")
 455            && (-d "${lk_path}include")
 456            && (-d "${lk_path}drivers")
 457            && (-d "${lk_path}fs")
 458            && (-d "${lk_path}init")
 459            && (-d "${lk_path}ipc")
 460            && (-d "${lk_path}kernel")
 461            && (-d "${lk_path}lib")
 462            && (-d "${lk_path}scripts")) {
 463                return 1;
 464        }
 465        return 0;
 466}
 467
 468sub parse_email {
 469    my ($formatted_email) = @_;
 470
 471    my $name = "";
 472    my $address = "";
 473
 474    if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
 475        $name = $1;
 476        $address = $2;
 477    } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
 478        $address = $1;
 479    } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
 480        $address = $1;
 481    }
 482
 483    $name =~ s/^\s+|\s+$//g;
 484    $name =~ s/^\"|\"$//g;
 485    $address =~ s/^\s+|\s+$//g;
 486
 487    if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
 488        $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 489        $name = "\"$name\"";
 490    }
 491
 492    return ($name, $address);
 493}
 494
 495sub format_email {
 496    my ($name, $address) = @_;
 497
 498    my $formatted_email;
 499
 500    $name =~ s/^\s+|\s+$//g;
 501    $name =~ s/^\"|\"$//g;
 502    $address =~ s/^\s+|\s+$//g;
 503
 504    if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
 505        $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 506        $name = "\"$name\"";
 507    }
 508
 509    if ($email_usename) {
 510        if ("$name" eq "") {
 511            $formatted_email = "$address";
 512        } else {
 513            $formatted_email = "$name <${address}>";
 514        }
 515    } else {
 516        $formatted_email = $address;
 517    }
 518
 519    return $formatted_email;
 520}
 521
 522sub find_starting_index {
 523    my ($index) = @_;
 524
 525    while ($index > 0) {
 526        my $tv = $typevalue[$index];
 527        if (!($tv =~ m/^(\C):\s*(.*)/)) {
 528            last;
 529        }
 530        $index--;
 531    }
 532
 533    return $index;
 534}
 535
 536sub find_ending_index {
 537    my ($index) = @_;
 538
 539    while ($index < @typevalue) {
 540        my $tv = $typevalue[$index];
 541        if (!($tv =~ m/^(\C):\s*(.*)/)) {
 542            last;
 543        }
 544        $index++;
 545    }
 546
 547    return $index;
 548}
 549
 550sub add_categories {
 551    my ($index) = @_;
 552
 553    my $i;
 554    my $start = find_starting_index($index);
 555    my $end = find_ending_index($index);
 556
 557    push(@subsystem, $typevalue[$start]);
 558
 559    for ($i = $start + 1; $i < $end; $i++) {
 560        my $tv = $typevalue[$i];
 561        if ($tv =~ m/^(\C):\s*(.*)/) {
 562            my $ptype = $1;
 563            my $pvalue = $2;
 564            if ($ptype eq "L") {
 565                my $list_address = $pvalue;
 566                my $list_additional = "";
 567                if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
 568                    $list_address = $1;
 569                    $list_additional = $2;
 570                }
 571                if ($list_additional =~ m/subscribers-only/) {
 572                    if ($email_subscriber_list) {
 573                        push(@list_to, $list_address);
 574                    }
 575                } else {
 576                    if ($email_list) {
 577                        push(@list_to, $list_address);
 578                    }
 579                }
 580            } elsif ($ptype eq "M") {
 581                my ($name, $address) = parse_email($pvalue);
 582                if ($name eq "") {
 583                    if ($i > 0) {
 584                        my $tv = $typevalue[$i - 1];
 585                        if ($tv =~ m/^(\C):\s*(.*)/) {
 586                            if ($1 eq "P") {
 587                                $name = $2;
 588                                $pvalue = format_email($name, $address);
 589                            }
 590                        }
 591                    }
 592                }
 593                if ($email_maintainer) {
 594                    push_email_addresses($pvalue);
 595                }
 596            } elsif ($ptype eq "T") {
 597                push(@scm, $pvalue);
 598            } elsif ($ptype eq "W") {
 599                push(@web, $pvalue);
 600            } elsif ($ptype eq "S") {
 601                push(@status, $pvalue);
 602            }
 603        }
 604    }
 605}
 606
 607my %email_hash_name;
 608my %email_hash_address;
 609
 610sub email_inuse {
 611    my ($name, $address) = @_;
 612
 613    return 1 if (($name eq "") && ($address eq ""));
 614    return 1 if (($name ne "") && exists($email_hash_name{$name}));
 615    return 1 if (($address ne "") && exists($email_hash_address{$address}));
 616
 617    return 0;
 618}
 619
 620sub push_email_address {
 621    my ($line) = @_;
 622
 623    my ($name, $address) = parse_email($line);
 624
 625    if ($address eq "") {
 626        return 0;
 627    }
 628
 629    if (!$email_remove_duplicates) {
 630        push(@email_to, format_email($name, $address));
 631    } elsif (!email_inuse($name, $address)) {
 632        push(@email_to, format_email($name, $address));
 633        $email_hash_name{$name}++;
 634        $email_hash_address{$address}++;
 635    }
 636
 637    return 1;
 638}
 639
 640sub push_email_addresses {
 641    my ($address) = @_;
 642
 643    my @address_list = ();
 644
 645    if (rfc822_valid($address)) {
 646        push_email_address($address);
 647    } elsif (@address_list = rfc822_validlist($address)) {
 648        my $array_count = shift(@address_list);
 649        while (my $entry = shift(@address_list)) {
 650            push_email_address($entry);
 651        }
 652    } else {
 653        if (!push_email_address($address)) {
 654            warn("Invalid MAINTAINERS address: '" . $address . "'\n");
 655        }
 656    }
 657}
 658
 659sub which {
 660    my ($bin) = @_;
 661
 662    foreach my $path (split(/:/, $ENV{PATH})) {
 663        if (-e "$path/$bin") {
 664            return "$path/$bin";
 665        }
 666    }
 667
 668    return "";
 669}
 670
 671sub mailmap {
 672    my @lines = @_;
 673    my %hash;
 674
 675    foreach my $line (@lines) {
 676        my ($name, $address) = parse_email($line);
 677        if (!exists($hash{$name})) {
 678            $hash{$name} = $address;
 679        } elsif ($address ne $hash{$name}) {
 680            $address = $hash{$name};
 681            $line = format_email($name, $address);
 682        }
 683        if (exists($mailmap{$name})) {
 684            my $obj = $mailmap{$name};
 685            foreach my $map_address (@$obj) {
 686                if (($map_address eq $address) &&
 687                    ($map_address ne $hash{$name})) {
 688                    $line = format_email($name, $hash{$name});
 689                }
 690            }
 691        }
 692    }
 693
 694    return @lines;
 695}
 696
 697sub recent_git_signoffs {
 698    my ($file) = @_;
 699
 700    my $sign_offs = "";
 701    my $cmd = "";
 702    my $output = "";
 703    my $count = 0;
 704    my @lines = ();
 705    my %hash;
 706    my $total_sign_offs;
 707
 708    if (which("git") eq "") {
 709        warn("$P: git not found.  Add --nogit to options?\n");
 710        return;
 711    }
 712    if (!(-d ".git")) {
 713        warn("$P: .git directory not found.  Use a git repository for better results.\n");
 714        warn("$P: perhaps 'git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git'\n");
 715        return;
 716    }
 717
 718    $cmd = "git log --since=${email_git_since} -- ${file}";
 719
 720    $output = `${cmd}`;
 721    $output =~ s/^\s*//gm;
 722
 723    @lines = split("\n", $output);
 724
 725    @lines = grep(/^[-_         a-z]+by:.*\@.*$/i, @lines);
 726    if (!$email_git_penguin_chiefs) {
 727        @lines = grep(!/${penguin_chiefs}/i, @lines);
 728    }
 729    # cut -f2- -d":"
 730    s/.*:\s*(.+)\s*/$1/ for (@lines);
 731
 732    $total_sign_offs = @lines;
 733
 734    if ($email_remove_duplicates) {
 735        @lines = mailmap(@lines);
 736    }
 737
 738    @lines = sort(@lines);
 739
 740    # uniq -c
 741    $hash{$_}++ for @lines;
 742
 743    # sort -rn
 744    foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 745        my $sign_offs = $hash{$line};
 746        $count++;
 747        last if ($sign_offs < $email_git_min_signatures ||
 748                 $count > $email_git_max_maintainers ||
 749                 $sign_offs * 100 / $total_sign_offs < $email_git_min_percent);
 750        push_email_address($line);
 751    }
 752}
 753
 754sub save_commits {
 755    my ($cmd, @commits) = @_;
 756    my $output;
 757    my @lines = ();
 758
 759    $output = `${cmd}`;
 760
 761    @lines = split("\n", $output);
 762    foreach my $line (@lines) {
 763        if ($line =~ m/^(\w+) /) {
 764            push (@commits, $1);
 765        }
 766    }
 767    return @commits;
 768}
 769
 770sub git_assign_blame {
 771    my ($file) = @_;
 772
 773    my @lines = ();
 774    my @commits = ();
 775    my $cmd;
 776    my $output;
 777    my %hash;
 778    my $total_sign_offs;
 779    my $count;
 780
 781    if (@range) {
 782        foreach my $file_range_diff (@range) {
 783            next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
 784            my $diff_file = $1;
 785            my $diff_start = $2;
 786            my $diff_length = $3;
 787            next if (!("$file" eq "$diff_file"));
 788            $cmd = "git blame -l -L $diff_start,+$diff_length $file";
 789            @commits = save_commits($cmd, @commits);
 790        }
 791    } else {
 792        if (-f $file) {
 793            $cmd = "git blame -l $file";
 794            @commits = save_commits($cmd, @commits);
 795        }
 796    }
 797
 798    $total_sign_offs = 0;
 799    @commits = uniq(@commits);
 800    foreach my $commit (@commits) {
 801        $cmd = "git log -1 ${commit}";
 802
 803        $output = `${cmd}`;
 804        $output =~ s/^\s*//gm;
 805        @lines = split("\n", $output);
 806
 807        @lines = grep(/^[-_     a-z]+by:.*\@.*$/i, @lines);
 808        if (!$email_git_penguin_chiefs) {
 809            @lines = grep(!/${penguin_chiefs}/i, @lines);
 810        }
 811
 812        # cut -f2- -d":"
 813        s/.*:\s*(.+)\s*/$1/ for (@lines);
 814
 815        $total_sign_offs += @lines;
 816
 817        if ($email_remove_duplicates) {
 818            @lines = mailmap(@lines);
 819        }
 820
 821        $hash{$_}++ for @lines;
 822    }
 823
 824    $count = 0;
 825    foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 826        my $sign_offs = $hash{$line};
 827        $count++;
 828        last if ($sign_offs < $email_git_min_signatures ||
 829                 $count > $email_git_max_maintainers ||
 830                 $sign_offs * 100 / $total_sign_offs < $email_git_min_percent);
 831        push_email_address($line);
 832    }
 833}
 834
 835sub uniq {
 836    my @parms = @_;
 837
 838    my %saw;
 839    @parms = grep(!$saw{$_}++, @parms);
 840    return @parms;
 841}
 842
 843sub sort_and_uniq {
 844    my @parms = @_;
 845
 846    my %saw;
 847    @parms = sort @parms;
 848    @parms = grep(!$saw{$_}++, @parms);
 849    return @parms;
 850}
 851
 852sub output {
 853    my @parms = @_;
 854
 855    if ($output_multiline) {
 856        foreach my $line (@parms) {
 857            print("${line}\n");
 858        }
 859    } else {
 860        print(join($output_separator, @parms));
 861        print("\n");
 862    }
 863}
 864
 865my $rfc822re;
 866
 867sub make_rfc822re {
 868#   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
 869#   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
 870#   This regexp will only work on addresses which have had comments stripped
 871#   and replaced with rfc822_lwsp.
 872
 873    my $specials = '()<>@,;:\\\\".\\[\\]';
 874    my $controls = '\\000-\\037\\177';
 875
 876    my $dtext = "[^\\[\\]\\r\\\\]";
 877    my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
 878
 879    my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
 880
 881#   Use zero-width assertion to spot the limit of an atom.  A simple
 882#   $rfc822_lwsp* causes the regexp engine to hang occasionally.
 883    my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
 884    my $word = "(?:$atom|$quoted_string)";
 885    my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
 886
 887    my $sub_domain = "(?:$atom|$domain_literal)";
 888    my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
 889
 890    my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
 891
 892    my $phrase = "$word*";
 893    my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
 894    my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
 895    my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
 896
 897    my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
 898    my $address = "(?:$mailbox|$group)";
 899
 900    return "$rfc822_lwsp*$address";
 901}
 902
 903sub rfc822_strip_comments {
 904    my $s = shift;
 905#   Recursively remove comments, and replace with a single space.  The simpler
 906#   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
 907#   chars in atoms, for example.
 908
 909    while ($s =~ s/^((?:[^"\\]|\\.)*
 910                    (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
 911                    \((?:[^()\\]|\\.)*\)/$1 /osx) {}
 912    return $s;
 913}
 914
 915#   valid: returns true if the parameter is an RFC822 valid address
 916#
 917sub rfc822_valid ($) {
 918    my $s = rfc822_strip_comments(shift);
 919
 920    if (!$rfc822re) {
 921        $rfc822re = make_rfc822re();
 922    }
 923
 924    return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
 925}
 926
 927#   validlist: In scalar context, returns true if the parameter is an RFC822
 928#              valid list of addresses.
 929#
 930#              In list context, returns an empty list on failure (an invalid
 931#              address was found); otherwise a list whose first element is the
 932#              number of addresses found and whose remaining elements are the
 933#              addresses.  This is needed to disambiguate failure (invalid)
 934#              from success with no addresses found, because an empty string is
 935#              a valid list.
 936
 937sub rfc822_validlist ($) {
 938    my $s = rfc822_strip_comments(shift);
 939
 940    if (!$rfc822re) {
 941        $rfc822re = make_rfc822re();
 942    }
 943    # * null list items are valid according to the RFC
 944    # * the '1' business is to aid in distinguishing failure from no results
 945
 946    my @r;
 947    if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
 948        $s =~ m/^$rfc822_char*$/) {
 949        while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
 950            push @r, $1;
 951        }
 952        return wantarray ? (scalar(@r), @r) : 1;
 953    }
 954    else {
 955        return wantarray ? () : 0;
 956    }
 957}
 958