diff options
Diffstat (limited to 'scripts/get_maintainer.pl')
| -rwxr-xr-x | scripts/get_maintainer.pl | 575 |
1 files changed, 446 insertions, 129 deletions
diff --git a/scripts/get_maintainer.pl b/scripts/get_maintainer.pl index 3bd5f4f30235..4414194bedcf 100755 --- a/scripts/get_maintainer.pl +++ b/scripts/get_maintainer.pl @@ -1,4 +1,6 @@ #!/usr/bin/env perl +# SPDX-License-Identifier: GPL-2.0 +# # (c) 2007, Joe Perches <joe@perches.com> # created from checkpatch.pl # @@ -7,8 +9,6 @@ # # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> # perl scripts/get_maintainer.pl [OPTIONS] -f <file> -# -# Licensed under the terms of the GNU GPL License version 2 use warnings; use strict; @@ -18,6 +18,9 @@ my $V = '0.26'; use Getopt::Long qw(:config no_auto_abbrev); use Cwd; +use File::Find; +use File::Spec::Functions; +use open qw(:std :encoding(UTF-8)); my $cur_path = fastgetcwd() . '/'; my $lk_path = "./"; @@ -25,7 +28,9 @@ my $email = 1; my $email_usename = 1; my $email_maintainer = 1; my $email_reviewer = 1; +my $email_fixes = 1; my $email_list = 1; +my $email_moderated_list = 1; my $email_subscriber_list = 0; my $email_git_penguin_chiefs = 0; my $email_git = 0; @@ -45,24 +50,36 @@ my $output_multiline = 1; my $output_separator = ", "; my $output_roles = 0; my $output_rolestats = 1; +my $output_substatus = undef; my $output_section_maxlen = 50; my $scm = 0; +my $tree = 1; my $web = 0; +my $bug = 0; my $subsystem = 0; my $status = 0; my $letters = ""; my $keywords = 1; +my $keywords_in_file = 0; my $sections = 0; -my $file_emails = 0; +my $email_file_emails = 0; my $from_filename = 0; my $pattern_depth = 0; +my $self_test = undef; my $version = 0; my $help = 0; - +my $find_maintainer_files = 0; +my $maintainer_path; my $vcs_used = 0; my $exit = 0; +my @files = (); +my @fixes = (); # If a patch description includes Fixes: lines +my @range = (); +my @keyword_tvi = (); +my @file_emails = (); + my %commit_author_hash; my %commit_signer_hash; @@ -136,6 +153,7 @@ my %VCS_cmds_git = ( "subject_pattern" => "^GitSubject: (.*)", "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$", "file_exists_cmd" => "git ls-files \$file", + "list_files_cmd" => "git ls-files \$file", ); my %VCS_cmds_hg = ( @@ -165,6 +183,7 @@ my %VCS_cmds_hg = ( "subject_pattern" => "^HgSubject: (.*)", "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$", "file_exists_cmd" => "hg files \$file", + "list_files_cmd" => "hg manifest -R \$file", ); my $conf = which_conf(".get_maintainer.conf"); @@ -214,6 +233,14 @@ if (-f $ignore_file) { close($ignore); } +if ($#ARGV > 0) { + foreach (@ARGV) { + if ($_ =~ /^-{1,2}self-test(?:=|$)/) { + die "$P: using --self-test does not allow any other option or argument\n"; + } + } +} + if (!GetOptions( 'email!' => \$email, 'git!' => \$email_git, @@ -234,6 +261,8 @@ if (!GetOptions( 'r!' => \$email_reviewer, 'n!' => \$email_usename, 'l!' => \$email_list, + 'fixes!' => \$email_fixes, + 'moderated!' => \$email_moderated_list, 's!' => \$email_subscriber_list, 'multiline!' => \$output_multiline, 'roles!' => \$output_roles, @@ -241,14 +270,21 @@ if (!GetOptions( 'separator=s' => \$output_separator, 'subsystem!' => \$subsystem, 'status!' => \$status, + 'substatus!' => \$output_substatus, 'scm!' => \$scm, + 'tree!' => \$tree, 'web!' => \$web, + 'bug!' => \$bug, 'letters=s' => \$letters, 'pattern-depth=i' => \$pattern_depth, 'k|keywords!' => \$keywords, + 'kf|keywords-in-file!' => \$keywords_in_file, 'sections!' => \$sections, - 'fe|file-emails!' => \$file_emails, + 'fe|file-emails!' => \$email_file_emails, 'f|file' => \$from_filename, + 'find-maintainer-files' => \$find_maintainer_files, + 'mpath|maintainer-path=s' => \$maintainer_path, + 'self-test:s' => \$self_test, 'v|version' => \$version, 'h|help|usage' => \$help, )) { @@ -265,6 +301,12 @@ if ($version != 0) { exit 0; } +if (defined $self_test) { + read_all_maintainer_files(); + self_test(); + exit 0; +} + if (-t STDIN && !@ARGV) { # We're talking to a terminal, but have no command line arguments. die "$P: missing patchfile or -f file - use --help if necessary\n"; @@ -274,6 +316,10 @@ $output_multiline = 0 if ($output_separator ne ", "); $output_rolestats = 1 if ($interactive); $output_roles = 1 if ($output_rolestats); +if (!defined $output_substatus) { + $output_substatus = $email && $output_roles && -t STDOUT; +} + if ($sections || $letters ne "") { $sections = 1; $email = 0; @@ -282,12 +328,14 @@ if ($sections || $letters ne "") { $status = 0; $subsystem = 0; $web = 0; + $bug = 0; $keywords = 0; + $keywords_in_file = 0; $interactive = 0; } else { - my $selections = $email + $scm + $status + $subsystem + $web; + my $selections = $email + $scm + $status + $subsystem + $web + $bug; if ($selections == 0) { - die "$P: Missing required option: email, scm, status, subsystem or web\n"; + die "$P: Missing required option: email, scm, status, subsystem, web or bug\n"; } } @@ -298,7 +346,7 @@ if ($email && die "$P: Please select at least 1 email option\n"; } -if (!top_of_kernel_tree($lk_path)) { +if ($tree && !top_of_kernel_tree($lk_path)) { die "$P: The current directory does not appear to be " . "a linux kernel source tree.\n"; } @@ -307,36 +355,110 @@ if (!top_of_kernel_tree($lk_path)) { my @typevalue = (); my %keyword_hash; +my @mfiles = (); +my @self_test_info = (); -open (my $maint, '<', "${lk_path}MAINTAINERS") - or die "$P: Can't open MAINTAINERS: $!\n"; -while (<$maint>) { - my $line = $_; +sub read_maintainer_file { + my ($file) = @_; - if ($line =~ m/^([A-Z]):\s*(.*)/) { - my $type = $1; - my $value = $2; + open (my $maint, '<', "$file") + or die "$P: Can't open MAINTAINERS file '$file': $!\n"; + my $i = 1; + while (<$maint>) { + my $line = $_; + chomp $line; - ##Filename pattern matching - if ($type eq "F" || $type eq "X") { - $value =~ s@\.@\\\.@g; ##Convert . to \. - $value =~ s/\*/\.\*/g; ##Convert * to .* - $value =~ s/\?/\./g; ##Convert ? to . - ##if pattern is a directory and it lacks a trailing slash, add one - if ((-d $value)) { - $value =~ s@([^/])$@$1/@; + if ($line =~ m/^([A-Z]):\s*(.*)/) { + my $type = $1; + my $value = $2; + + ##Filename pattern matching + if ($type eq "F" || $type eq "X") { + $value =~ s@\.@\\\.@g; ##Convert . to \. + $value =~ s/\*/\.\*/g; ##Convert * to .* + $value =~ s/\?/\./g; ##Convert ? to . + ##if pattern is a directory and it lacks a trailing slash, add one + if ((-d $value)) { + $value =~ s@([^/])$@$1/@; + } + } elsif ($type eq "K") { + $keyword_hash{@typevalue} = $value; + } + push(@typevalue, "$type:$value"); + } elsif (!(/^\s*$/ || /^\s*\#/)) { + push(@typevalue, $line); + } + if (defined $self_test) { + push(@self_test_info, {file=>$file, linenr=>$i, line=>$line}); + } + $i++; + } + close($maint); +} + +sub find_is_maintainer_file { + my ($file) = $_; + return if ($file !~ m@/MAINTAINERS$@); + $file = $File::Find::name; + return if (! -f $file); + push(@mfiles, $file); +} + +sub find_ignore_git { + return grep { $_ !~ /^\.git$/; } @_; +} + +read_all_maintainer_files(); + +sub read_all_maintainer_files { + my $path = "${lk_path}MAINTAINERS"; + if (defined $maintainer_path) { + $path = $maintainer_path; + # Perl Cookbook tilde expansion if necessary + $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex; + } + + if (-d $path) { + $path .= '/' if ($path !~ m@/$@); + if ($find_maintainer_files) { + find( { wanted => \&find_is_maintainer_file, + preprocess => \&find_ignore_git, + no_chdir => 1, + }, "$path"); + } else { + opendir(DIR, "$path") or die $!; + my @files = readdir(DIR); + closedir(DIR); + foreach my $file (@files) { + push(@mfiles, "$path$file") if ($file !~ /^\./); } - } elsif ($type eq "K") { - $keyword_hash{@typevalue} = $value; } - push(@typevalue, "$type:$value"); - } elsif (!/^(\s)*$/) { - $line =~ s/\n$//g; - push(@typevalue, $line); + } elsif (-f "$path") { + push(@mfiles, "$path"); + } else { + die "$P: MAINTAINER file not found '$path'\n"; + } + die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0); + foreach my $file (@mfiles) { + read_maintainer_file("$file"); } } -close($maint); +sub maintainers_in_file { + my ($file) = @_; + + return if ($file =~ m@\bMAINTAINERS$@); + + if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) { + open(my $f, '<', $file) + or die "$P: Can't open $file: $!\n"; + my $text = do { local($/) ; <$f> }; + close($f); + + my @poss_addr = $text =~ m$[\p{L}\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g; + push(@file_emails, clean_file_emails(@poss_addr)); + } +} # # Read mail address map @@ -418,17 +540,13 @@ sub read_mailmap { ## use the filenames on the command line or find the filenames in the patchfiles -my @files = (); -my @range = (); -my @keyword_tvi = (); -my @file_emails = (); - if (!@ARGV) { push(@ARGV, "&STDIN"); } foreach my $file (@ARGV) { if ($file ne "&STDIN") { + $file = canonpath($file); ##if $file is a directory and it lacks a trailing slash, add one if ((-d $file)) { $file =~ s@([^/])$@$1/@; @@ -436,26 +554,23 @@ foreach my $file (@ARGV) { die "$P: file '${file}' not found\n"; } } + if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) { + warn "$P: file '$file' not found in version control $!\n"; + } if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) { $file =~ s/^\Q${cur_path}\E//; #strip any absolute path $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree push(@files, $file); - if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) { + if ($file ne "MAINTAINERS" && -f $file && $keywords && $keywords_in_file) { open(my $f, '<', $file) or die "$P: Can't open $file: $!\n"; my $text = do { local($/) ; <$f> }; close($f); - if ($keywords) { - foreach my $line (keys %keyword_hash) { - if ($text =~ m/$keyword_hash{$line}/x) { - push(@keyword_tvi, $line); - } + foreach my $line (keys %keyword_hash) { + if ($text =~ m/$keyword_hash{$line}/x) { + push(@keyword_tvi, $line); } } - if ($file_emails) { - 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; - push(@file_emails, clean_file_emails(@poss_addr)); - } } } else { my $file_cnt = @files; @@ -473,7 +588,20 @@ foreach my $file (@ARGV) { while (<$patch>) { my $patch_line = $_; - if (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) { + if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) { + my $filename = $1; + push(@files, $filename); + } elsif (m/^rename (?:from|to) (\S+)\s*$/) { + my $filename = $1; + push(@files, $filename); + } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) { + my $filename1 = $1; + my $filename2 = $2; + push(@files, $filename1); + push(@files, $filename2); + } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) { + push(@fixes, $1) if ($email_fixes); + } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) { my $filename = $1; $filename =~ s@^[^/]*/@@; $filename =~ s@\n@@; @@ -503,6 +631,7 @@ foreach my $file (@ARGV) { } @file_emails = uniq(@file_emails); +@fixes = uniq(@fixes); my %email_hash_name; my %email_hash_address; @@ -511,13 +640,14 @@ my %hash_list_to; my @list_to = (); my @scm = (); my @web = (); +my @bug = (); my @subsystem = (); my @status = (); +my @substatus = (); my %deduplicate_name_hash = (); my %deduplicate_address_hash = (); my @maintainers = get_maintainers(); - if (@maintainers) { @maintainers = merge_email(@maintainers); output(@maintainers); @@ -528,6 +658,11 @@ if ($scm) { output(@scm); } +if ($output_substatus) { + @substatus = uniq(@substatus); + output(@substatus); +} + if ($status) { @status = uniq(@status); output(@status); @@ -543,8 +678,142 @@ if ($web) { output(@web); } +if ($bug) { + @bug = uniq(@bug); + output(@bug); +} + exit($exit); +sub self_test { + my @lsfiles = (); + my @good_links = (); + my @bad_links = (); + my @section_headers = (); + my $index = 0; + + @lsfiles = vcs_list_files($lk_path); + + for my $x (@self_test_info) { + $index++; + + ## Section header duplication and missing section content + if (($self_test eq "" || $self_test =~ /\bsections\b/) && + $x->{line} =~ /^\S[^:]/ && + defined $self_test_info[$index] && + $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) { + my $has_S = 0; + my $has_F = 0; + my $has_ML = 0; + my $status = ""; + if (grep(m@^\Q$x->{line}\E@, @section_headers)) { + print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n"); + } else { + push(@section_headers, $x->{line}); + } + my $nextline = $index; + while (defined $self_test_info[$nextline] && + $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) { + my $type = $1; + my $value = $2; + if ($type eq "S") { + $has_S = 1; + $status = $value; + } elsif ($type eq "F" || $type eq "N") { + $has_F = 1; + } elsif ($type eq "M" || $type eq "R" || $type eq "L") { + $has_ML = 1; + } + $nextline++; + } + if (!$has_ML && $status !~ /orphan|obsolete/i) { + print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n"); + } + if (!$has_S) { + print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n"); + } + if (!$has_F) { + print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n"); + } + } + + next if ($x->{line} !~ /^([A-Z]):\s*(.*)/); + + my $type = $1; + my $value = $2; + + ## Filename pattern matching + if (($type eq "F" || $type eq "X") && + ($self_test eq "" || $self_test =~ /\bpatterns\b/)) { + $value =~ s@\.@\\\.@g; ##Convert . to \. + $value =~ s/\*/\.\*/g; ##Convert * to .* + $value =~ s/\?/\./g; ##Convert ? to . + ##if pattern is a directory and it lacks a trailing slash, add one + if ((-d $value)) { + $value =~ s@([^/])$@$1/@; + } + if (!grep(m@^$value@, @lsfiles)) { + print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n"); + } + + ## Link reachability + } elsif (($type eq "W" || $type eq "Q" || $type eq "B") && + $value =~ /^https?:/ && + ($self_test eq "" || $self_test =~ /\blinks\b/)) { + next if (grep(m@^\Q$value\E$@, @good_links)); + my $isbad = 0; + if (grep(m@^\Q$value\E$@, @bad_links)) { + $isbad = 1; + } else { + my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`; + if ($? == 0) { + push(@good_links, $value); + } else { + push(@bad_links, $value); + $isbad = 1; + } + } + if ($isbad) { + print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); + } + + ## SCM reachability + } elsif ($type eq "T" && + ($self_test eq "" || $self_test =~ /\bscm\b/)) { + next if (grep(m@^\Q$value\E$@, @good_links)); + my $isbad = 0; + if (grep(m@^\Q$value\E$@, @bad_links)) { + $isbad = 1; + } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) { + print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n"); + } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) { + my $url = $1; + my $branch = ""; + $branch = $3 if $3; + my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`; + if ($? == 0) { + push(@good_links, $value); + } else { + push(@bad_links, $value); + $isbad = 1; + } + } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) { + my $url = $1; + my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`; + if ($? == 0) { + push(@good_links, $value); + } else { + push(@bad_links, $value); + $isbad = 1; + } + } + if ($isbad) { + print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); + } + } + } +} + sub ignore_email_address { my ($address) = @_; @@ -599,8 +868,10 @@ sub get_maintainers { @list_to = (); @scm = (); @web = (); + @bug = (); @subsystem = (); @status = (); + @substatus = (); %deduplicate_name_hash = (); %deduplicate_address_hash = (); if ($email_git_all_signature_types) { @@ -673,7 +944,7 @@ sub get_maintainers { } foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { - add_categories($line); + add_categories($line, ""); if ($sections) { my $i; my $start = find_starting_index($line); @@ -694,12 +965,14 @@ sub get_maintainers { print("\n"); } } + + maintainers_in_file($file); } if ($keywords) { @keyword_tvi = sort_and_uniq(@keyword_tvi); foreach my $line (@keyword_tvi) { - add_categories($line); + add_categories($line, ":Keyword:$keyword_hash{$line}"); } } @@ -709,8 +982,10 @@ sub get_maintainers { foreach my $file (@files) { if ($email && - ($email_git || ($email_git_fallback && - !$exact_pattern_match_hash{$file}))) { + ($email_git || + ($email_git_fallback && + $file !~ /MAINTAINERS$/ && + !$exact_pattern_match_hash{$file}))) { vcs_file_signoffs($file); } if ($email && $email_git_blame) { @@ -733,6 +1008,7 @@ sub get_maintainers { } foreach my $email (@file_emails) { + $email = mailmap_email($email); my ($name, $address) = parse_email($email); my $tmp_email = format_email($name, $address, $email_usename); @@ -741,6 +1017,10 @@ sub get_maintainers { } } + foreach my $fix (@fixes) { + vcs_add_commit_signers($fix, "blamed_fixes"); + } + my @to = (); if ($email || $email_list) { if ($email) { @@ -801,15 +1081,19 @@ MAINTAINER field selection options: --r => include reviewer(s) if any --n => include name 'Full Name <addr\@domain.tld>' --l => include list(s) if any - --s => include subscriber only list(s) if any + --moderated => include moderated lists(s) if any (default: true) + --s => include subscriber only list(s) if any (default: false) --remove-duplicates => minimize duplicate email names/addresses - --roles => show roles (status:subsystem, git-signer, list, etc...) + --roles => show roles (role:subsystem, git-signer, list, etc...) --rolestats => show roles and statistics (commits/total_commits, %) + --substatus => show subsystem status if not Maintained (default: match --roles when output is tty)" --file-emails => add email addresses found in -f file (default: 0 (off)) + --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on)) --scm => print SCM tree(s) if any --status => print status if any --subsystem => print subsystem name if any --web => print website(s) if any + --bug => print bug reporting info if any Output type options: --separator [, ] => separator for multiple entries on 1 line @@ -819,15 +1103,18 @@ Output type options: Other options: --pattern-depth => Number of pattern directory traversals (default: 0 (all)) --keywords => scan patch for keywords (default: $keywords) + --keywords-in-file => scan file for keywords (default: $keywords_in_file) --sections => print all of the subsystem sections with pattern matches --letters => print all matching 'letter' types from all matching sections --mailmap => use .mailmap file (default: $email_use_mailmap) + --no-tree => run without a kernel tree + --self-test => show potential issues with MAINTAINERS file content --version => show version --help => show this help information Default options: - [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0 - --remove-duplicates --rolestats] + [--email --tree --nogit --git-fallback --m --r --n --l --multiline + --pattern-depth=0 --remove-duplicates --rolestats --keywords] Notes: Using "-f directory" may give unexpected results: @@ -873,7 +1160,7 @@ sub top_of_kernel_tree { if ( (-f "${lk_path}COPYING") && (-f "${lk_path}CREDITS") && (-f "${lk_path}Kbuild") - && (-f "${lk_path}MAINTAINERS") + && (-e "${lk_path}MAINTAINERS") && (-f "${lk_path}Makefile") && (-f "${lk_path}README") && (-d "${lk_path}Documentation") @@ -891,6 +1178,17 @@ sub top_of_kernel_tree { return 0; } +sub escape_name { + my ($name) = @_; + + if ($name =~ /[^\w \-]/ai) { ##has "must quote" chars + $name =~ s/(?<!\\)"/\\"/g; ##escape quotes + $name = "\"$name\""; + } + + return $name; +} + sub parse_email { my ($formatted_email) = @_; @@ -908,13 +1206,9 @@ sub parse_email { $name =~ s/^\s+|\s+$//g; $name =~ s/^\"|\"$//g; + $name = escape_name($name); $address =~ s/^\s+|\s+$//g; - if ($name =~ /[^\w \-]/i) { ##has "must quote" chars - $name =~ s/(?<!\\)"/\\"/g; ##escape quotes - $name = "\"$name\""; - } - return ($name, $address); } @@ -925,13 +1219,9 @@ sub format_email { $name =~ s/^\s+|\s+$//g; $name =~ s/^\"|\"$//g; + $name = escape_name($name); $address =~ s/^\s+|\s+$//g; - if ($name =~ /[^\w \-]/i) { ##has "must quote" chars - $name =~ s/(?<!\\)"/\\"/g; ##escape quotes - $name = "\"$name\""; - } - if ($usename) { if ("$name" eq "") { $formatted_email = "$address"; @@ -1008,8 +1298,9 @@ sub get_maintainer_role { my $start = find_starting_index($index); my $end = find_ending_index($index); - my $role = "unknown"; + my $role = "maintainer"; my $subsystem = get_subsystem_name($index); + my $status = "unknown"; for ($i = $start + 1; $i < $end; $i++) { my $tv = $typevalue[$i]; @@ -1017,23 +1308,13 @@ sub get_maintainer_role { my $ptype = $1; my $pvalue = $2; if ($ptype eq "S") { - $role = $pvalue; + $status = $pvalue; } } } - $role = lc($role); - if ($role eq "supported") { - $role = "supporter"; - } elsif ($role eq "maintained") { - $role = "maintainer"; - } elsif ($role eq "odd fixes") { - $role = "odd fixer"; - } elsif ($role eq "orphan") { - $role = "orphan minder"; - } elsif ($role eq "obsolete") { - $role = "obsolete minder"; - } elsif ($role eq "buried alive in reporters") { + $status = lc($status); + if ($status eq "buried alive in reporters") { $role = "chief penguin"; } @@ -1053,13 +1334,15 @@ sub get_list_role { } sub add_categories { - my ($index) = @_; + my ($index, $suffix) = @_; my $i; my $start = find_starting_index($index); my $end = find_ending_index($index); - push(@subsystem, $typevalue[$start]); + my $subsystem = $typevalue[$start]; + push(@subsystem, $subsystem); + my $status = "Unknown"; for ($i = $start + 1; $i < $end; $i++) { my $tv = $typevalue[$i]; @@ -1083,66 +1366,52 @@ sub add_categories { if (!$hash_list_to{lc($list_address)}) { $hash_list_to{lc($list_address)} = 1; push(@list_to, [$list_address, - "subscriber list${list_role}"]); + "subscriber list${list_role}" . $suffix]); } } } else { if ($email_list) { if (!$hash_list_to{lc($list_address)}) { - $hash_list_to{lc($list_address)} = 1; if ($list_additional =~ m/moderated/) { - push(@list_to, [$list_address, - "moderated list${list_role}"]); + if ($email_moderated_list) { + $hash_list_to{lc($list_address)} = 1; + push(@list_to, [$list_address, + "moderated list${list_role}" . $suffix]); + } } else { + $hash_list_to{lc($list_address)} = 1; push(@list_to, [$list_address, - "open list${list_role}"]); + "open list${list_role}" . $suffix]); } } } } } elsif ($ptype eq "M") { - my ($name, $address) = parse_email($pvalue); - if ($name eq "") { - if ($i > 0) { - my $tv = $typevalue[$i - 1]; - if ($tv =~ m/^([A-Z]):\s*(.*)/) { - if ($1 eq "P") { - $name = $2; - $pvalue = format_email($name, $address, $email_usename); - } - } - } - } if ($email_maintainer) { my $role = get_maintainer_role($i); - push_email_addresses($pvalue, $role); + push_email_addresses($pvalue, $role . $suffix); } } elsif ($ptype eq "R") { - my ($name, $address) = parse_email($pvalue); - if ($name eq "") { - if ($i > 0) { - my $tv = $typevalue[$i - 1]; - if ($tv =~ m/^([A-Z]):\s*(.*)/) { - if ($1 eq "P") { - $name = $2; - $pvalue = format_email($name, $address, $email_usename); - } - } - } - } if ($email_reviewer) { - my $subsystem = get_subsystem_name($i); - push_email_addresses($pvalue, "reviewer:$subsystem"); + my $subs = get_subsystem_name($i); + push_email_addresses($pvalue, "reviewer:$subs" . $suffix); } } elsif ($ptype eq "T") { - push(@scm, $pvalue); + push(@scm, $pvalue . $suffix); } elsif ($ptype eq "W") { - push(@web, $pvalue); + push(@web, $pvalue . $suffix); + } elsif ($ptype eq "B") { + push(@bug, $pvalue . $suffix); } elsif ($ptype eq "S") { - push(@status, $pvalue); + push(@status, $pvalue . $suffix); + $status = $pvalue; } } } + + if ($subsystem ne "THE REST" and $status ne "Maintained") { + push(@substatus, $subsystem . " status: " . $status . $suffix) + } } sub email_inuse { @@ -1481,7 +1750,7 @@ sub vcs_exists { %VCS_cmds = %VCS_cmds_hg; return 2 if eval $VCS_cmds{"available"}; %VCS_cmds = (); - if (!$printed_novcs) { + if (!$printed_novcs && $email_git) { warn("$P: No supported VCS found. Add --nogit to options?\n"); warn("Using a git repository produces better results.\n"); warn("Try Linus Torvalds' latest git repository using:\n"); @@ -1500,6 +1769,32 @@ sub vcs_is_hg { return $vcs_used == 2; } +sub vcs_add_commit_signers { + return if (!vcs_exists()); + + my ($commit, $desc) = @_; + my $commit_count = 0; + my $commit_authors_ref; + my $commit_signers_ref; + my $stats_ref; + my @commit_authors = (); + my @commit_signers = (); + my $cmd; + + $cmd = $VCS_cmds{"find_commit_signers_cmd"}; + $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd + + ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, ""); + @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; + @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; + + foreach my $signer (@commit_signers) { + $signer = deduplicate_email($signer); + } + + vcs_assign($desc, 1, @commit_signers); +} + sub interactive_get_maintainers { my ($list_ref) = @_; my @list = @$list_ref; @@ -1593,7 +1888,7 @@ tm toggle maintainers tg toggle git entries tl toggle open list entries ts toggle subscriber list entries -f emails in file [$file_emails] +f emails in file [$email_file_emails] k keywords in file [$keywords] r remove duplicates [$email_remove_duplicates] p# pattern match depth [$pattern_depth] @@ -1620,6 +1915,7 @@ EOT $done = 1; $output_rolestats = 0; $output_roles = 0; + $output_substatus = 0; last; } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { $selected{$nr - 1} = !$selected{$nr - 1}; @@ -1718,7 +2014,7 @@ EOT bool_invert(\$email_git_all_signature_types); $rerun = 1; } elsif ($sel eq "f") { - bool_invert(\$file_emails); + bool_invert(\$email_file_emails); $rerun = 1; } elsif ($sel eq "r") { bool_invert(\$email_remove_duplicates); @@ -2151,6 +2447,23 @@ sub vcs_file_exists { return $exists; } +sub vcs_list_files { + my ($file) = @_; + + my @lsfiles = (); + + my $vcs_used = vcs_exists(); + return 0 if (!$vcs_used); + + my $cmd = $VCS_cmds{"list_files_cmd"}; + $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd + @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd); + + return () if ($? != 0); + + return @lsfiles; +} + sub uniq { my (@parms) = @_; @@ -2175,17 +2488,23 @@ sub clean_file_emails { foreach my $email (@file_emails) { $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; my ($name, $address) = parse_email($email); - if ($name eq '"[,\.]"') { - $name = ""; - } - my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); + # Strip quotes for easier processing, format_email will add them back + $name =~ s/^"(.*)"$/$1/; + + # Split into name-like parts and remove stray punctuation particles + my @nw = split(/[^\p{L}\'\,\.\+-]/, $name); + @nw = grep(!/^[\'\,\.\+-]$/, @nw); + + # Make a best effort to extract the name, and only the name, by taking + # only the last two names, or in the case of obvious initials, the last + # three names. if (@nw > 2) { my $first = $nw[@nw - 3]; my $middle = $nw[@nw - 2]; my $last = $nw[@nw - 1]; - if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || + if (((length($first) == 1 && $first =~ m/\p{L}/) || (length($first) == 2 && substr($first, -1) eq ".")) || (length($middle) == 1 || (length($middle) == 2 && substr($middle, -1) eq "."))) { @@ -2193,18 +2512,16 @@ sub clean_file_emails { } else { $name = "$middle $last"; } + } else { + $name = "@nw"; } if (substr($name, -1) =~ /[,\.]/) { $name = substr($name, 0, length($name) - 1); - } elsif (substr($name, -2) =~ /[,\.]"/) { - $name = substr($name, 0, length($name) - 2) . '"'; } if (substr($name, 0, 1) =~ /[,\.]/) { $name = substr($name, 1, length($name) - 1); - } elsif (substr($name, 0, 2) =~ /"[,\.]/) { - $name = '"' . substr($name, 2, length($name) - 2); } my $fmt_email = format_email($name, $address, $email_usename); |