1cb77f0d6SKamil Rytarowski#!/usr/bin/env perl 2882ea1d6SJoe Perches# SPDX-License-Identifier: GPL-2.0 3882ea1d6SJoe Perches# 4cb7301c7SJoe Perches# (c) 2007, Joe Perches <joe@perches.com> 5cb7301c7SJoe Perches# created from checkpatch.pl 6cb7301c7SJoe Perches# 7cb7301c7SJoe Perches# Print selected MAINTAINERS information for 8cb7301c7SJoe Perches# the files modified in a patch or for a file 9cb7301c7SJoe Perches# 103bd7bf5fSRoel Kluin# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 113bd7bf5fSRoel Kluin# perl scripts/get_maintainer.pl [OPTIONS] -f <file> 12cb7301c7SJoe Perches 13cb77f0d6SKamil Rytarowskiuse warnings; 14cb7301c7SJoe Perchesuse strict; 15cb7301c7SJoe Perches 16cb7301c7SJoe Perchesmy $P = $0; 177e1863afSJoe Perchesmy $V = '0.26'; 18cb7301c7SJoe Perches 19cb7301c7SJoe Perchesuse Getopt::Long qw(:config no_auto_abbrev); 20be17bddcSJoe Perchesuse Cwd; 216f7d98ecSJoe Perchesuse File::Find; 22e33c9fe8SJoe Perchesuse File::Spec::Functions; 23cb7301c7SJoe Perches 24be17bddcSJoe Perchesmy $cur_path = fastgetcwd() . '/'; 25cb7301c7SJoe Perchesmy $lk_path = "./"; 26cb7301c7SJoe Perchesmy $email = 1; 27cb7301c7SJoe Perchesmy $email_usename = 1; 28cb7301c7SJoe Perchesmy $email_maintainer = 1; 29c1c3f2c9SJoe Perchesmy $email_reviewer = 1; 302f5bd343SJoe Perchesmy $email_fixes = 1; 31cb7301c7SJoe Perchesmy $email_list = 1; 3249662503SJoe Perchesmy $email_moderated_list = 1; 33cb7301c7SJoe Perchesmy $email_subscriber_list = 0; 34cb7301c7SJoe Perchesmy $email_git_penguin_chiefs = 0; 35e3e9d114SJoe Perchesmy $email_git = 0; 360fa05599SFlorian Micklermy $email_git_all_signature_types = 0; 3760db31acSJoe Perchesmy $email_git_blame = 0; 38683c6f8fSJoe Perchesmy $email_git_blame_signatures = 1; 39e3e9d114SJoe Perchesmy $email_git_fallback = 1; 40cb7301c7SJoe Perchesmy $email_git_min_signatures = 1; 41cb7301c7SJoe Perchesmy $email_git_max_maintainers = 5; 42afa81ee1SJoe Perchesmy $email_git_min_percent = 5; 43cb7301c7SJoe Perchesmy $email_git_since = "1-year-ago"; 4460db31acSJoe Perchesmy $email_hg_since = "-365"; 45dace8e30SFlorian Micklermy $interactive = 0; 4611ecf53cSJoe Perchesmy $email_remove_duplicates = 1; 47b9e2331dSJoe Perchesmy $email_use_mailmap = 1; 48cb7301c7SJoe Perchesmy $output_multiline = 1; 49cb7301c7SJoe Perchesmy $output_separator = ", "; 503c7385b8SJoe Perchesmy $output_roles = 0; 517e1863afSJoe Perchesmy $output_rolestats = 1; 52364f68dcSJoe Perchesmy $output_section_maxlen = 50; 53cb7301c7SJoe Perchesmy $scm = 0; 5431bb82c9SAntonio Nino Diazmy $tree = 1; 55cb7301c7SJoe Perchesmy $web = 0; 56cb7301c7SJoe Perchesmy $subsystem = 0; 57cb7301c7SJoe Perchesmy $status = 0; 5803aed214SJoe Perchesmy $letters = ""; 59dcf36a92SJoe Perchesmy $keywords = 1; 604b76c9daSJoe Perchesmy $sections = 0; 610c78c013SJoe Perchesmy $email_file_emails = 0; 624a7fdb5fSJoe Perchesmy $from_filename = 0; 633fb55652SJoe Perchesmy $pattern_depth = 0; 64083bf9c5SJoe Perchesmy $self_test = undef; 65cb7301c7SJoe Perchesmy $version = 0; 66cb7301c7SJoe Perchesmy $help = 0; 676f7d98ecSJoe Perchesmy $find_maintainer_files = 0; 685f0baf95SJoe Perchesmy $maintainer_path; 69683c6f8fSJoe Perchesmy $vcs_used = 0; 70683c6f8fSJoe Perches 71cb7301c7SJoe Perchesmy $exit = 0; 72cb7301c7SJoe Perches 730c78c013SJoe Perchesmy @files = (); 740c78c013SJoe Perchesmy @fixes = (); # If a patch description includes Fixes: lines 750c78c013SJoe Perchesmy @range = (); 760c78c013SJoe Perchesmy @keyword_tvi = (); 770c78c013SJoe Perchesmy @file_emails = (); 780c78c013SJoe Perches 79683c6f8fSJoe Perchesmy %commit_author_hash; 80683c6f8fSJoe Perchesmy %commit_signer_hash; 81dace8e30SFlorian Mickler 82cb7301c7SJoe Perchesmy @penguin_chief = (); 83cb7301c7SJoe Perchespush(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org"); 84cb7301c7SJoe Perches#Andrew wants in on most everything - 2009/01/14 85cb7301c7SJoe Perches#push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org"); 86cb7301c7SJoe Perches 87cb7301c7SJoe Perchesmy @penguin_chief_names = (); 88cb7301c7SJoe Perchesforeach my $chief (@penguin_chief) { 89cb7301c7SJoe Perches if ($chief =~ m/^(.*):(.*)/) { 90cb7301c7SJoe Perches my $chief_name = $1; 91cb7301c7SJoe Perches my $chief_addr = $2; 92cb7301c7SJoe Perches push(@penguin_chief_names, $chief_name); 93cb7301c7SJoe Perches } 94cb7301c7SJoe Perches} 95cb7301c7SJoe Perchesmy $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)"; 96cb7301c7SJoe Perches 97e4d26b02SJoe Perches# Signature types of people who are either 98e4d26b02SJoe Perches# a) responsible for the code in question, or 99e4d26b02SJoe Perches# b) familiar enough with it to give relevant feedback 100e4d26b02SJoe Perchesmy @signature_tags = (); 101e4d26b02SJoe Perchespush(@signature_tags, "Signed-off-by:"); 102e4d26b02SJoe Perchespush(@signature_tags, "Reviewed-by:"); 103e4d26b02SJoe Perchespush(@signature_tags, "Acked-by:"); 104e4d26b02SJoe Perches 1057dea2681SJoe Perchesmy $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 1067dea2681SJoe Perches 1075f2441e9SJoe Perches# rfc822 email address - preloaded methods go here. 1081b5e1cf6SJoe Perchesmy $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 109df4cc036SJoe Perchesmy $rfc822_char = '[\\000-\\377]'; 1101b5e1cf6SJoe Perches 11160db31acSJoe Perches# VCS command support: class-like functions and strings 11260db31acSJoe Perches 11360db31acSJoe Perchesmy %VCS_cmds; 11460db31acSJoe Perches 11560db31acSJoe Perchesmy %VCS_cmds_git = ( 11660db31acSJoe Perches "execute_cmd" => \&git_execute_cmd, 117ec83b616SRichard Genoud "available" => '(which("git") ne "") && (-e ".git")', 118683c6f8fSJoe Perches "find_signers_cmd" => 119ed128feaSIan Campbell "git log --no-color --follow --since=\$email_git_since " . 120c9ecefeaSJoe Perches '--numstat --no-merges ' . 121683c6f8fSJoe Perches '--format="GitCommit: %H%n' . 122683c6f8fSJoe Perches 'GitAuthor: %an <%ae>%n' . 123683c6f8fSJoe Perches 'GitDate: %aD%n' . 124683c6f8fSJoe Perches 'GitSubject: %s%n' . 125683c6f8fSJoe Perches '%b%n"' . 126683c6f8fSJoe Perches " -- \$file", 127683c6f8fSJoe Perches "find_commit_signers_cmd" => 128683c6f8fSJoe Perches "git log --no-color " . 129c9ecefeaSJoe Perches '--numstat ' . 130683c6f8fSJoe Perches '--format="GitCommit: %H%n' . 131683c6f8fSJoe Perches 'GitAuthor: %an <%ae>%n' . 132683c6f8fSJoe Perches 'GitDate: %aD%n' . 133683c6f8fSJoe Perches 'GitSubject: %s%n' . 134683c6f8fSJoe Perches '%b%n"' . 135683c6f8fSJoe Perches " -1 \$commit", 136683c6f8fSJoe Perches "find_commit_author_cmd" => 137683c6f8fSJoe Perches "git log --no-color " . 138c9ecefeaSJoe Perches '--numstat ' . 139683c6f8fSJoe Perches '--format="GitCommit: %H%n' . 140683c6f8fSJoe Perches 'GitAuthor: %an <%ae>%n' . 141683c6f8fSJoe Perches 'GitDate: %aD%n' . 142683c6f8fSJoe Perches 'GitSubject: %s%n"' . 143683c6f8fSJoe Perches " -1 \$commit", 14460db31acSJoe Perches "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file", 14560db31acSJoe Perches "blame_file_cmd" => "git blame -l \$file", 146683c6f8fSJoe Perches "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})", 147dace8e30SFlorian Mickler "blame_commit_pattern" => "^([0-9a-f]+) ", 148683c6f8fSJoe Perches "author_pattern" => "^GitAuthor: (.*)", 149683c6f8fSJoe Perches "subject_pattern" => "^GitSubject: (.*)", 150c9ecefeaSJoe Perches "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$", 1514cad35a7SJoe Perches "file_exists_cmd" => "git ls-files \$file", 152e1f75904STom Saeger "list_files_cmd" => "git ls-files \$file", 15360db31acSJoe Perches); 15460db31acSJoe Perches 15560db31acSJoe Perchesmy %VCS_cmds_hg = ( 15660db31acSJoe Perches "execute_cmd" => \&hg_execute_cmd, 15760db31acSJoe Perches "available" => '(which("hg") ne "") && (-d ".hg")', 15860db31acSJoe Perches "find_signers_cmd" => 15960db31acSJoe Perches "hg log --date=\$email_hg_since " . 160683c6f8fSJoe Perches "--template='HgCommit: {node}\\n" . 161683c6f8fSJoe Perches "HgAuthor: {author}\\n" . 162683c6f8fSJoe Perches "HgSubject: {desc}\\n'" . 163683c6f8fSJoe Perches " -- \$file", 164683c6f8fSJoe Perches "find_commit_signers_cmd" => 165683c6f8fSJoe Perches "hg log " . 166683c6f8fSJoe Perches "--template='HgSubject: {desc}\\n'" . 167683c6f8fSJoe Perches " -r \$commit", 168683c6f8fSJoe Perches "find_commit_author_cmd" => 169683c6f8fSJoe Perches "hg log " . 170683c6f8fSJoe Perches "--template='HgCommit: {node}\\n" . 171683c6f8fSJoe Perches "HgAuthor: {author}\\n" . 172683c6f8fSJoe Perches "HgSubject: {desc|firstline}\\n'" . 173683c6f8fSJoe Perches " -r \$commit", 17460db31acSJoe Perches "blame_range_cmd" => "", # not supported 175683c6f8fSJoe Perches "blame_file_cmd" => "hg blame -n \$file", 176683c6f8fSJoe Perches "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})", 177dace8e30SFlorian Mickler "blame_commit_pattern" => "^([ 0-9a-f]+):", 178683c6f8fSJoe Perches "author_pattern" => "^HgAuthor: (.*)", 179683c6f8fSJoe Perches "subject_pattern" => "^HgSubject: (.*)", 180c9ecefeaSJoe Perches "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$", 1814cad35a7SJoe Perches "file_exists_cmd" => "hg files \$file", 182e1f75904STom Saeger "list_files_cmd" => "hg manifest -R \$file", 18360db31acSJoe Perches); 18460db31acSJoe Perches 185bcde44edSJoe Perchesmy $conf = which_conf(".get_maintainer.conf"); 186bcde44edSJoe Perchesif (-f $conf) { 187368669daSJoe Perches my @conf_args; 188bcde44edSJoe Perches open(my $conffile, '<', "$conf") 189bcde44edSJoe Perches or warn "$P: Can't find a readable .get_maintainer.conf file $!\n"; 190bcde44edSJoe Perches 191368669daSJoe Perches while (<$conffile>) { 192368669daSJoe Perches my $line = $_; 193368669daSJoe Perches 194368669daSJoe Perches $line =~ s/\s*\n?$//g; 195368669daSJoe Perches $line =~ s/^\s*//g; 196368669daSJoe Perches $line =~ s/\s+/ /g; 197368669daSJoe Perches 198368669daSJoe Perches next if ($line =~ m/^\s*#/); 199368669daSJoe Perches next if ($line =~ m/^\s*$/); 200368669daSJoe Perches 201368669daSJoe Perches my @words = split(" ", $line); 202368669daSJoe Perches foreach my $word (@words) { 203368669daSJoe Perches last if ($word =~ m/^#/); 204368669daSJoe Perches push (@conf_args, $word); 205368669daSJoe Perches } 206368669daSJoe Perches } 207368669daSJoe Perches close($conffile); 208368669daSJoe Perches unshift(@ARGV, @conf_args) if @conf_args; 209368669daSJoe Perches} 210368669daSJoe Perches 211435de078SJoe Perchesmy @ignore_emails = (); 212435de078SJoe Perchesmy $ignore_file = which_conf(".get_maintainer.ignore"); 213435de078SJoe Perchesif (-f $ignore_file) { 214435de078SJoe Perches open(my $ignore, '<', "$ignore_file") 215435de078SJoe Perches or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n"; 216435de078SJoe Perches while (<$ignore>) { 217435de078SJoe Perches my $line = $_; 218435de078SJoe Perches 219435de078SJoe Perches $line =~ s/\s*\n?$//; 220435de078SJoe Perches $line =~ s/^\s*//; 221435de078SJoe Perches $line =~ s/\s+$//; 222435de078SJoe Perches $line =~ s/#.*$//; 223435de078SJoe Perches 224435de078SJoe Perches next if ($line =~ m/^\s*$/); 225435de078SJoe Perches if (rfc822_valid($line)) { 226435de078SJoe Perches push(@ignore_emails, $line); 227435de078SJoe Perches } 228435de078SJoe Perches } 229435de078SJoe Perches close($ignore); 230435de078SJoe Perches} 231435de078SJoe Perches 232e1f75904STom Saegerif ($#ARGV > 0) { 233e1f75904STom Saeger foreach (@ARGV) { 234083bf9c5SJoe Perches if ($_ =~ /^-{1,2}self-test(?:=|$)/) { 235e1f75904STom Saeger die "$P: using --self-test does not allow any other option or argument\n"; 236e1f75904STom Saeger } 237e1f75904STom Saeger } 238e1f75904STom Saeger} 239e1f75904STom Saeger 240cb7301c7SJoe Perchesif (!GetOptions( 241cb7301c7SJoe Perches 'email!' => \$email, 242cb7301c7SJoe Perches 'git!' => \$email_git, 243e4d26b02SJoe Perches 'git-all-signature-types!' => \$email_git_all_signature_types, 24460db31acSJoe Perches 'git-blame!' => \$email_git_blame, 245683c6f8fSJoe Perches 'git-blame-signatures!' => \$email_git_blame_signatures, 246e3e9d114SJoe Perches 'git-fallback!' => \$email_git_fallback, 247cb7301c7SJoe Perches 'git-chief-penguins!' => \$email_git_penguin_chiefs, 248cb7301c7SJoe Perches 'git-min-signatures=i' => \$email_git_min_signatures, 249cb7301c7SJoe Perches 'git-max-maintainers=i' => \$email_git_max_maintainers, 250afa81ee1SJoe Perches 'git-min-percent=i' => \$email_git_min_percent, 251cb7301c7SJoe Perches 'git-since=s' => \$email_git_since, 25260db31acSJoe Perches 'hg-since=s' => \$email_hg_since, 253dace8e30SFlorian Mickler 'i|interactive!' => \$interactive, 25411ecf53cSJoe Perches 'remove-duplicates!' => \$email_remove_duplicates, 255b9e2331dSJoe Perches 'mailmap!' => \$email_use_mailmap, 256cb7301c7SJoe Perches 'm!' => \$email_maintainer, 257c1c3f2c9SJoe Perches 'r!' => \$email_reviewer, 258cb7301c7SJoe Perches 'n!' => \$email_usename, 259cb7301c7SJoe Perches 'l!' => \$email_list, 2602f5bd343SJoe Perches 'fixes!' => \$email_fixes, 26149662503SJoe Perches 'moderated!' => \$email_moderated_list, 262cb7301c7SJoe Perches 's!' => \$email_subscriber_list, 263cb7301c7SJoe Perches 'multiline!' => \$output_multiline, 2643c7385b8SJoe Perches 'roles!' => \$output_roles, 2653c7385b8SJoe Perches 'rolestats!' => \$output_rolestats, 266cb7301c7SJoe Perches 'separator=s' => \$output_separator, 267cb7301c7SJoe Perches 'subsystem!' => \$subsystem, 268cb7301c7SJoe Perches 'status!' => \$status, 269cb7301c7SJoe Perches 'scm!' => \$scm, 27031bb82c9SAntonio Nino Diaz 'tree!' => \$tree, 271cb7301c7SJoe Perches 'web!' => \$web, 27203aed214SJoe Perches 'letters=s' => \$letters, 2733fb55652SJoe Perches 'pattern-depth=i' => \$pattern_depth, 274dcf36a92SJoe Perches 'k|keywords!' => \$keywords, 2754b76c9daSJoe Perches 'sections!' => \$sections, 2760c78c013SJoe Perches 'fe|file-emails!' => \$email_file_emails, 2774a7fdb5fSJoe Perches 'f|file' => \$from_filename, 2786f7d98ecSJoe Perches 'find-maintainer-files' => \$find_maintainer_files, 2795f0baf95SJoe Perches 'mpath|maintainer-path=s' => \$maintainer_path, 280083bf9c5SJoe Perches 'self-test:s' => \$self_test, 281cb7301c7SJoe Perches 'v|version' => \$version, 28264f77f31SJoe Perches 'h|help|usage' => \$help, 283cb7301c7SJoe Perches )) { 2843c7385b8SJoe Perches die "$P: invalid argument - use --help if necessary\n"; 285cb7301c7SJoe Perches} 286cb7301c7SJoe Perches 287cb7301c7SJoe Perchesif ($help != 0) { 288cb7301c7SJoe Perches usage(); 289cb7301c7SJoe Perches exit 0; 290cb7301c7SJoe Perches} 291cb7301c7SJoe Perches 292cb7301c7SJoe Perchesif ($version != 0) { 293cb7301c7SJoe Perches print("${P} ${V}\n"); 294cb7301c7SJoe Perches exit 0; 295cb7301c7SJoe Perches} 296cb7301c7SJoe Perches 297083bf9c5SJoe Perchesif (defined $self_test) { 298e1f75904STom Saeger read_all_maintainer_files(); 299083bf9c5SJoe Perches self_test(); 300e1f75904STom Saeger exit 0; 301e1f75904STom Saeger} 302e1f75904STom Saeger 30364f77f31SJoe Perchesif (-t STDIN && !@ARGV) { 30464f77f31SJoe Perches # We're talking to a terminal, but have no command line arguments. 30564f77f31SJoe Perches die "$P: missing patchfile or -f file - use --help if necessary\n"; 306cb7301c7SJoe Perches} 307cb7301c7SJoe Perches 308683c6f8fSJoe Perches$output_multiline = 0 if ($output_separator ne ", "); 309683c6f8fSJoe Perches$output_rolestats = 1 if ($interactive); 310683c6f8fSJoe Perches$output_roles = 1 if ($output_rolestats); 3113c7385b8SJoe Perches 31203aed214SJoe Perchesif ($sections || $letters ne "") { 31303aed214SJoe Perches $sections = 1; 3144b76c9daSJoe Perches $email = 0; 3154b76c9daSJoe Perches $email_list = 0; 3164b76c9daSJoe Perches $scm = 0; 3174b76c9daSJoe Perches $status = 0; 3184b76c9daSJoe Perches $subsystem = 0; 3194b76c9daSJoe Perches $web = 0; 3204b76c9daSJoe Perches $keywords = 0; 3216ef1c52eSJoe Perches $interactive = 0; 3224b76c9daSJoe Perches} else { 323cb7301c7SJoe Perches my $selections = $email + $scm + $status + $subsystem + $web; 324cb7301c7SJoe Perches if ($selections == 0) { 325cb7301c7SJoe Perches die "$P: Missing required option: email, scm, status, subsystem or web\n"; 326cb7301c7SJoe Perches } 3274b76c9daSJoe Perches} 328cb7301c7SJoe Perches 329f5492666SJoe Perchesif ($email && 330c1c3f2c9SJoe Perches ($email_maintainer + $email_reviewer + 331c1c3f2c9SJoe Perches $email_list + $email_subscriber_list + 332f5492666SJoe Perches $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) { 333cb7301c7SJoe Perches die "$P: Please select at least 1 email option\n"; 334cb7301c7SJoe Perches} 335cb7301c7SJoe Perches 33631bb82c9SAntonio Nino Diazif ($tree && !top_of_kernel_tree($lk_path)) { 337cb7301c7SJoe Perches die "$P: The current directory does not appear to be " 338cb7301c7SJoe Perches . "a linux kernel source tree.\n"; 339cb7301c7SJoe Perches} 340cb7301c7SJoe Perches 341cb7301c7SJoe Perches## Read MAINTAINERS for type/value pairs 342cb7301c7SJoe Perches 343cb7301c7SJoe Perchesmy @typevalue = (); 344dcf36a92SJoe Perchesmy %keyword_hash; 3456f7d98ecSJoe Perchesmy @mfiles = (); 346083bf9c5SJoe Perchesmy @self_test_info = (); 347dcf36a92SJoe Perches 3486f7d98ecSJoe Perchessub read_maintainer_file { 3496f7d98ecSJoe Perches my ($file) = @_; 3506f7d98ecSJoe Perches 3516f7d98ecSJoe Perches open (my $maint, '<', "$file") 3526f7d98ecSJoe Perches or die "$P: Can't open MAINTAINERS file '$file': $!\n"; 353e1f75904STom Saeger my $i = 1; 35422dd5b0cSStephen Hemminger while (<$maint>) { 355cb7301c7SJoe Perches my $line = $_; 356083bf9c5SJoe Perches chomp $line; 357cb7301c7SJoe Perches 358ce8155f7SJoe Perches if ($line =~ m/^([A-Z]):\s*(.*)/) { 359cb7301c7SJoe Perches my $type = $1; 360cb7301c7SJoe Perches my $value = $2; 361cb7301c7SJoe Perches 362cb7301c7SJoe Perches ##Filename pattern matching 363cb7301c7SJoe Perches if ($type eq "F" || $type eq "X") { 364cb7301c7SJoe Perches $value =~ s@\.@\\\.@g; ##Convert . to \. 365cb7301c7SJoe Perches $value =~ s/\*/\.\*/g; ##Convert * to .* 366cb7301c7SJoe Perches $value =~ s/\?/\./g; ##Convert ? to . 367870020f9SJoe Perches ##if pattern is a directory and it lacks a trailing slash, add one 368870020f9SJoe Perches if ((-d $value)) { 369870020f9SJoe Perches $value =~ s@([^/])$@$1/@; 370870020f9SJoe Perches } 371dcf36a92SJoe Perches } elsif ($type eq "K") { 372dcf36a92SJoe Perches $keyword_hash{@typevalue} = $value; 373cb7301c7SJoe Perches } 374cb7301c7SJoe Perches push(@typevalue, "$type:$value"); 3756f7d98ecSJoe Perches } elsif (!(/^\s*$/ || /^\s*\#/)) { 376cb7301c7SJoe Perches push(@typevalue, $line); 377cb7301c7SJoe Perches } 378083bf9c5SJoe Perches if (defined $self_test) { 379083bf9c5SJoe Perches push(@self_test_info, {file=>$file, linenr=>$i, line=>$line}); 380083bf9c5SJoe Perches } 381e1f75904STom Saeger $i++; 382cb7301c7SJoe Perches } 38322dd5b0cSStephen Hemminger close($maint); 3846f7d98ecSJoe Perches} 385cb7301c7SJoe Perches 3866f7d98ecSJoe Perchessub find_is_maintainer_file { 3876f7d98ecSJoe Perches my ($file) = $_; 3886f7d98ecSJoe Perches return if ($file !~ m@/MAINTAINERS$@); 3896f7d98ecSJoe Perches $file = $File::Find::name; 3906f7d98ecSJoe Perches return if (! -f $file); 3916f7d98ecSJoe Perches push(@mfiles, $file); 3926f7d98ecSJoe Perches} 3936f7d98ecSJoe Perches 3946f7d98ecSJoe Perchessub find_ignore_git { 3956f7d98ecSJoe Perches return grep { $_ !~ /^\.git$/; } @_; 3966f7d98ecSJoe Perches} 3976f7d98ecSJoe Perches 398e1f75904STom Saegerread_all_maintainer_files(); 399e1f75904STom Saeger 400e1f75904STom Saegersub read_all_maintainer_files { 4015f0baf95SJoe Perches my $path = "${lk_path}MAINTAINERS"; 4025f0baf95SJoe Perches if (defined $maintainer_path) { 4035f0baf95SJoe Perches $path = $maintainer_path; 4045f0baf95SJoe Perches # Perl Cookbook tilde expansion if necessary 4055f0baf95SJoe Perches $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex; 4065f0baf95SJoe Perches } 4075f0baf95SJoe Perches 4085f0baf95SJoe Perches if (-d $path) { 4095f0baf95SJoe Perches $path .= '/' if ($path !~ m@/$@); 4100fbd75fdSJoe Perches if ($find_maintainer_files) { 4110fbd75fdSJoe Perches find( { wanted => \&find_is_maintainer_file, 4120fbd75fdSJoe Perches preprocess => \&find_ignore_git, 4130fbd75fdSJoe Perches no_chdir => 1, 4140fbd75fdSJoe Perches }, "$path"); 4150fbd75fdSJoe Perches } else { 4165f0baf95SJoe Perches opendir(DIR, "$path") or die $!; 4176f7d98ecSJoe Perches my @files = readdir(DIR); 4186f7d98ecSJoe Perches closedir(DIR); 4196f7d98ecSJoe Perches foreach my $file (@files) { 4205f0baf95SJoe Perches push(@mfiles, "$path$file") if ($file !~ /^\./); 4216f7d98ecSJoe Perches } 4226f7d98ecSJoe Perches } 4235f0baf95SJoe Perches } elsif (-f "$path") { 4245f0baf95SJoe Perches push(@mfiles, "$path"); 4255f0baf95SJoe Perches } else { 4265f0baf95SJoe Perches die "$P: MAINTAINER file not found '$path'\n"; 4275f0baf95SJoe Perches } 4285f0baf95SJoe Perches die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0); 4296f7d98ecSJoe Perches foreach my $file (@mfiles) { 4306f7d98ecSJoe Perches read_maintainer_file("$file"); 4316f7d98ecSJoe Perches } 432e1f75904STom Saeger} 4338cbb3a77SJoe Perches 4340c78c013SJoe Perchessub maintainers_in_file { 4350c78c013SJoe Perches my ($file) = @_; 4360c78c013SJoe Perches 4370c78c013SJoe Perches return if ($file =~ m@\bMAINTAINERS$@); 4380c78c013SJoe Perches 4390c78c013SJoe Perches if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) { 4400c78c013SJoe Perches open(my $f, '<', $file) 4410c78c013SJoe Perches or die "$P: Can't open $file: $!\n"; 4420c78c013SJoe Perches my $text = do { local($/) ; <$f> }; 4430c78c013SJoe Perches close($f); 4440c78c013SJoe Perches 4450c78c013SJoe Perches 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; 4460c78c013SJoe Perches push(@file_emails, clean_file_emails(@poss_addr)); 4470c78c013SJoe Perches } 4480c78c013SJoe Perches} 4490c78c013SJoe Perches 4507fa8ff2eSFlorian Mickler# 4517fa8ff2eSFlorian Mickler# Read mail address map 4527fa8ff2eSFlorian Mickler# 4537fa8ff2eSFlorian Mickler 454b9e2331dSJoe Perchesmy $mailmap; 455b9e2331dSJoe Perches 456b9e2331dSJoe Perchesread_mailmap(); 4577fa8ff2eSFlorian Mickler 4587fa8ff2eSFlorian Micklersub read_mailmap { 459b9e2331dSJoe Perches $mailmap = { 4607fa8ff2eSFlorian Mickler names => {}, 4617fa8ff2eSFlorian Mickler addresses => {} 4627fa8ff2eSFlorian Mickler }; 4637fa8ff2eSFlorian Mickler 464b9e2331dSJoe Perches return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap")); 4657fa8ff2eSFlorian Mickler 4667fa8ff2eSFlorian Mickler open(my $mailmap_file, '<', "${lk_path}.mailmap") 46722dd5b0cSStephen Hemminger or warn "$P: Can't open .mailmap: $!\n"; 4688cbb3a77SJoe Perches 4697fa8ff2eSFlorian Mickler while (<$mailmap_file>) { 4707fa8ff2eSFlorian Mickler s/#.*$//; #strip comments 4717fa8ff2eSFlorian Mickler s/^\s+|\s+$//g; #trim 4728cbb3a77SJoe Perches 4737fa8ff2eSFlorian Mickler next if (/^\s*$/); #skip empty lines 4747fa8ff2eSFlorian Mickler #entries have one of the following formats: 4757fa8ff2eSFlorian Mickler # name1 <mail1> 4767fa8ff2eSFlorian Mickler # <mail1> <mail2> 4777fa8ff2eSFlorian Mickler # name1 <mail1> <mail2> 4787fa8ff2eSFlorian Mickler # name1 <mail1> name2 <mail2> 4797fa8ff2eSFlorian Mickler # (see man git-shortlog) 4800334b382SJoe Perches 4810334b382SJoe Perches if (/^([^<]+)<([^>]+)>$/) { 4827fa8ff2eSFlorian Mickler my $real_name = $1; 4837fa8ff2eSFlorian Mickler my $address = $2; 4848cbb3a77SJoe Perches 4857fa8ff2eSFlorian Mickler $real_name =~ s/\s+$//; 486b9e2331dSJoe Perches ($real_name, $address) = parse_email("$real_name <$address>"); 4877fa8ff2eSFlorian Mickler $mailmap->{names}->{$address} = $real_name; 4888cbb3a77SJoe Perches 4890334b382SJoe Perches } elsif (/^<([^>]+)>\s*<([^>]+)>$/) { 4907fa8ff2eSFlorian Mickler my $real_address = $1; 4917fa8ff2eSFlorian Mickler my $wrong_address = $2; 4927fa8ff2eSFlorian Mickler 4937fa8ff2eSFlorian Mickler $mailmap->{addresses}->{$wrong_address} = $real_address; 4947fa8ff2eSFlorian Mickler 4950334b382SJoe Perches } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) { 4967fa8ff2eSFlorian Mickler my $real_name = $1; 4977fa8ff2eSFlorian Mickler my $real_address = $2; 4987fa8ff2eSFlorian Mickler my $wrong_address = $3; 4997fa8ff2eSFlorian Mickler 5007fa8ff2eSFlorian Mickler $real_name =~ s/\s+$//; 501b9e2331dSJoe Perches ($real_name, $real_address) = 502b9e2331dSJoe Perches parse_email("$real_name <$real_address>"); 5037fa8ff2eSFlorian Mickler $mailmap->{names}->{$wrong_address} = $real_name; 5047fa8ff2eSFlorian Mickler $mailmap->{addresses}->{$wrong_address} = $real_address; 5057fa8ff2eSFlorian Mickler 5060334b382SJoe Perches } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) { 5077fa8ff2eSFlorian Mickler my $real_name = $1; 5087fa8ff2eSFlorian Mickler my $real_address = $2; 5097fa8ff2eSFlorian Mickler my $wrong_name = $3; 5107fa8ff2eSFlorian Mickler my $wrong_address = $4; 5117fa8ff2eSFlorian Mickler 5127fa8ff2eSFlorian Mickler $real_name =~ s/\s+$//; 513b9e2331dSJoe Perches ($real_name, $real_address) = 514b9e2331dSJoe Perches parse_email("$real_name <$real_address>"); 5157fa8ff2eSFlorian Mickler 516b9e2331dSJoe Perches $wrong_name =~ s/\s+$//; 517b9e2331dSJoe Perches ($wrong_name, $wrong_address) = 518b9e2331dSJoe Perches parse_email("$wrong_name <$wrong_address>"); 519b9e2331dSJoe Perches 520b9e2331dSJoe Perches my $wrong_email = format_email($wrong_name, $wrong_address, 1); 521b9e2331dSJoe Perches $mailmap->{names}->{$wrong_email} = $real_name; 522b9e2331dSJoe Perches $mailmap->{addresses}->{$wrong_email} = $real_address; 5238cbb3a77SJoe Perches } 5248cbb3a77SJoe Perches } 5257fa8ff2eSFlorian Mickler close($mailmap_file); 5268cbb3a77SJoe Perches} 5278cbb3a77SJoe Perches 5284a7fdb5fSJoe Perches## use the filenames on the command line or find the filenames in the patchfiles 529cb7301c7SJoe Perches 53064f77f31SJoe Perchesif (!@ARGV) { 53164f77f31SJoe Perches push(@ARGV, "&STDIN"); 53264f77f31SJoe Perches} 53364f77f31SJoe Perches 5344a7fdb5fSJoe Perchesforeach my $file (@ARGV) { 53564f77f31SJoe Perches if ($file ne "&STDIN") { 536e33c9fe8SJoe Perches $file = canonpath($file); 537870020f9SJoe Perches ##if $file is a directory and it lacks a trailing slash, add one 538870020f9SJoe Perches if ((-d $file)) { 539870020f9SJoe Perches $file =~ s@([^/])$@$1/@; 540870020f9SJoe Perches } elsif (!(-f $file)) { 5414a7fdb5fSJoe Perches die "$P: file '${file}' not found\n"; 542cb7301c7SJoe Perches } 54364f77f31SJoe Perches } 544cdfe2d22SJoe Perches if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) { 545cdfe2d22SJoe Perches warn "$P: file '$file' not found in version control $!\n"; 546cdfe2d22SJoe Perches } 547aec742e8SJoe Perches if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) { 548be17bddcSJoe Perches $file =~ s/^\Q${cur_path}\E//; #strip any absolute path 549be17bddcSJoe Perches $file =~ s/^\Q${lk_path}\E//; #or the path to the lk tree 5504a7fdb5fSJoe Perches push(@files, $file); 5510c78c013SJoe Perches if ($file ne "MAINTAINERS" && -f $file && $keywords) { 55222dd5b0cSStephen Hemminger open(my $f, '<', $file) 55322dd5b0cSStephen Hemminger or die "$P: Can't open $file: $!\n"; 55422dd5b0cSStephen Hemminger my $text = do { local($/) ; <$f> }; 55522dd5b0cSStephen Hemminger close($f); 55603372dbbSJoe Perches if ($keywords) { 557dcf36a92SJoe Perches foreach my $line (keys %keyword_hash) { 558a8af2430SJoe Perches if ($text =~ m/$keyword_hash{$line}/x) { 559dcf36a92SJoe Perches push(@keyword_tvi, $line); 560dcf36a92SJoe Perches } 561dcf36a92SJoe Perches } 56203372dbbSJoe Perches } 563dcf36a92SJoe Perches } 564cb7301c7SJoe Perches } else { 5654a7fdb5fSJoe Perches my $file_cnt = @files; 566f5492666SJoe Perches my $lastfile; 56722dd5b0cSStephen Hemminger 5683a4df13dSWolfram Sang open(my $patch, "< $file") 56922dd5b0cSStephen Hemminger or die "$P: Can't open $file: $!\n"; 5707764dcb5SJoe Perches 5717764dcb5SJoe Perches # We can check arbitrary information before the patch 5727764dcb5SJoe Perches # like the commit message, mail headers, etc... 5737764dcb5SJoe Perches # This allows us to match arbitrary keywords against any part 5747764dcb5SJoe Perches # of a git format-patch generated file (subject tags, etc...) 5757764dcb5SJoe Perches 5767764dcb5SJoe Perches my $patch_prefix = ""; #Parsing the intro 5777764dcb5SJoe Perches 57822dd5b0cSStephen Hemminger while (<$patch>) { 579dcf36a92SJoe Perches my $patch_line = $_; 5800455c747SJoe Perches if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) { 5810455c747SJoe Perches my $filename = $1; 5820455c747SJoe Perches push(@files, $filename); 5830455c747SJoe Perches } elsif (m/^rename (?:from|to) (\S+)\s*$/) { 5840455c747SJoe Perches my $filename = $1; 5850455c747SJoe Perches push(@files, $filename); 5860455c747SJoe Perches } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) { 5870455c747SJoe Perches my $filename1 = $1; 5880455c747SJoe Perches my $filename2 = $2; 5890455c747SJoe Perches push(@files, $filename1); 5900455c747SJoe Perches push(@files, $filename2); 5912f5bd343SJoe Perches } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) { 5922f5bd343SJoe Perches push(@fixes, $1) if ($email_fixes); 5930455c747SJoe Perches } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) { 5944a7fdb5fSJoe Perches my $filename = $1; 5954a7fdb5fSJoe Perches $filename =~ s@^[^/]*/@@; 5964a7fdb5fSJoe Perches $filename =~ s@\n@@; 597f5492666SJoe Perches $lastfile = $filename; 5984a7fdb5fSJoe Perches push(@files, $filename); 5997764dcb5SJoe Perches $patch_prefix = "^[+-].*"; #Now parsing the actual patch 600f5492666SJoe Perches } elsif (m/^\@\@ -(\d+),(\d+)/) { 601f5492666SJoe Perches if ($email_git_blame) { 602f5492666SJoe Perches push(@range, "$lastfile:$1:$2"); 603f5492666SJoe Perches } 604dcf36a92SJoe Perches } elsif ($keywords) { 605dcf36a92SJoe Perches foreach my $line (keys %keyword_hash) { 6067764dcb5SJoe Perches if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) { 607dcf36a92SJoe Perches push(@keyword_tvi, $line); 608dcf36a92SJoe Perches } 609dcf36a92SJoe Perches } 610cb7301c7SJoe Perches } 611cb7301c7SJoe Perches } 61222dd5b0cSStephen Hemminger close($patch); 61322dd5b0cSStephen Hemminger 6144a7fdb5fSJoe Perches if ($file_cnt == @files) { 6157f29fd27SJoe Perches warn "$P: file '${file}' doesn't appear to be a patch. " 616cb7301c7SJoe Perches . "Add -f to options?\n"; 617cb7301c7SJoe Perches } 618cb7301c7SJoe Perches @files = sort_and_uniq(@files); 619cb7301c7SJoe Perches } 6204a7fdb5fSJoe Perches} 621cb7301c7SJoe Perches 62203372dbbSJoe Perches@file_emails = uniq(@file_emails); 6232f5bd343SJoe Perches@fixes = uniq(@fixes); 62403372dbbSJoe Perches 625683c6f8fSJoe Perchesmy %email_hash_name; 626683c6f8fSJoe Perchesmy %email_hash_address; 627cb7301c7SJoe Perchesmy @email_to = (); 628683c6f8fSJoe Perchesmy %hash_list_to; 629290603c1SJoe Perchesmy @list_to = (); 630cb7301c7SJoe Perchesmy @scm = (); 631cb7301c7SJoe Perchesmy @web = (); 632cb7301c7SJoe Perchesmy @subsystem = (); 633cb7301c7SJoe Perchesmy @status = (); 634b9e2331dSJoe Perchesmy %deduplicate_name_hash = (); 635b9e2331dSJoe Perchesmy %deduplicate_address_hash = (); 636683c6f8fSJoe Perches 6376ef1c52eSJoe Perchesmy @maintainers = get_maintainers(); 6386ef1c52eSJoe Perchesif (@maintainers) { 6396ef1c52eSJoe Perches @maintainers = merge_email(@maintainers); 6406ef1c52eSJoe Perches output(@maintainers); 6416ef1c52eSJoe Perches} 642683c6f8fSJoe Perches 643683c6f8fSJoe Perchesif ($scm) { 644683c6f8fSJoe Perches @scm = uniq(@scm); 645683c6f8fSJoe Perches output(@scm); 646683c6f8fSJoe Perches} 647683c6f8fSJoe Perches 648683c6f8fSJoe Perchesif ($status) { 649683c6f8fSJoe Perches @status = uniq(@status); 650683c6f8fSJoe Perches output(@status); 651683c6f8fSJoe Perches} 652683c6f8fSJoe Perches 653683c6f8fSJoe Perchesif ($subsystem) { 654683c6f8fSJoe Perches @subsystem = uniq(@subsystem); 655683c6f8fSJoe Perches output(@subsystem); 656683c6f8fSJoe Perches} 657683c6f8fSJoe Perches 658683c6f8fSJoe Perchesif ($web) { 659683c6f8fSJoe Perches @web = uniq(@web); 660683c6f8fSJoe Perches output(@web); 661683c6f8fSJoe Perches} 662683c6f8fSJoe Perches 663683c6f8fSJoe Perchesexit($exit); 664683c6f8fSJoe Perches 665083bf9c5SJoe Perchessub self_test { 666e1f75904STom Saeger my @lsfiles = (); 667083bf9c5SJoe Perches my @good_links = (); 668083bf9c5SJoe Perches my @bad_links = (); 669083bf9c5SJoe Perches my @section_headers = (); 670083bf9c5SJoe Perches my $index = 0; 671e1f75904STom Saeger 672e1f75904STom Saeger @lsfiles = vcs_list_files($lk_path); 673e1f75904STom Saeger 674083bf9c5SJoe Perches for my $x (@self_test_info) { 675083bf9c5SJoe Perches $index++; 676083bf9c5SJoe Perches 677083bf9c5SJoe Perches ## Section header duplication and missing section content 678083bf9c5SJoe Perches if (($self_test eq "" || $self_test =~ /\bsections\b/) && 679083bf9c5SJoe Perches $x->{line} =~ /^\S[^:]/ && 680083bf9c5SJoe Perches defined $self_test_info[$index] && 681083bf9c5SJoe Perches $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) { 682083bf9c5SJoe Perches my $has_S = 0; 683083bf9c5SJoe Perches my $has_F = 0; 684083bf9c5SJoe Perches my $has_ML = 0; 685083bf9c5SJoe Perches my $status = ""; 686083bf9c5SJoe Perches if (grep(m@^\Q$x->{line}\E@, @section_headers)) { 687083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n"); 688083bf9c5SJoe Perches } else { 689083bf9c5SJoe Perches push(@section_headers, $x->{line}); 690083bf9c5SJoe Perches } 691083bf9c5SJoe Perches my $nextline = $index; 692083bf9c5SJoe Perches while (defined $self_test_info[$nextline] && 693083bf9c5SJoe Perches $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) { 694083bf9c5SJoe Perches my $type = $1; 695083bf9c5SJoe Perches my $value = $2; 696083bf9c5SJoe Perches if ($type eq "S") { 697083bf9c5SJoe Perches $has_S = 1; 698083bf9c5SJoe Perches $status = $value; 699083bf9c5SJoe Perches } elsif ($type eq "F" || $type eq "N") { 700083bf9c5SJoe Perches $has_F = 1; 701083bf9c5SJoe Perches } elsif ($type eq "M" || $type eq "R" || $type eq "L") { 702083bf9c5SJoe Perches $has_ML = 1; 703083bf9c5SJoe Perches } 704083bf9c5SJoe Perches $nextline++; 705083bf9c5SJoe Perches } 706083bf9c5SJoe Perches if (!$has_ML && $status !~ /orphan|obsolete/i) { 707083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n"); 708083bf9c5SJoe Perches } 709083bf9c5SJoe Perches if (!$has_S) { 710083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n"); 711083bf9c5SJoe Perches } 712083bf9c5SJoe Perches if (!$has_F) { 713083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n"); 714083bf9c5SJoe Perches } 715083bf9c5SJoe Perches } 716083bf9c5SJoe Perches 717083bf9c5SJoe Perches next if ($x->{line} !~ /^([A-Z]):\s*(.*)/); 718083bf9c5SJoe Perches 719083bf9c5SJoe Perches my $type = $1; 720083bf9c5SJoe Perches my $value = $2; 721083bf9c5SJoe Perches 722083bf9c5SJoe Perches ## Filename pattern matching 723083bf9c5SJoe Perches if (($type eq "F" || $type eq "X") && 724083bf9c5SJoe Perches ($self_test eq "" || $self_test =~ /\bpatterns\b/)) { 725083bf9c5SJoe Perches $value =~ s@\.@\\\.@g; ##Convert . to \. 726083bf9c5SJoe Perches $value =~ s/\*/\.\*/g; ##Convert * to .* 727083bf9c5SJoe Perches $value =~ s/\?/\./g; ##Convert ? to . 728083bf9c5SJoe Perches ##if pattern is a directory and it lacks a trailing slash, add one 729083bf9c5SJoe Perches if ((-d $value)) { 730083bf9c5SJoe Perches $value =~ s@([^/])$@$1/@; 731083bf9c5SJoe Perches } 732083bf9c5SJoe Perches if (!grep(m@^$value@, @lsfiles)) { 733083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n"); 734083bf9c5SJoe Perches } 735083bf9c5SJoe Perches 736083bf9c5SJoe Perches ## Link reachability 737083bf9c5SJoe Perches } elsif (($type eq "W" || $type eq "Q" || $type eq "B") && 738083bf9c5SJoe Perches $value =~ /^https?:/ && 739083bf9c5SJoe Perches ($self_test eq "" || $self_test =~ /\blinks\b/)) { 740083bf9c5SJoe Perches next if (grep(m@^\Q$value\E$@, @good_links)); 741083bf9c5SJoe Perches my $isbad = 0; 742083bf9c5SJoe Perches if (grep(m@^\Q$value\E$@, @bad_links)) { 743083bf9c5SJoe Perches $isbad = 1; 744083bf9c5SJoe Perches } else { 745083bf9c5SJoe Perches my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`; 746083bf9c5SJoe Perches if ($? == 0) { 747083bf9c5SJoe Perches push(@good_links, $value); 748083bf9c5SJoe Perches } else { 749083bf9c5SJoe Perches push(@bad_links, $value); 750083bf9c5SJoe Perches $isbad = 1; 751083bf9c5SJoe Perches } 752083bf9c5SJoe Perches } 753083bf9c5SJoe Perches if ($isbad) { 754083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); 755083bf9c5SJoe Perches } 756083bf9c5SJoe Perches 757083bf9c5SJoe Perches ## SCM reachability 758083bf9c5SJoe Perches } elsif ($type eq "T" && 759083bf9c5SJoe Perches ($self_test eq "" || $self_test =~ /\bscm\b/)) { 760083bf9c5SJoe Perches next if (grep(m@^\Q$value\E$@, @good_links)); 761083bf9c5SJoe Perches my $isbad = 0; 762083bf9c5SJoe Perches if (grep(m@^\Q$value\E$@, @bad_links)) { 763083bf9c5SJoe Perches $isbad = 1; 764083bf9c5SJoe Perches } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) { 765083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n"); 766083bf9c5SJoe Perches } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) { 767083bf9c5SJoe Perches my $url = $1; 768083bf9c5SJoe Perches my $branch = ""; 769083bf9c5SJoe Perches $branch = $3 if $3; 770083bf9c5SJoe Perches my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`; 771083bf9c5SJoe Perches if ($? == 0) { 772083bf9c5SJoe Perches push(@good_links, $value); 773083bf9c5SJoe Perches } else { 774083bf9c5SJoe Perches push(@bad_links, $value); 775083bf9c5SJoe Perches $isbad = 1; 776083bf9c5SJoe Perches } 777083bf9c5SJoe Perches } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) { 778083bf9c5SJoe Perches my $url = $1; 779083bf9c5SJoe Perches my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`; 780083bf9c5SJoe Perches if ($? == 0) { 781083bf9c5SJoe Perches push(@good_links, $value); 782083bf9c5SJoe Perches } else { 783083bf9c5SJoe Perches push(@bad_links, $value); 784083bf9c5SJoe Perches $isbad = 1; 785083bf9c5SJoe Perches } 786083bf9c5SJoe Perches } 787083bf9c5SJoe Perches if ($isbad) { 788083bf9c5SJoe Perches print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n"); 789083bf9c5SJoe Perches } 790e1f75904STom Saeger } 791e1f75904STom Saeger } 792e1f75904STom Saeger} 793e1f75904STom Saeger 794435de078SJoe Perchessub ignore_email_address { 795435de078SJoe Perches my ($address) = @_; 796435de078SJoe Perches 797435de078SJoe Perches foreach my $ignore (@ignore_emails) { 798435de078SJoe Perches return 1 if ($ignore eq $address); 799435de078SJoe Perches } 800435de078SJoe Perches 801435de078SJoe Perches return 0; 802435de078SJoe Perches} 803435de078SJoe Perches 804ab6c937dSJoe Perchessub range_is_maintained { 805ab6c937dSJoe Perches my ($start, $end) = @_; 806ab6c937dSJoe Perches 807ab6c937dSJoe Perches for (my $i = $start; $i < $end; $i++) { 808ab6c937dSJoe Perches my $line = $typevalue[$i]; 809ce8155f7SJoe Perches if ($line =~ m/^([A-Z]):\s*(.*)/) { 810ab6c937dSJoe Perches my $type = $1; 811ab6c937dSJoe Perches my $value = $2; 812ab6c937dSJoe Perches if ($type eq 'S') { 813ab6c937dSJoe Perches if ($value =~ /(maintain|support)/i) { 814ab6c937dSJoe Perches return 1; 815ab6c937dSJoe Perches } 816ab6c937dSJoe Perches } 817ab6c937dSJoe Perches } 818ab6c937dSJoe Perches } 819ab6c937dSJoe Perches return 0; 820ab6c937dSJoe Perches} 821ab6c937dSJoe Perches 822ab6c937dSJoe Perchessub range_has_maintainer { 823ab6c937dSJoe Perches my ($start, $end) = @_; 824ab6c937dSJoe Perches 825ab6c937dSJoe Perches for (my $i = $start; $i < $end; $i++) { 826ab6c937dSJoe Perches my $line = $typevalue[$i]; 827ce8155f7SJoe Perches if ($line =~ m/^([A-Z]):\s*(.*)/) { 828ab6c937dSJoe Perches my $type = $1; 829ab6c937dSJoe Perches my $value = $2; 830ab6c937dSJoe Perches if ($type eq 'M') { 831ab6c937dSJoe Perches return 1; 832ab6c937dSJoe Perches } 833ab6c937dSJoe Perches } 834ab6c937dSJoe Perches } 835ab6c937dSJoe Perches return 0; 836ab6c937dSJoe Perches} 837ab6c937dSJoe Perches 8386ef1c52eSJoe Perchessub get_maintainers { 839683c6f8fSJoe Perches %email_hash_name = (); 840683c6f8fSJoe Perches %email_hash_address = (); 841683c6f8fSJoe Perches %commit_author_hash = (); 842683c6f8fSJoe Perches %commit_signer_hash = (); 843683c6f8fSJoe Perches @email_to = (); 844683c6f8fSJoe Perches %hash_list_to = (); 845683c6f8fSJoe Perches @list_to = (); 846683c6f8fSJoe Perches @scm = (); 847683c6f8fSJoe Perches @web = (); 848683c6f8fSJoe Perches @subsystem = (); 849683c6f8fSJoe Perches @status = (); 850b9e2331dSJoe Perches %deduplicate_name_hash = (); 851b9e2331dSJoe Perches %deduplicate_address_hash = (); 852683c6f8fSJoe Perches if ($email_git_all_signature_types) { 853683c6f8fSJoe Perches $signature_pattern = "(.+?)[Bb][Yy]:"; 854683c6f8fSJoe Perches } else { 855683c6f8fSJoe Perches $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 856683c6f8fSJoe Perches } 857cb7301c7SJoe Perches 858cb7301c7SJoe Perches # Find responsible parties 859cb7301c7SJoe Perches 860b9e2331dSJoe Perches my %exact_pattern_match_hash = (); 8616ef1c52eSJoe Perches 862cb7301c7SJoe Perches foreach my $file (@files) { 863cb7301c7SJoe Perches 864272a8979SJoe Perches my %hash; 865272a8979SJoe Perches my $tvi = find_first_section(); 866272a8979SJoe Perches while ($tvi < @typevalue) { 867272a8979SJoe Perches my $start = find_starting_index($tvi); 868272a8979SJoe Perches my $end = find_ending_index($tvi); 869272a8979SJoe Perches my $exclude = 0; 870272a8979SJoe Perches my $i; 871272a8979SJoe Perches 872cb7301c7SJoe Perches #Do not match excluded file patterns 873cb7301c7SJoe Perches 874272a8979SJoe Perches for ($i = $start; $i < $end; $i++) { 875272a8979SJoe Perches my $line = $typevalue[$i]; 876ce8155f7SJoe Perches if ($line =~ m/^([A-Z]):\s*(.*)/) { 877cb7301c7SJoe Perches my $type = $1; 878cb7301c7SJoe Perches my $value = $2; 879cb7301c7SJoe Perches if ($type eq 'X') { 880cb7301c7SJoe Perches if (file_match_pattern($file, $value)) { 881cb7301c7SJoe Perches $exclude = 1; 8823c840c18SJoe Perches last; 883cb7301c7SJoe Perches } 884cb7301c7SJoe Perches } 885cb7301c7SJoe Perches } 886cb7301c7SJoe Perches } 887cb7301c7SJoe Perches 888cb7301c7SJoe Perches if (!$exclude) { 889272a8979SJoe Perches for ($i = $start; $i < $end; $i++) { 890272a8979SJoe Perches my $line = $typevalue[$i]; 891ce8155f7SJoe Perches if ($line =~ m/^([A-Z]):\s*(.*)/) { 892cb7301c7SJoe Perches my $type = $1; 893cb7301c7SJoe Perches my $value = $2; 894cb7301c7SJoe Perches if ($type eq 'F') { 895cb7301c7SJoe Perches if (file_match_pattern($file, $value)) { 8963fb55652SJoe Perches my $value_pd = ($value =~ tr@/@@); 8973fb55652SJoe Perches my $file_pd = ($file =~ tr@/@@); 8983fb55652SJoe Perches $value_pd++ if (substr($value,-1,1) ne "/"); 899e3e9d114SJoe Perches $value_pd = -1 if ($value =~ /^\.\*/); 900ab6c937dSJoe Perches if ($value_pd >= $file_pd && 901ab6c937dSJoe Perches range_is_maintained($start, $end) && 902ab6c937dSJoe Perches range_has_maintainer($start, $end)) { 9036ef1c52eSJoe Perches $exact_pattern_match_hash{$file} = 1; 9046ef1c52eSJoe Perches } 9053fb55652SJoe Perches if ($pattern_depth == 0 || 9063fb55652SJoe Perches (($file_pd - $value_pd) < $pattern_depth)) { 9073fb55652SJoe Perches $hash{$tvi} = $value_pd; 9083fb55652SJoe Perches } 909cb7301c7SJoe Perches } 910bbbe96edSStephen Warren } elsif ($type eq 'N') { 911eb90d085SStephen Warren if ($file =~ m/$value/x) { 912eb90d085SStephen Warren $hash{$tvi} = 0; 913eb90d085SStephen Warren } 914cb7301c7SJoe Perches } 915cb7301c7SJoe Perches } 916cb7301c7SJoe Perches } 917272a8979SJoe Perches } 9183c840c18SJoe Perches $tvi = $end + 1; 919272a8979SJoe Perches } 920272a8979SJoe Perches 9211d606b4eSJoe Perches foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 9221d606b4eSJoe Perches add_categories($line); 9234b76c9daSJoe Perches if ($sections) { 9244b76c9daSJoe Perches my $i; 9254b76c9daSJoe Perches my $start = find_starting_index($line); 9264b76c9daSJoe Perches my $end = find_ending_index($line); 9274b76c9daSJoe Perches for ($i = $start; $i < $end; $i++) { 9284b76c9daSJoe Perches my $line = $typevalue[$i]; 9294b76c9daSJoe Perches if ($line =~ /^[FX]:/) { ##Restore file patterns 9304b76c9daSJoe Perches $line =~ s/([^\\])\.([^\*])/$1\?$2/g; 9314b76c9daSJoe Perches $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ? 9324b76c9daSJoe Perches $line =~ s/\\\./\./g; ##Convert \. to . 9334b76c9daSJoe Perches $line =~ s/\.\*/\*/g; ##Convert .* to * 9344b76c9daSJoe Perches } 93503aed214SJoe Perches my $count = $line =~ s/^([A-Z]):/$1:\t/g; 93603aed214SJoe Perches if ($letters eq "" || (!$count || $letters =~ /$1/i)) { 9374b76c9daSJoe Perches print("$line\n"); 9384b76c9daSJoe Perches } 93903aed214SJoe Perches } 940f11e9a15SJoe Perches print("\n"); 9414b76c9daSJoe Perches } 9421d606b4eSJoe Perches } 9430c78c013SJoe Perches 9440c78c013SJoe Perches maintainers_in_file($file); 945cb7301c7SJoe Perches } 946cb7301c7SJoe Perches 947dcf36a92SJoe Perches if ($keywords) { 948dcf36a92SJoe Perches @keyword_tvi = sort_and_uniq(@keyword_tvi); 949dcf36a92SJoe Perches foreach my $line (@keyword_tvi) { 950dcf36a92SJoe Perches add_categories($line); 951dcf36a92SJoe Perches } 952dcf36a92SJoe Perches } 953dcf36a92SJoe Perches 954b9e2331dSJoe Perches foreach my $email (@email_to, @list_to) { 955b9e2331dSJoe Perches $email->[0] = deduplicate_email($email->[0]); 956b9e2331dSJoe Perches } 9576ef1c52eSJoe Perches 9586ef1c52eSJoe Perches foreach my $file (@files) { 9596ef1c52eSJoe Perches if ($email && 9606343f6b7SJoe Perches ($email_git || 9616343f6b7SJoe Perches ($email_git_fallback && 9626343f6b7SJoe Perches $file !~ /MAINTAINERS$/ && 9636ef1c52eSJoe Perches !$exact_pattern_match_hash{$file}))) { 9646ef1c52eSJoe Perches vcs_file_signoffs($file); 9656ef1c52eSJoe Perches } 9666ef1c52eSJoe Perches if ($email && $email_git_blame) { 9676ef1c52eSJoe Perches vcs_file_blame($file); 9686ef1c52eSJoe Perches } 9696ef1c52eSJoe Perches } 9706ef1c52eSJoe Perches 971f5f5078dSJoe Perches if ($email) { 972cb7301c7SJoe Perches foreach my $chief (@penguin_chief) { 973cb7301c7SJoe Perches if ($chief =~ m/^(.*):(.*)/) { 974f5f5078dSJoe Perches my $email_address; 9750e70e83dSJoe Perches 976a8af2430SJoe Perches $email_address = format_email($1, $2, $email_usename); 977f5f5078dSJoe Perches if ($email_git_penguin_chiefs) { 9783c7385b8SJoe Perches push(@email_to, [$email_address, 'chief penguin']); 979f5f5078dSJoe Perches } else { 9803c7385b8SJoe Perches @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 981cb7301c7SJoe Perches } 982cb7301c7SJoe Perches } 983cb7301c7SJoe Perches } 98403372dbbSJoe Perches 98503372dbbSJoe Perches foreach my $email (@file_emails) { 986*11fb4896SRob Herring $email = mailmap_email($email); 98703372dbbSJoe Perches my ($name, $address) = parse_email($email); 98803372dbbSJoe Perches 98903372dbbSJoe Perches my $tmp_email = format_email($name, $address, $email_usename); 99003372dbbSJoe Perches push_email_address($tmp_email, ''); 99103372dbbSJoe Perches add_role($tmp_email, 'in file'); 99203372dbbSJoe Perches } 993cb7301c7SJoe Perches } 994cb7301c7SJoe Perches 9950ef82fceSDouglas Anderson foreach my $fix (@fixes) { 9960ef82fceSDouglas Anderson vcs_add_commit_signers($fix, "blamed_fixes"); 9970ef82fceSDouglas Anderson } 9980ef82fceSDouglas Anderson 999290603c1SJoe Perches my @to = (); 1000683c6f8fSJoe Perches if ($email || $email_list) { 1001cb7301c7SJoe Perches if ($email) { 1002290603c1SJoe Perches @to = (@to, @email_to); 1003cb7301c7SJoe Perches } 1004290603c1SJoe Perches if ($email_list) { 1005290603c1SJoe Perches @to = (@to, @list_to); 1006290603c1SJoe Perches } 1007cb7301c7SJoe Perches } 1008cb7301c7SJoe Perches 10096ef1c52eSJoe Perches if ($interactive) { 1010b9e2331dSJoe Perches @to = interactive_get_maintainers(\@to); 10116ef1c52eSJoe Perches } 1012cb7301c7SJoe Perches 1013683c6f8fSJoe Perches return @to; 1014cb7301c7SJoe Perches} 1015cb7301c7SJoe Perches 1016cb7301c7SJoe Perchessub file_match_pattern { 1017cb7301c7SJoe Perches my ($file, $pattern) = @_; 1018cb7301c7SJoe Perches if (substr($pattern, -1) eq "/") { 1019cb7301c7SJoe Perches if ($file =~ m@^$pattern@) { 1020cb7301c7SJoe Perches return 1; 1021cb7301c7SJoe Perches } 1022cb7301c7SJoe Perches } else { 1023cb7301c7SJoe Perches if ($file =~ m@^$pattern@) { 1024cb7301c7SJoe Perches my $s1 = ($file =~ tr@/@@); 1025cb7301c7SJoe Perches my $s2 = ($pattern =~ tr@/@@); 1026cb7301c7SJoe Perches if ($s1 == $s2) { 1027cb7301c7SJoe Perches return 1; 1028cb7301c7SJoe Perches } 1029cb7301c7SJoe Perches } 1030cb7301c7SJoe Perches } 1031cb7301c7SJoe Perches return 0; 1032cb7301c7SJoe Perches} 1033cb7301c7SJoe Perches 1034cb7301c7SJoe Perchessub usage { 1035cb7301c7SJoe Perches print <<EOT; 1036cb7301c7SJoe Perchesusage: $P [options] patchfile 1037870020f9SJoe Perches $P [options] -f file|directory 1038cb7301c7SJoe Perchesversion: $V 1039cb7301c7SJoe Perches 1040cb7301c7SJoe PerchesMAINTAINER field selection options: 1041cb7301c7SJoe Perches --email => print email address(es) if any 1042cb7301c7SJoe Perches --git => include recent git \*-by: signers 1043e4d26b02SJoe Perches --git-all-signature-types => include signers regardless of signature type 1044683c6f8fSJoe Perches or use only ${signature_pattern} signers (default: $email_git_all_signature_types) 1045e3e9d114SJoe Perches --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback) 1046cb7301c7SJoe Perches --git-chief-penguins => include ${penguin_chiefs} 1047e4d26b02SJoe Perches --git-min-signatures => number of signatures required (default: $email_git_min_signatures) 1048e4d26b02SJoe Perches --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers) 1049e4d26b02SJoe Perches --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent) 1050f5492666SJoe Perches --git-blame => use git blame to find modified commits for patch or file 10513cbcca8aSBrian Norris --git-blame-signatures => when used with --git-blame, also include all commit signers 1052e4d26b02SJoe Perches --git-since => git history to use (default: $email_git_since) 1053e4d26b02SJoe Perches --hg-since => hg history to use (default: $email_hg_since) 1054dace8e30SFlorian Mickler --interactive => display a menu (mostly useful if used with the --git option) 1055cb7301c7SJoe Perches --m => include maintainer(s) if any 1056c1c3f2c9SJoe Perches --r => include reviewer(s) if any 1057cb7301c7SJoe Perches --n => include name 'Full Name <addr\@domain.tld>' 1058cb7301c7SJoe Perches --l => include list(s) if any 105949662503SJoe Perches --moderated => include moderated lists(s) if any (default: true) 106049662503SJoe Perches --s => include subscriber only list(s) if any (default: false) 106111ecf53cSJoe Perches --remove-duplicates => minimize duplicate email names/addresses 10623c7385b8SJoe Perches --roles => show roles (status:subsystem, git-signer, list, etc...) 10633c7385b8SJoe Perches --rolestats => show roles and statistics (commits/total_commits, %) 106403372dbbSJoe Perches --file-emails => add email addresses found in -f file (default: 0 (off)) 10652f5bd343SJoe Perches --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on)) 1066cb7301c7SJoe Perches --scm => print SCM tree(s) if any 1067cb7301c7SJoe Perches --status => print status if any 1068cb7301c7SJoe Perches --subsystem => print subsystem name if any 1069cb7301c7SJoe Perches --web => print website(s) if any 1070cb7301c7SJoe Perches 1071cb7301c7SJoe PerchesOutput type options: 1072cb7301c7SJoe Perches --separator [, ] => separator for multiple entries on 1 line 107342498316SJoe Perches using --separator also sets --nomultiline if --separator is not [, ] 1074cb7301c7SJoe Perches --multiline => print 1 entry per line 1075cb7301c7SJoe Perches 1076cb7301c7SJoe PerchesOther options: 10773fb55652SJoe Perches --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 1078b9e2331dSJoe Perches --keywords => scan patch for keywords (default: $keywords) 1079b9e2331dSJoe Perches --sections => print all of the subsystem sections with pattern matches 108003aed214SJoe Perches --letters => print all matching 'letter' types from all matching sections 1081b9e2331dSJoe Perches --mailmap => use .mailmap file (default: $email_use_mailmap) 108231bb82c9SAntonio Nino Diaz --no-tree => run without a kernel tree 1083e1f75904STom Saeger --self-test => show potential issues with MAINTAINERS file content 1084f5f5078dSJoe Perches --version => show version 1085cb7301c7SJoe Perches --help => show this help information 1086cb7301c7SJoe Perches 10873fb55652SJoe PerchesDefault options: 108831bb82c9SAntonio Nino Diaz [--email --tree --nogit --git-fallback --m --r --n --l --multiline 108931bb82c9SAntonio Nino Diaz --pattern-depth=0 --remove-duplicates --rolestats] 10903fb55652SJoe Perches 1091870020f9SJoe PerchesNotes: 1092870020f9SJoe Perches Using "-f directory" may give unexpected results: 1093870020f9SJoe Perches Used with "--git", git signators for _all_ files in and below 1094870020f9SJoe Perches directory are examined as git recurses directories. 1095870020f9SJoe Perches Any specified X: (exclude) pattern matches are _not_ ignored. 1096870020f9SJoe Perches Used with "--nogit", directory is used as a pattern match, 1097870020f9SJoe Perches no individual file within the directory or subdirectory 1098870020f9SJoe Perches is matched. 1099f5492666SJoe Perches Used with "--git-blame", does not iterate all files in directory 1100f5492666SJoe Perches Using "--git-blame" is slow and may add old committers and authors 1101f5492666SJoe Perches that are no longer active maintainers to the output. 11023c7385b8SJoe Perches Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 11033c7385b8SJoe Perches other automated tools that expect only ["name"] <email address> 11043c7385b8SJoe Perches may not work because of additional output after <email address>. 11053c7385b8SJoe Perches Using "--rolestats" and "--git-blame" shows the #/total=% commits, 11063c7385b8SJoe Perches not the percentage of the entire file authored. # of commits is 11073c7385b8SJoe Perches not a good measure of amount of code authored. 1 major commit may 11083c7385b8SJoe Perches contain a thousand lines, 5 trivial commits may modify a single line. 110960db31acSJoe Perches If git is not installed, but mercurial (hg) is installed and an .hg 111060db31acSJoe Perches repository exists, the following options apply to mercurial: 111160db31acSJoe Perches --git, 111260db31acSJoe Perches --git-min-signatures, --git-max-maintainers, --git-min-percent, and 111360db31acSJoe Perches --git-blame 111460db31acSJoe Perches Use --hg-since not --git-since to control date selection 1115368669daSJoe Perches File ".get_maintainer.conf", if it exists in the linux kernel source root 1116368669daSJoe Perches directory, can change whatever get_maintainer defaults are desired. 1117368669daSJoe Perches Entries in this file can be any command line argument. 1118368669daSJoe Perches This file is prepended to any additional command line arguments. 1119368669daSJoe Perches Multiple lines and # comments are allowed. 1120b1312bfeSBrian Norris Most options have both positive and negative forms. 1121b1312bfeSBrian Norris The negative forms for --<foo> are --no<foo> and --no-<foo>. 1122b1312bfeSBrian Norris 1123cb7301c7SJoe PerchesEOT 1124cb7301c7SJoe Perches} 1125cb7301c7SJoe Perches 1126cb7301c7SJoe Perchessub top_of_kernel_tree { 1127cb7301c7SJoe Perches my ($lk_path) = @_; 1128cb7301c7SJoe Perches 1129cb7301c7SJoe Perches if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 1130cb7301c7SJoe Perches $lk_path .= "/"; 1131cb7301c7SJoe Perches } 1132cb7301c7SJoe Perches if ( (-f "${lk_path}COPYING") 1133cb7301c7SJoe Perches && (-f "${lk_path}CREDITS") 1134cb7301c7SJoe Perches && (-f "${lk_path}Kbuild") 11356f7d98ecSJoe Perches && (-e "${lk_path}MAINTAINERS") 1136cb7301c7SJoe Perches && (-f "${lk_path}Makefile") 1137cb7301c7SJoe Perches && (-f "${lk_path}README") 1138cb7301c7SJoe Perches && (-d "${lk_path}Documentation") 1139cb7301c7SJoe Perches && (-d "${lk_path}arch") 1140cb7301c7SJoe Perches && (-d "${lk_path}include") 1141cb7301c7SJoe Perches && (-d "${lk_path}drivers") 1142cb7301c7SJoe Perches && (-d "${lk_path}fs") 1143cb7301c7SJoe Perches && (-d "${lk_path}init") 1144cb7301c7SJoe Perches && (-d "${lk_path}ipc") 1145cb7301c7SJoe Perches && (-d "${lk_path}kernel") 1146cb7301c7SJoe Perches && (-d "${lk_path}lib") 1147cb7301c7SJoe Perches && (-d "${lk_path}scripts")) { 1148cb7301c7SJoe Perches return 1; 1149cb7301c7SJoe Perches } 1150cb7301c7SJoe Perches return 0; 1151cb7301c7SJoe Perches} 1152cb7301c7SJoe Perches 11530e70e83dSJoe Perchessub parse_email { 11540e70e83dSJoe Perches my ($formatted_email) = @_; 11550e70e83dSJoe Perches 11560e70e83dSJoe Perches my $name = ""; 11570e70e83dSJoe Perches my $address = ""; 11580e70e83dSJoe Perches 115911ecf53cSJoe Perches if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 11600e70e83dSJoe Perches $name = $1; 11610e70e83dSJoe Perches $address = $2; 116211ecf53cSJoe Perches } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 11630e70e83dSJoe Perches $address = $1; 1164b781655aSJoe Perches } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 11650e70e83dSJoe Perches $address = $1; 11660e70e83dSJoe Perches } 1167cb7301c7SJoe Perches 1168cb7301c7SJoe Perches $name =~ s/^\s+|\s+$//g; 1169d789504aSJoe Perches $name =~ s/^\"|\"$//g; 11700e70e83dSJoe Perches $address =~ s/^\s+|\s+$//g; 1171cb7301c7SJoe Perches 1172a63ceb4cSStephen Hemminger if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 1173cb7301c7SJoe Perches $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 11740e70e83dSJoe Perches $name = "\"$name\""; 1175cb7301c7SJoe Perches } 11760e70e83dSJoe Perches 11770e70e83dSJoe Perches return ($name, $address); 11780e70e83dSJoe Perches} 11790e70e83dSJoe Perches 11800e70e83dSJoe Perchessub format_email { 1181a8af2430SJoe Perches my ($name, $address, $usename) = @_; 11820e70e83dSJoe Perches 11830e70e83dSJoe Perches my $formatted_email; 11840e70e83dSJoe Perches 11850e70e83dSJoe Perches $name =~ s/^\s+|\s+$//g; 11860e70e83dSJoe Perches $name =~ s/^\"|\"$//g; 11870e70e83dSJoe Perches $address =~ s/^\s+|\s+$//g; 11880e70e83dSJoe Perches 1189a63ceb4cSStephen Hemminger if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 11900e70e83dSJoe Perches $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 11910e70e83dSJoe Perches $name = "\"$name\""; 11920e70e83dSJoe Perches } 11930e70e83dSJoe Perches 1194a8af2430SJoe Perches if ($usename) { 11950e70e83dSJoe Perches if ("$name" eq "") { 11960e70e83dSJoe Perches $formatted_email = "$address"; 11970e70e83dSJoe Perches } else { 1198a8af2430SJoe Perches $formatted_email = "$name <$address>"; 11990e70e83dSJoe Perches } 12000e70e83dSJoe Perches } else { 12010e70e83dSJoe Perches $formatted_email = $address; 12020e70e83dSJoe Perches } 12030e70e83dSJoe Perches 1204cb7301c7SJoe Perches return $formatted_email; 1205cb7301c7SJoe Perches} 1206cb7301c7SJoe Perches 1207272a8979SJoe Perchessub find_first_section { 1208272a8979SJoe Perches my $index = 0; 1209272a8979SJoe Perches 1210272a8979SJoe Perches while ($index < @typevalue) { 1211272a8979SJoe Perches my $tv = $typevalue[$index]; 1212ce8155f7SJoe Perches if (($tv =~ m/^([A-Z]):\s*(.*)/)) { 1213272a8979SJoe Perches last; 1214272a8979SJoe Perches } 1215272a8979SJoe Perches $index++; 1216272a8979SJoe Perches } 1217272a8979SJoe Perches 1218272a8979SJoe Perches return $index; 1219272a8979SJoe Perches} 1220272a8979SJoe Perches 1221b781655aSJoe Perchessub find_starting_index { 1222b781655aSJoe Perches my ($index) = @_; 1223b781655aSJoe Perches 1224b781655aSJoe Perches while ($index > 0) { 1225b781655aSJoe Perches my $tv = $typevalue[$index]; 1226ce8155f7SJoe Perches if (!($tv =~ m/^([A-Z]):\s*(.*)/)) { 1227b781655aSJoe Perches last; 1228b781655aSJoe Perches } 1229b781655aSJoe Perches $index--; 1230b781655aSJoe Perches } 1231b781655aSJoe Perches 1232b781655aSJoe Perches return $index; 1233b781655aSJoe Perches} 1234b781655aSJoe Perches 1235b781655aSJoe Perchessub find_ending_index { 1236b781655aSJoe Perches my ($index) = @_; 1237b781655aSJoe Perches 1238b781655aSJoe Perches while ($index < @typevalue) { 1239b781655aSJoe Perches my $tv = $typevalue[$index]; 1240ce8155f7SJoe Perches if (!($tv =~ m/^([A-Z]):\s*(.*)/)) { 1241b781655aSJoe Perches last; 1242b781655aSJoe Perches } 1243b781655aSJoe Perches $index++; 1244b781655aSJoe Perches } 1245b781655aSJoe Perches 1246b781655aSJoe Perches return $index; 1247b781655aSJoe Perches} 1248b781655aSJoe Perches 12492a7cb1dcSJoe Perchessub get_subsystem_name { 12502a7cb1dcSJoe Perches my ($index) = @_; 12512a7cb1dcSJoe Perches 12522a7cb1dcSJoe Perches my $start = find_starting_index($index); 12532a7cb1dcSJoe Perches 12542a7cb1dcSJoe Perches my $subsystem = $typevalue[$start]; 12552a7cb1dcSJoe Perches if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) { 12562a7cb1dcSJoe Perches $subsystem = substr($subsystem, 0, $output_section_maxlen - 3); 12572a7cb1dcSJoe Perches $subsystem =~ s/\s*$//; 12582a7cb1dcSJoe Perches $subsystem = $subsystem . "..."; 12592a7cb1dcSJoe Perches } 12602a7cb1dcSJoe Perches return $subsystem; 12612a7cb1dcSJoe Perches} 12622a7cb1dcSJoe Perches 12633c7385b8SJoe Perchessub get_maintainer_role { 12643c7385b8SJoe Perches my ($index) = @_; 12653c7385b8SJoe Perches 12663c7385b8SJoe Perches my $i; 12673c7385b8SJoe Perches my $start = find_starting_index($index); 12683c7385b8SJoe Perches my $end = find_ending_index($index); 12693c7385b8SJoe Perches 12700ede2745SJoe Perches my $role = "unknown"; 12712a7cb1dcSJoe Perches my $subsystem = get_subsystem_name($index); 12723c7385b8SJoe Perches 12733c7385b8SJoe Perches for ($i = $start + 1; $i < $end; $i++) { 12743c7385b8SJoe Perches my $tv = $typevalue[$i]; 1275ce8155f7SJoe Perches if ($tv =~ m/^([A-Z]):\s*(.*)/) { 12763c7385b8SJoe Perches my $ptype = $1; 12773c7385b8SJoe Perches my $pvalue = $2; 12783c7385b8SJoe Perches if ($ptype eq "S") { 12793c7385b8SJoe Perches $role = $pvalue; 12803c7385b8SJoe Perches } 12813c7385b8SJoe Perches } 12823c7385b8SJoe Perches } 12833c7385b8SJoe Perches 12843c7385b8SJoe Perches $role = lc($role); 12853c7385b8SJoe Perches if ($role eq "supported") { 12863c7385b8SJoe Perches $role = "supporter"; 12873c7385b8SJoe Perches } elsif ($role eq "maintained") { 12883c7385b8SJoe Perches $role = "maintainer"; 12893c7385b8SJoe Perches } elsif ($role eq "odd fixes") { 12903c7385b8SJoe Perches $role = "odd fixer"; 12913c7385b8SJoe Perches } elsif ($role eq "orphan") { 12923c7385b8SJoe Perches $role = "orphan minder"; 12933c7385b8SJoe Perches } elsif ($role eq "obsolete") { 12943c7385b8SJoe Perches $role = "obsolete minder"; 12953c7385b8SJoe Perches } elsif ($role eq "buried alive in reporters") { 12963c7385b8SJoe Perches $role = "chief penguin"; 12973c7385b8SJoe Perches } 12983c7385b8SJoe Perches 12993c7385b8SJoe Perches return $role . ":" . $subsystem; 13003c7385b8SJoe Perches} 13013c7385b8SJoe Perches 13023c7385b8SJoe Perchessub get_list_role { 13033c7385b8SJoe Perches my ($index) = @_; 13043c7385b8SJoe Perches 13052a7cb1dcSJoe Perches my $subsystem = get_subsystem_name($index); 13063c7385b8SJoe Perches 13073c7385b8SJoe Perches if ($subsystem eq "THE REST") { 13083c7385b8SJoe Perches $subsystem = ""; 13093c7385b8SJoe Perches } 13103c7385b8SJoe Perches 13113c7385b8SJoe Perches return $subsystem; 13123c7385b8SJoe Perches} 13133c7385b8SJoe Perches 1314cb7301c7SJoe Perchessub add_categories { 1315cb7301c7SJoe Perches my ($index) = @_; 1316cb7301c7SJoe Perches 1317b781655aSJoe Perches my $i; 1318b781655aSJoe Perches my $start = find_starting_index($index); 1319b781655aSJoe Perches my $end = find_ending_index($index); 1320b781655aSJoe Perches 1321b781655aSJoe Perches push(@subsystem, $typevalue[$start]); 1322b781655aSJoe Perches 1323b781655aSJoe Perches for ($i = $start + 1; $i < $end; $i++) { 1324b781655aSJoe Perches my $tv = $typevalue[$i]; 1325ce8155f7SJoe Perches if ($tv =~ m/^([A-Z]):\s*(.*)/) { 1326cb7301c7SJoe Perches my $ptype = $1; 1327cb7301c7SJoe Perches my $pvalue = $2; 1328cb7301c7SJoe Perches if ($ptype eq "L") { 1329290603c1SJoe Perches my $list_address = $pvalue; 1330290603c1SJoe Perches my $list_additional = ""; 13313c7385b8SJoe Perches my $list_role = get_list_role($i); 13323c7385b8SJoe Perches 13333c7385b8SJoe Perches if ($list_role ne "") { 13343c7385b8SJoe Perches $list_role = ":" . $list_role; 13353c7385b8SJoe Perches } 1336290603c1SJoe Perches if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 1337290603c1SJoe Perches $list_address = $1; 1338290603c1SJoe Perches $list_additional = $2; 1339290603c1SJoe Perches } 1340bdf7c685SJoe Perches if ($list_additional =~ m/subscribers-only/) { 1341cb7301c7SJoe Perches if ($email_subscriber_list) { 13426ef1c52eSJoe Perches if (!$hash_list_to{lc($list_address)}) { 13436ef1c52eSJoe Perches $hash_list_to{lc($list_address)} = 1; 1344683c6f8fSJoe Perches push(@list_to, [$list_address, 1345683c6f8fSJoe Perches "subscriber list${list_role}"]); 1346683c6f8fSJoe Perches } 1347cb7301c7SJoe Perches } 1348cb7301c7SJoe Perches } else { 1349cb7301c7SJoe Perches if ($email_list) { 13506ef1c52eSJoe Perches if (!$hash_list_to{lc($list_address)}) { 1351728f5a94SRichard Weinberger if ($list_additional =~ m/moderated/) { 135249662503SJoe Perches if ($email_moderated_list) { 135349662503SJoe Perches $hash_list_to{lc($list_address)} = 1; 1354728f5a94SRichard Weinberger push(@list_to, [$list_address, 1355728f5a94SRichard Weinberger "moderated list${list_role}"]); 135649662503SJoe Perches } 1357728f5a94SRichard Weinberger } else { 135849662503SJoe Perches $hash_list_to{lc($list_address)} = 1; 1359683c6f8fSJoe Perches push(@list_to, [$list_address, 1360683c6f8fSJoe Perches "open list${list_role}"]); 1361683c6f8fSJoe Perches } 1362cb7301c7SJoe Perches } 1363cb7301c7SJoe Perches } 1364728f5a94SRichard Weinberger } 1365cb7301c7SJoe Perches } elsif ($ptype eq "M") { 13660e70e83dSJoe Perches if ($email_maintainer) { 13673c7385b8SJoe Perches my $role = get_maintainer_role($i); 13683c7385b8SJoe Perches push_email_addresses($pvalue, $role); 1369cb7301c7SJoe Perches } 1370c1c3f2c9SJoe Perches } elsif ($ptype eq "R") { 1371c1c3f2c9SJoe Perches if ($email_reviewer) { 13722a7cb1dcSJoe Perches my $subsystem = get_subsystem_name($i); 13732a7cb1dcSJoe Perches push_email_addresses($pvalue, "reviewer:$subsystem"); 1374c1c3f2c9SJoe Perches } 1375cb7301c7SJoe Perches } elsif ($ptype eq "T") { 1376cb7301c7SJoe Perches push(@scm, $pvalue); 1377cb7301c7SJoe Perches } elsif ($ptype eq "W") { 1378cb7301c7SJoe Perches push(@web, $pvalue); 1379cb7301c7SJoe Perches } elsif ($ptype eq "S") { 1380cb7301c7SJoe Perches push(@status, $pvalue); 1381cb7301c7SJoe Perches } 1382cb7301c7SJoe Perches } 1383cb7301c7SJoe Perches } 1384cb7301c7SJoe Perches} 1385cb7301c7SJoe Perches 138611ecf53cSJoe Perchessub email_inuse { 138711ecf53cSJoe Perches my ($name, $address) = @_; 13880e70e83dSJoe Perches 138911ecf53cSJoe Perches return 1 if (($name eq "") && ($address eq "")); 13906ef1c52eSJoe Perches return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 13916ef1c52eSJoe Perches return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 139211ecf53cSJoe Perches 13930e70e83dSJoe Perches return 0; 13940e70e83dSJoe Perches} 13950e70e83dSJoe Perches 13961b5e1cf6SJoe Perchessub push_email_address { 13973c7385b8SJoe Perches my ($line, $role) = @_; 13981b5e1cf6SJoe Perches 13990e70e83dSJoe Perches my ($name, $address) = parse_email($line); 1400f5492666SJoe Perches 1401b781655aSJoe Perches if ($address eq "") { 1402b781655aSJoe Perches return 0; 1403b781655aSJoe Perches } 1404b781655aSJoe Perches 140511ecf53cSJoe Perches if (!$email_remove_duplicates) { 1406a8af2430SJoe Perches push(@email_to, [format_email($name, $address, $email_usename), $role]); 140711ecf53cSJoe Perches } elsif (!email_inuse($name, $address)) { 1408a8af2430SJoe Perches push(@email_to, [format_email($name, $address, $email_usename), $role]); 1409fae99206SJoe Perches $email_hash_name{lc($name)}++ if ($name ne ""); 14106ef1c52eSJoe Perches $email_hash_address{lc($address)}++; 14111b5e1cf6SJoe Perches } 1412b781655aSJoe Perches 1413b781655aSJoe Perches return 1; 14140a79c492SJoe Perches} 14151b5e1cf6SJoe Perches 14161b5e1cf6SJoe Perchessub push_email_addresses { 14173c7385b8SJoe Perches my ($address, $role) = @_; 14181b5e1cf6SJoe Perches 14191b5e1cf6SJoe Perches my @address_list = (); 14201b5e1cf6SJoe Perches 14215f2441e9SJoe Perches if (rfc822_valid($address)) { 14223c7385b8SJoe Perches push_email_address($address, $role); 14235f2441e9SJoe Perches } elsif (@address_list = rfc822_validlist($address)) { 14241b5e1cf6SJoe Perches my $array_count = shift(@address_list); 14251b5e1cf6SJoe Perches while (my $entry = shift(@address_list)) { 14263c7385b8SJoe Perches push_email_address($entry, $role); 14271b5e1cf6SJoe Perches } 14285f2441e9SJoe Perches } else { 14293c7385b8SJoe Perches if (!push_email_address($address, $role)) { 14305f2441e9SJoe Perches warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 14311b5e1cf6SJoe Perches } 14321b5e1cf6SJoe Perches } 1433b781655aSJoe Perches} 14341b5e1cf6SJoe Perches 14353c7385b8SJoe Perchessub add_role { 14363c7385b8SJoe Perches my ($line, $role) = @_; 14373c7385b8SJoe Perches 14383c7385b8SJoe Perches my ($name, $address) = parse_email($line); 1439a8af2430SJoe Perches my $email = format_email($name, $address, $email_usename); 14403c7385b8SJoe Perches 14413c7385b8SJoe Perches foreach my $entry (@email_to) { 14423c7385b8SJoe Perches if ($email_remove_duplicates) { 14433c7385b8SJoe Perches my ($entry_name, $entry_address) = parse_email($entry->[0]); 144403372dbbSJoe Perches if (($name eq $entry_name || $address eq $entry_address) 144503372dbbSJoe Perches && ($role eq "" || !($entry->[1] =~ m/$role/)) 144603372dbbSJoe Perches ) { 14473c7385b8SJoe Perches if ($entry->[1] eq "") { 14483c7385b8SJoe Perches $entry->[1] = "$role"; 14493c7385b8SJoe Perches } else { 14503c7385b8SJoe Perches $entry->[1] = "$entry->[1],$role"; 14513c7385b8SJoe Perches } 14523c7385b8SJoe Perches } 14533c7385b8SJoe Perches } else { 145403372dbbSJoe Perches if ($email eq $entry->[0] 145503372dbbSJoe Perches && ($role eq "" || !($entry->[1] =~ m/$role/)) 145603372dbbSJoe Perches ) { 14573c7385b8SJoe Perches if ($entry->[1] eq "") { 14583c7385b8SJoe Perches $entry->[1] = "$role"; 14593c7385b8SJoe Perches } else { 14603c7385b8SJoe Perches $entry->[1] = "$entry->[1],$role"; 14613c7385b8SJoe Perches } 14623c7385b8SJoe Perches } 14633c7385b8SJoe Perches } 14643c7385b8SJoe Perches } 14653c7385b8SJoe Perches} 14663c7385b8SJoe Perches 1467cb7301c7SJoe Perchessub which { 1468cb7301c7SJoe Perches my ($bin) = @_; 1469cb7301c7SJoe Perches 1470f5f5078dSJoe Perches foreach my $path (split(/:/, $ENV{PATH})) { 1471cb7301c7SJoe Perches if (-e "$path/$bin") { 1472cb7301c7SJoe Perches return "$path/$bin"; 1473cb7301c7SJoe Perches } 1474cb7301c7SJoe Perches } 1475cb7301c7SJoe Perches 1476cb7301c7SJoe Perches return ""; 1477cb7301c7SJoe Perches} 1478cb7301c7SJoe Perches 1479bcde44edSJoe Perchessub which_conf { 1480bcde44edSJoe Perches my ($conf) = @_; 1481bcde44edSJoe Perches 1482bcde44edSJoe Perches foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1483bcde44edSJoe Perches if (-e "$path/$conf") { 1484bcde44edSJoe Perches return "$path/$conf"; 1485bcde44edSJoe Perches } 1486bcde44edSJoe Perches } 1487bcde44edSJoe Perches 1488bcde44edSJoe Perches return ""; 1489bcde44edSJoe Perches} 1490bcde44edSJoe Perches 14917fa8ff2eSFlorian Micklersub mailmap_email { 1492b9e2331dSJoe Perches my ($line) = @_; 14938cbb3a77SJoe Perches 14948cbb3a77SJoe Perches my ($name, $address) = parse_email($line); 14957fa8ff2eSFlorian Mickler my $email = format_email($name, $address, 1); 14967fa8ff2eSFlorian Mickler my $real_name = $name; 14977fa8ff2eSFlorian Mickler my $real_address = $address; 14987fa8ff2eSFlorian Mickler 149947abc722SJoe Perches if (exists $mailmap->{names}->{$email} || 150047abc722SJoe Perches exists $mailmap->{addresses}->{$email}) { 15017fa8ff2eSFlorian Mickler if (exists $mailmap->{names}->{$email}) { 15027fa8ff2eSFlorian Mickler $real_name = $mailmap->{names}->{$email}; 15038cbb3a77SJoe Perches } 15047fa8ff2eSFlorian Mickler if (exists $mailmap->{addresses}->{$email}) { 15057fa8ff2eSFlorian Mickler $real_address = $mailmap->{addresses}->{$email}; 15067fa8ff2eSFlorian Mickler } 15077fa8ff2eSFlorian Mickler } else { 15087fa8ff2eSFlorian Mickler if (exists $mailmap->{names}->{$address}) { 15097fa8ff2eSFlorian Mickler $real_name = $mailmap->{names}->{$address}; 15107fa8ff2eSFlorian Mickler } 15117fa8ff2eSFlorian Mickler if (exists $mailmap->{addresses}->{$address}) { 15127fa8ff2eSFlorian Mickler $real_address = $mailmap->{addresses}->{$address}; 15138cbb3a77SJoe Perches } 15148cbb3a77SJoe Perches } 15157fa8ff2eSFlorian Mickler return format_email($real_name, $real_address, 1); 15167fa8ff2eSFlorian Mickler} 15177fa8ff2eSFlorian Mickler 15187fa8ff2eSFlorian Micklersub mailmap { 15197fa8ff2eSFlorian Mickler my (@addresses) = @_; 15207fa8ff2eSFlorian Mickler 1521b9e2331dSJoe Perches my @mapped_emails = (); 15227fa8ff2eSFlorian Mickler foreach my $line (@addresses) { 1523b9e2331dSJoe Perches push(@mapped_emails, mailmap_email($line)); 15247fa8ff2eSFlorian Mickler } 1525b9e2331dSJoe Perches merge_by_realname(@mapped_emails) if ($email_use_mailmap); 1526b9e2331dSJoe Perches return @mapped_emails; 15277fa8ff2eSFlorian Mickler} 15287fa8ff2eSFlorian Mickler 15297fa8ff2eSFlorian Micklersub merge_by_realname { 15307fa8ff2eSFlorian Mickler my %address_map; 15317fa8ff2eSFlorian Mickler my (@emails) = @_; 1532b9e2331dSJoe Perches 15337fa8ff2eSFlorian Mickler foreach my $email (@emails) { 15347fa8ff2eSFlorian Mickler my ($name, $address) = parse_email($email); 1535b9e2331dSJoe Perches if (exists $address_map{$name}) { 15367fa8ff2eSFlorian Mickler $address = $address_map{$name}; 15377fa8ff2eSFlorian Mickler $email = format_email($name, $address, 1); 1538b9e2331dSJoe Perches } else { 1539b9e2331dSJoe Perches $address_map{$name} = $address; 15408cbb3a77SJoe Perches } 15418cbb3a77SJoe Perches } 15428cbb3a77SJoe Perches} 15438cbb3a77SJoe Perches 154460db31acSJoe Perchessub git_execute_cmd { 1545a8af2430SJoe Perches my ($cmd) = @_; 154660db31acSJoe Perches my @lines = (); 1547a8af2430SJoe Perches 154860db31acSJoe Perches my $output = `$cmd`; 154960db31acSJoe Perches $output =~ s/^\s*//gm; 155060db31acSJoe Perches @lines = split("\n", $output); 155160db31acSJoe Perches 155260db31acSJoe Perches return @lines; 155360db31acSJoe Perches} 155460db31acSJoe Perches 155560db31acSJoe Perchessub hg_execute_cmd { 155660db31acSJoe Perches my ($cmd) = @_; 155760db31acSJoe Perches my @lines = (); 155860db31acSJoe Perches 155960db31acSJoe Perches my $output = `$cmd`; 156060db31acSJoe Perches @lines = split("\n", $output); 156160db31acSJoe Perches 156260db31acSJoe Perches return @lines; 156360db31acSJoe Perches} 156460db31acSJoe Perches 1565683c6f8fSJoe Perchessub extract_formatted_signatures { 1566683c6f8fSJoe Perches my (@signature_lines) = @_; 1567683c6f8fSJoe Perches 1568683c6f8fSJoe Perches my @type = @signature_lines; 1569683c6f8fSJoe Perches 1570683c6f8fSJoe Perches s/\s*(.*):.*/$1/ for (@type); 1571683c6f8fSJoe Perches 1572683c6f8fSJoe Perches # cut -f2- -d":" 1573683c6f8fSJoe Perches s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1574683c6f8fSJoe Perches 1575683c6f8fSJoe Perches## Reformat email addresses (with names) to avoid badly written signatures 1576683c6f8fSJoe Perches 1577683c6f8fSJoe Perches foreach my $signer (@signature_lines) { 1578b9e2331dSJoe Perches $signer = deduplicate_email($signer); 1579683c6f8fSJoe Perches } 1580683c6f8fSJoe Perches 1581683c6f8fSJoe Perches return (\@type, \@signature_lines); 1582683c6f8fSJoe Perches} 1583683c6f8fSJoe Perches 158460db31acSJoe Perchessub vcs_find_signers { 1585c9ecefeaSJoe Perches my ($cmd, $file) = @_; 1586a8af2430SJoe Perches my $commits; 1587683c6f8fSJoe Perches my @lines = (); 1588683c6f8fSJoe Perches my @signatures = (); 1589c9ecefeaSJoe Perches my @authors = (); 1590c9ecefeaSJoe Perches my @stats = (); 1591a8af2430SJoe Perches 159260db31acSJoe Perches @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1593cb7301c7SJoe Perches 159460db31acSJoe Perches my $pattern = $VCS_cmds{"commit_pattern"}; 1595c9ecefeaSJoe Perches my $author_pattern = $VCS_cmds{"author_pattern"}; 1596c9ecefeaSJoe Perches my $stat_pattern = $VCS_cmds{"stat_pattern"}; 1597c9ecefeaSJoe Perches 1598c9ecefeaSJoe Perches $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern 1599cb7301c7SJoe Perches 160060db31acSJoe Perches $commits = grep(/$pattern/, @lines); # of commits 1601afa81ee1SJoe Perches 1602c9ecefeaSJoe Perches @authors = grep(/$author_pattern/, @lines); 1603683c6f8fSJoe Perches @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1604c9ecefeaSJoe Perches @stats = grep(/$stat_pattern/, @lines); 1605683c6f8fSJoe Perches 1606c9ecefeaSJoe Perches# print("stats: <@stats>\n"); 1607c9ecefeaSJoe Perches 1608c9ecefeaSJoe Perches return (0, \@signatures, \@authors, \@stats) if !@signatures; 1609683c6f8fSJoe Perches 1610683c6f8fSJoe Perches save_commits_by_author(@lines) if ($interactive); 1611683c6f8fSJoe Perches save_commits_by_signer(@lines) if ($interactive); 1612683c6f8fSJoe Perches 16130e70e83dSJoe Perches if (!$email_git_penguin_chiefs) { 1614683c6f8fSJoe Perches @signatures = grep(!/${penguin_chiefs}/i, @signatures); 1615afa81ee1SJoe Perches } 161663ab52dbSJoe Perches 1617c9ecefeaSJoe Perches my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors); 1618683c6f8fSJoe Perches my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 161963ab52dbSJoe Perches 1620c9ecefeaSJoe Perches return ($commits, $signers_ref, $authors_ref, \@stats); 1621a8af2430SJoe Perches} 1622a8af2430SJoe Perches 162363ab52dbSJoe Perchessub vcs_find_author { 162463ab52dbSJoe Perches my ($cmd) = @_; 162563ab52dbSJoe Perches my @lines = (); 162663ab52dbSJoe Perches 162763ab52dbSJoe Perches @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 162863ab52dbSJoe Perches 162963ab52dbSJoe Perches if (!$email_git_penguin_chiefs) { 163063ab52dbSJoe Perches @lines = grep(!/${penguin_chiefs}/i, @lines); 163163ab52dbSJoe Perches } 163263ab52dbSJoe Perches 163363ab52dbSJoe Perches return @lines if !@lines; 163463ab52dbSJoe Perches 1635683c6f8fSJoe Perches my @authors = (); 163663ab52dbSJoe Perches foreach my $line (@lines) { 1637683c6f8fSJoe Perches if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1638683c6f8fSJoe Perches my $author = $1; 1639683c6f8fSJoe Perches my ($name, $address) = parse_email($author); 1640683c6f8fSJoe Perches $author = format_email($name, $address, 1); 1641683c6f8fSJoe Perches push(@authors, $author); 1642683c6f8fSJoe Perches } 164363ab52dbSJoe Perches } 164463ab52dbSJoe Perches 1645683c6f8fSJoe Perches save_commits_by_author(@lines) if ($interactive); 1646683c6f8fSJoe Perches save_commits_by_signer(@lines) if ($interactive); 1647683c6f8fSJoe Perches 1648683c6f8fSJoe Perches return @authors; 164963ab52dbSJoe Perches} 165063ab52dbSJoe Perches 165160db31acSJoe Perchessub vcs_save_commits { 165260db31acSJoe Perches my ($cmd) = @_; 165360db31acSJoe Perches my @lines = (); 165460db31acSJoe Perches my @commits = (); 165560db31acSJoe Perches 165660db31acSJoe Perches @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 165760db31acSJoe Perches 165860db31acSJoe Perches foreach my $line (@lines) { 165960db31acSJoe Perches if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 166060db31acSJoe Perches push(@commits, $1); 166160db31acSJoe Perches } 166260db31acSJoe Perches } 166360db31acSJoe Perches 166460db31acSJoe Perches return @commits; 166560db31acSJoe Perches} 166660db31acSJoe Perches 166760db31acSJoe Perchessub vcs_blame { 166860db31acSJoe Perches my ($file) = @_; 166960db31acSJoe Perches my $cmd; 167060db31acSJoe Perches my @commits = (); 167160db31acSJoe Perches 167260db31acSJoe Perches return @commits if (!(-f $file)); 167360db31acSJoe Perches 167460db31acSJoe Perches if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 167560db31acSJoe Perches my @all_commits = (); 167660db31acSJoe Perches 167760db31acSJoe Perches $cmd = $VCS_cmds{"blame_file_cmd"}; 167860db31acSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 167960db31acSJoe Perches @all_commits = vcs_save_commits($cmd); 168060db31acSJoe Perches 168160db31acSJoe Perches foreach my $file_range_diff (@range) { 168260db31acSJoe Perches next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 168360db31acSJoe Perches my $diff_file = $1; 168460db31acSJoe Perches my $diff_start = $2; 168560db31acSJoe Perches my $diff_length = $3; 168660db31acSJoe Perches next if ("$file" ne "$diff_file"); 168760db31acSJoe Perches for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 168860db31acSJoe Perches push(@commits, $all_commits[$i]); 168960db31acSJoe Perches } 169060db31acSJoe Perches } 169160db31acSJoe Perches } elsif (@range) { 169260db31acSJoe Perches foreach my $file_range_diff (@range) { 169360db31acSJoe Perches next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 169460db31acSJoe Perches my $diff_file = $1; 169560db31acSJoe Perches my $diff_start = $2; 169660db31acSJoe Perches my $diff_length = $3; 169760db31acSJoe Perches next if ("$file" ne "$diff_file"); 169860db31acSJoe Perches $cmd = $VCS_cmds{"blame_range_cmd"}; 169960db31acSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 170060db31acSJoe Perches push(@commits, vcs_save_commits($cmd)); 170160db31acSJoe Perches } 170260db31acSJoe Perches } else { 170360db31acSJoe Perches $cmd = $VCS_cmds{"blame_file_cmd"}; 170460db31acSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 170560db31acSJoe Perches @commits = vcs_save_commits($cmd); 170660db31acSJoe Perches } 170760db31acSJoe Perches 170863ab52dbSJoe Perches foreach my $commit (@commits) { 170963ab52dbSJoe Perches $commit =~ s/^\^//g; 171063ab52dbSJoe Perches } 171163ab52dbSJoe Perches 171260db31acSJoe Perches return @commits; 171360db31acSJoe Perches} 171460db31acSJoe Perches 171560db31acSJoe Perchesmy $printed_novcs = 0; 171660db31acSJoe Perchessub vcs_exists { 171760db31acSJoe Perches %VCS_cmds = %VCS_cmds_git; 171860db31acSJoe Perches return 1 if eval $VCS_cmds{"available"}; 171960db31acSJoe Perches %VCS_cmds = %VCS_cmds_hg; 1720683c6f8fSJoe Perches return 2 if eval $VCS_cmds{"available"}; 172160db31acSJoe Perches %VCS_cmds = (); 172226d98e9fSRandy Dunlap if (!$printed_novcs && $email_git) { 172360db31acSJoe Perches warn("$P: No supported VCS found. Add --nogit to options?\n"); 172460db31acSJoe Perches warn("Using a git repository produces better results.\n"); 172560db31acSJoe Perches warn("Try Linus Torvalds' latest git repository using:\n"); 17263d1c2f72SRalf Thielow warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n"); 172760db31acSJoe Perches $printed_novcs = 1; 172860db31acSJoe Perches } 172960db31acSJoe Perches return 0; 173060db31acSJoe Perches} 173160db31acSJoe Perches 1732683c6f8fSJoe Perchessub vcs_is_git { 1733b9e2331dSJoe Perches vcs_exists(); 1734683c6f8fSJoe Perches return $vcs_used == 1; 1735683c6f8fSJoe Perches} 1736683c6f8fSJoe Perches 1737683c6f8fSJoe Perchessub vcs_is_hg { 1738683c6f8fSJoe Perches return $vcs_used == 2; 1739683c6f8fSJoe Perches} 1740683c6f8fSJoe Perches 17412f5bd343SJoe Perchessub vcs_add_commit_signers { 17422f5bd343SJoe Perches return if (!vcs_exists()); 17432f5bd343SJoe Perches 17442f5bd343SJoe Perches my ($commit, $desc) = @_; 17452f5bd343SJoe Perches my $commit_count = 0; 17462f5bd343SJoe Perches my $commit_authors_ref; 17472f5bd343SJoe Perches my $commit_signers_ref; 17482f5bd343SJoe Perches my $stats_ref; 17492f5bd343SJoe Perches my @commit_authors = (); 17502f5bd343SJoe Perches my @commit_signers = (); 17512f5bd343SJoe Perches my $cmd; 17522f5bd343SJoe Perches 17532f5bd343SJoe Perches $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 17542f5bd343SJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 17552f5bd343SJoe Perches 17562f5bd343SJoe Perches ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, ""); 17572f5bd343SJoe Perches @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; 17582f5bd343SJoe Perches @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; 17592f5bd343SJoe Perches 17602f5bd343SJoe Perches foreach my $signer (@commit_signers) { 17612f5bd343SJoe Perches $signer = deduplicate_email($signer); 17622f5bd343SJoe Perches } 17632f5bd343SJoe Perches 17642f5bd343SJoe Perches vcs_assign($desc, 1, @commit_signers); 17652f5bd343SJoe Perches} 17662f5bd343SJoe Perches 17676ef1c52eSJoe Perchessub interactive_get_maintainers { 1768683c6f8fSJoe Perches my ($list_ref) = @_; 1769dace8e30SFlorian Mickler my @list = @$list_ref; 1770dace8e30SFlorian Mickler 1771683c6f8fSJoe Perches vcs_exists(); 1772dace8e30SFlorian Mickler 1773dace8e30SFlorian Mickler my %selected; 1774683c6f8fSJoe Perches my %authored; 1775683c6f8fSJoe Perches my %signed; 1776dace8e30SFlorian Mickler my $count = 0; 17776ef1c52eSJoe Perches my $maintained = 0; 1778dace8e30SFlorian Mickler foreach my $entry (@list) { 1779b9e2331dSJoe Perches $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i); 1780b9e2331dSJoe Perches $selected{$count} = 1; 1781683c6f8fSJoe Perches $authored{$count} = 0; 1782683c6f8fSJoe Perches $signed{$count} = 0; 1783dace8e30SFlorian Mickler $count++; 1784dace8e30SFlorian Mickler } 1785dace8e30SFlorian Mickler 1786dace8e30SFlorian Mickler #menu loop 1787683c6f8fSJoe Perches my $done = 0; 1788683c6f8fSJoe Perches my $print_options = 0; 1789683c6f8fSJoe Perches my $redraw = 1; 1790683c6f8fSJoe Perches while (!$done) { 1791683c6f8fSJoe Perches $count = 0; 1792683c6f8fSJoe Perches if ($redraw) { 17936ef1c52eSJoe Perches printf STDERR "\n%1s %2s %-65s", 1794683c6f8fSJoe Perches "*", "#", "email/list and role:stats"; 17956ef1c52eSJoe Perches if ($email_git || 17966ef1c52eSJoe Perches ($email_git_fallback && !$maintained) || 17976ef1c52eSJoe Perches $email_git_blame) { 17986ef1c52eSJoe Perches print STDERR "auth sign"; 17996ef1c52eSJoe Perches } 18006ef1c52eSJoe Perches print STDERR "\n"; 1801dace8e30SFlorian Mickler foreach my $entry (@list) { 1802dace8e30SFlorian Mickler my $email = $entry->[0]; 1803dace8e30SFlorian Mickler my $role = $entry->[1]; 1804683c6f8fSJoe Perches my $sel = ""; 1805683c6f8fSJoe Perches $sel = "*" if ($selected{$count}); 1806683c6f8fSJoe Perches my $commit_author = $commit_author_hash{$email}; 1807683c6f8fSJoe Perches my $commit_signer = $commit_signer_hash{$email}; 1808683c6f8fSJoe Perches my $authored = 0; 1809683c6f8fSJoe Perches my $signed = 0; 1810683c6f8fSJoe Perches $authored++ for (@{$commit_author}); 1811683c6f8fSJoe Perches $signed++ for (@{$commit_signer}); 1812683c6f8fSJoe Perches printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1813683c6f8fSJoe Perches printf STDERR "%4d %4d", $authored, $signed 1814683c6f8fSJoe Perches if ($authored > 0 || $signed > 0); 1815683c6f8fSJoe Perches printf STDERR "\n %s\n", $role; 1816683c6f8fSJoe Perches if ($authored{$count}) { 1817683c6f8fSJoe Perches my $commit_author = $commit_author_hash{$email}; 1818683c6f8fSJoe Perches foreach my $ref (@{$commit_author}) { 1819683c6f8fSJoe Perches print STDERR " Author: @{$ref}[1]\n"; 1820dace8e30SFlorian Mickler } 1821dace8e30SFlorian Mickler } 1822683c6f8fSJoe Perches if ($signed{$count}) { 1823683c6f8fSJoe Perches my $commit_signer = $commit_signer_hash{$email}; 1824683c6f8fSJoe Perches foreach my $ref (@{$commit_signer}) { 1825683c6f8fSJoe Perches print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1826683c6f8fSJoe Perches } 1827683c6f8fSJoe Perches } 1828683c6f8fSJoe Perches 1829dace8e30SFlorian Mickler $count++; 1830dace8e30SFlorian Mickler } 1831683c6f8fSJoe Perches } 1832683c6f8fSJoe Perches my $date_ref = \$email_git_since; 1833683c6f8fSJoe Perches $date_ref = \$email_hg_since if (vcs_is_hg()); 1834683c6f8fSJoe Perches if ($print_options) { 1835683c6f8fSJoe Perches $print_options = 0; 1836683c6f8fSJoe Perches if (vcs_exists()) { 1837b9e2331dSJoe Perches print STDERR <<EOT 1838b9e2331dSJoe Perches 1839b9e2331dSJoe PerchesVersion Control options: 1840b9e2331dSJoe Perchesg use git history [$email_git] 1841b9e2331dSJoe Perchesgf use git-fallback [$email_git_fallback] 1842b9e2331dSJoe Perchesb use git blame [$email_git_blame] 1843b9e2331dSJoe Perchesbs use blame signatures [$email_git_blame_signatures] 1844b9e2331dSJoe Perchesc# minimum commits [$email_git_min_signatures] 1845b9e2331dSJoe Perches%# min percent [$email_git_min_percent] 1846b9e2331dSJoe Perchesd# history to use [$$date_ref] 1847b9e2331dSJoe Perchesx# max maintainers [$email_git_max_maintainers] 1848b9e2331dSJoe Perchest all signature types [$email_git_all_signature_types] 1849b9e2331dSJoe Perchesm use .mailmap [$email_use_mailmap] 1850b9e2331dSJoe PerchesEOT 1851683c6f8fSJoe Perches } 1852b9e2331dSJoe Perches print STDERR <<EOT 1853b9e2331dSJoe Perches 1854b9e2331dSJoe PerchesAdditional options: 1855b9e2331dSJoe Perches0 toggle all 1856b9e2331dSJoe Perchestm toggle maintainers 1857b9e2331dSJoe Perchestg toggle git entries 1858b9e2331dSJoe Perchestl toggle open list entries 1859b9e2331dSJoe Perchests toggle subscriber list entries 18600c78c013SJoe Perchesf emails in file [$email_file_emails] 1861b9e2331dSJoe Perchesk keywords in file [$keywords] 1862b9e2331dSJoe Perchesr remove duplicates [$email_remove_duplicates] 1863b9e2331dSJoe Perchesp# pattern match depth [$pattern_depth] 1864b9e2331dSJoe PerchesEOT 1865683c6f8fSJoe Perches } 1866683c6f8fSJoe Perches print STDERR 1867683c6f8fSJoe Perches"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1868683c6f8fSJoe Perches 1869683c6f8fSJoe Perches my $input = <STDIN>; 1870dace8e30SFlorian Mickler chomp($input); 1871dace8e30SFlorian Mickler 1872683c6f8fSJoe Perches $redraw = 1; 1873683c6f8fSJoe Perches my $rerun = 0; 1874dace8e30SFlorian Mickler my @wish = split(/[, ]+/, $input); 1875dace8e30SFlorian Mickler foreach my $nr (@wish) { 1876683c6f8fSJoe Perches $nr = lc($nr); 1877683c6f8fSJoe Perches my $sel = substr($nr, 0, 1); 1878683c6f8fSJoe Perches my $str = substr($nr, 1); 1879683c6f8fSJoe Perches my $val = 0; 1880683c6f8fSJoe Perches $val = $1 if $str =~ /^(\d+)$/; 1881683c6f8fSJoe Perches 1882683c6f8fSJoe Perches if ($sel eq "y") { 1883683c6f8fSJoe Perches $interactive = 0; 1884683c6f8fSJoe Perches $done = 1; 1885683c6f8fSJoe Perches $output_rolestats = 0; 1886683c6f8fSJoe Perches $output_roles = 0; 1887683c6f8fSJoe Perches last; 1888683c6f8fSJoe Perches } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1889683c6f8fSJoe Perches $selected{$nr - 1} = !$selected{$nr - 1}; 1890683c6f8fSJoe Perches } elsif ($sel eq "*" || $sel eq '^') { 1891683c6f8fSJoe Perches my $toggle = 0; 1892683c6f8fSJoe Perches $toggle = 1 if ($sel eq '*'); 1893683c6f8fSJoe Perches for (my $i = 0; $i < $count; $i++) { 1894683c6f8fSJoe Perches $selected{$i} = $toggle; 1895dace8e30SFlorian Mickler } 1896683c6f8fSJoe Perches } elsif ($sel eq "0") { 1897683c6f8fSJoe Perches for (my $i = 0; $i < $count; $i++) { 1898683c6f8fSJoe Perches $selected{$i} = !$selected{$i}; 1899683c6f8fSJoe Perches } 1900b9e2331dSJoe Perches } elsif ($sel eq "t") { 1901b9e2331dSJoe Perches if (lc($str) eq "m") { 1902b9e2331dSJoe Perches for (my $i = 0; $i < $count; $i++) { 1903b9e2331dSJoe Perches $selected{$i} = !$selected{$i} 1904b9e2331dSJoe Perches if ($list[$i]->[1] =~ /^(maintainer|supporter)/i); 1905b9e2331dSJoe Perches } 1906b9e2331dSJoe Perches } elsif (lc($str) eq "g") { 1907b9e2331dSJoe Perches for (my $i = 0; $i < $count; $i++) { 1908b9e2331dSJoe Perches $selected{$i} = !$selected{$i} 1909b9e2331dSJoe Perches if ($list[$i]->[1] =~ /^(author|commit|signer)/i); 1910b9e2331dSJoe Perches } 1911b9e2331dSJoe Perches } elsif (lc($str) eq "l") { 1912b9e2331dSJoe Perches for (my $i = 0; $i < $count; $i++) { 1913b9e2331dSJoe Perches $selected{$i} = !$selected{$i} 1914b9e2331dSJoe Perches if ($list[$i]->[1] =~ /^(open list)/i); 1915b9e2331dSJoe Perches } 1916b9e2331dSJoe Perches } elsif (lc($str) eq "s") { 1917b9e2331dSJoe Perches for (my $i = 0; $i < $count; $i++) { 1918b9e2331dSJoe Perches $selected{$i} = !$selected{$i} 1919b9e2331dSJoe Perches if ($list[$i]->[1] =~ /^(subscriber list)/i); 1920b9e2331dSJoe Perches } 1921b9e2331dSJoe Perches } 1922683c6f8fSJoe Perches } elsif ($sel eq "a") { 1923683c6f8fSJoe Perches if ($val > 0 && $val <= $count) { 1924683c6f8fSJoe Perches $authored{$val - 1} = !$authored{$val - 1}; 1925683c6f8fSJoe Perches } elsif ($str eq '*' || $str eq '^') { 1926683c6f8fSJoe Perches my $toggle = 0; 1927683c6f8fSJoe Perches $toggle = 1 if ($str eq '*'); 1928683c6f8fSJoe Perches for (my $i = 0; $i < $count; $i++) { 1929683c6f8fSJoe Perches $authored{$i} = $toggle; 1930683c6f8fSJoe Perches } 1931683c6f8fSJoe Perches } 1932683c6f8fSJoe Perches } elsif ($sel eq "s") { 1933683c6f8fSJoe Perches if ($val > 0 && $val <= $count) { 1934683c6f8fSJoe Perches $signed{$val - 1} = !$signed{$val - 1}; 1935683c6f8fSJoe Perches } elsif ($str eq '*' || $str eq '^') { 1936683c6f8fSJoe Perches my $toggle = 0; 1937683c6f8fSJoe Perches $toggle = 1 if ($str eq '*'); 1938683c6f8fSJoe Perches for (my $i = 0; $i < $count; $i++) { 1939683c6f8fSJoe Perches $signed{$i} = $toggle; 1940683c6f8fSJoe Perches } 1941683c6f8fSJoe Perches } 1942683c6f8fSJoe Perches } elsif ($sel eq "o") { 1943683c6f8fSJoe Perches $print_options = 1; 1944683c6f8fSJoe Perches $redraw = 1; 1945683c6f8fSJoe Perches } elsif ($sel eq "g") { 1946683c6f8fSJoe Perches if ($str eq "f") { 1947683c6f8fSJoe Perches bool_invert(\$email_git_fallback); 1948dace8e30SFlorian Mickler } else { 1949683c6f8fSJoe Perches bool_invert(\$email_git); 1950683c6f8fSJoe Perches } 1951683c6f8fSJoe Perches $rerun = 1; 1952683c6f8fSJoe Perches } elsif ($sel eq "b") { 1953683c6f8fSJoe Perches if ($str eq "s") { 1954683c6f8fSJoe Perches bool_invert(\$email_git_blame_signatures); 1955683c6f8fSJoe Perches } else { 1956683c6f8fSJoe Perches bool_invert(\$email_git_blame); 1957683c6f8fSJoe Perches } 1958683c6f8fSJoe Perches $rerun = 1; 1959683c6f8fSJoe Perches } elsif ($sel eq "c") { 1960683c6f8fSJoe Perches if ($val > 0) { 1961683c6f8fSJoe Perches $email_git_min_signatures = $val; 1962683c6f8fSJoe Perches $rerun = 1; 1963683c6f8fSJoe Perches } 1964683c6f8fSJoe Perches } elsif ($sel eq "x") { 1965683c6f8fSJoe Perches if ($val > 0) { 1966683c6f8fSJoe Perches $email_git_max_maintainers = $val; 1967683c6f8fSJoe Perches $rerun = 1; 1968683c6f8fSJoe Perches } 1969683c6f8fSJoe Perches } elsif ($sel eq "%") { 1970683c6f8fSJoe Perches if ($str ne "" && $val >= 0) { 1971683c6f8fSJoe Perches $email_git_min_percent = $val; 1972683c6f8fSJoe Perches $rerun = 1; 1973683c6f8fSJoe Perches } 1974683c6f8fSJoe Perches } elsif ($sel eq "d") { 1975683c6f8fSJoe Perches if (vcs_is_git()) { 1976683c6f8fSJoe Perches $email_git_since = $str; 1977683c6f8fSJoe Perches } elsif (vcs_is_hg()) { 1978683c6f8fSJoe Perches $email_hg_since = $str; 1979683c6f8fSJoe Perches } 1980683c6f8fSJoe Perches $rerun = 1; 1981683c6f8fSJoe Perches } elsif ($sel eq "t") { 1982683c6f8fSJoe Perches bool_invert(\$email_git_all_signature_types); 1983683c6f8fSJoe Perches $rerun = 1; 1984683c6f8fSJoe Perches } elsif ($sel eq "f") { 19850c78c013SJoe Perches bool_invert(\$email_file_emails); 1986683c6f8fSJoe Perches $rerun = 1; 1987683c6f8fSJoe Perches } elsif ($sel eq "r") { 1988683c6f8fSJoe Perches bool_invert(\$email_remove_duplicates); 1989683c6f8fSJoe Perches $rerun = 1; 1990b9e2331dSJoe Perches } elsif ($sel eq "m") { 1991b9e2331dSJoe Perches bool_invert(\$email_use_mailmap); 1992b9e2331dSJoe Perches read_mailmap(); 1993b9e2331dSJoe Perches $rerun = 1; 1994683c6f8fSJoe Perches } elsif ($sel eq "k") { 1995683c6f8fSJoe Perches bool_invert(\$keywords); 1996683c6f8fSJoe Perches $rerun = 1; 1997683c6f8fSJoe Perches } elsif ($sel eq "p") { 1998683c6f8fSJoe Perches if ($str ne "" && $val >= 0) { 1999683c6f8fSJoe Perches $pattern_depth = $val; 2000683c6f8fSJoe Perches $rerun = 1; 2001683c6f8fSJoe Perches } 20026ef1c52eSJoe Perches } elsif ($sel eq "h" || $sel eq "?") { 20036ef1c52eSJoe Perches print STDERR <<EOT 20046ef1c52eSJoe Perches 20056ef1c52eSJoe PerchesInteractive mode allows you to select the various maintainers, submitters, 20066ef1c52eSJoe Perchescommit signers and mailing lists that could be CC'd on a patch. 20076ef1c52eSJoe Perches 20086ef1c52eSJoe PerchesAny *'d entry is selected. 20096ef1c52eSJoe Perches 201047abc722SJoe PerchesIf you have git or hg installed, you can choose to summarize the commit 20116ef1c52eSJoe Percheshistory of files in the patch. Also, each line of the current file can 20126ef1c52eSJoe Perchesbe matched to its commit author and that commits signers with blame. 20136ef1c52eSJoe Perches 20146ef1c52eSJoe PerchesVarious knobs exist to control the length of time for active commit 20156ef1c52eSJoe Perchestracking, the maximum number of commit authors and signers to add, 20166ef1c52eSJoe Perchesand such. 20176ef1c52eSJoe Perches 20186ef1c52eSJoe PerchesEnter selections at the prompt until you are satisfied that the selected 20196ef1c52eSJoe Perchesmaintainers are appropriate. You may enter multiple selections separated 20206ef1c52eSJoe Perchesby either commas or spaces. 20216ef1c52eSJoe Perches 20226ef1c52eSJoe PerchesEOT 2023683c6f8fSJoe Perches } else { 2024683c6f8fSJoe Perches print STDERR "invalid option: '$nr'\n"; 2025683c6f8fSJoe Perches $redraw = 0; 2026dace8e30SFlorian Mickler } 2027dace8e30SFlorian Mickler } 2028683c6f8fSJoe Perches if ($rerun) { 2029683c6f8fSJoe Perches print STDERR "git-blame can be very slow, please have patience..." 2030683c6f8fSJoe Perches if ($email_git_blame); 20316ef1c52eSJoe Perches goto &get_maintainers; 2032683c6f8fSJoe Perches } 2033683c6f8fSJoe Perches } 2034dace8e30SFlorian Mickler 2035dace8e30SFlorian Mickler #drop not selected entries 2036dace8e30SFlorian Mickler $count = 0; 2037683c6f8fSJoe Perches my @new_emailto = (); 2038dace8e30SFlorian Mickler foreach my $entry (@list) { 2039dace8e30SFlorian Mickler if ($selected{$count}) { 2040dace8e30SFlorian Mickler push(@new_emailto, $list[$count]); 2041dace8e30SFlorian Mickler } 2042dace8e30SFlorian Mickler $count++; 2043dace8e30SFlorian Mickler } 2044683c6f8fSJoe Perches return @new_emailto; 2045dace8e30SFlorian Mickler} 2046dace8e30SFlorian Mickler 2047683c6f8fSJoe Perchessub bool_invert { 2048683c6f8fSJoe Perches my ($bool_ref) = @_; 2049683c6f8fSJoe Perches 2050683c6f8fSJoe Perches if ($$bool_ref) { 2051683c6f8fSJoe Perches $$bool_ref = 0; 2052683c6f8fSJoe Perches } else { 2053683c6f8fSJoe Perches $$bool_ref = 1; 2054683c6f8fSJoe Perches } 2055dace8e30SFlorian Mickler} 2056dace8e30SFlorian Mickler 2057b9e2331dSJoe Perchessub deduplicate_email { 2058b9e2331dSJoe Perches my ($email) = @_; 2059b9e2331dSJoe Perches 2060b9e2331dSJoe Perches my $matched = 0; 2061b9e2331dSJoe Perches my ($name, $address) = parse_email($email); 2062b9e2331dSJoe Perches $email = format_email($name, $address, 1); 2063b9e2331dSJoe Perches $email = mailmap_email($email); 2064b9e2331dSJoe Perches 2065b9e2331dSJoe Perches return $email if (!$email_remove_duplicates); 2066b9e2331dSJoe Perches 2067b9e2331dSJoe Perches ($name, $address) = parse_email($email); 2068b9e2331dSJoe Perches 2069fae99206SJoe Perches if ($name ne "" && $deduplicate_name_hash{lc($name)}) { 2070b9e2331dSJoe Perches $name = $deduplicate_name_hash{lc($name)}->[0]; 2071b9e2331dSJoe Perches $address = $deduplicate_name_hash{lc($name)}->[1]; 2072b9e2331dSJoe Perches $matched = 1; 2073b9e2331dSJoe Perches } elsif ($deduplicate_address_hash{lc($address)}) { 2074b9e2331dSJoe Perches $name = $deduplicate_address_hash{lc($address)}->[0]; 2075b9e2331dSJoe Perches $address = $deduplicate_address_hash{lc($address)}->[1]; 2076b9e2331dSJoe Perches $matched = 1; 2077b9e2331dSJoe Perches } 2078b9e2331dSJoe Perches if (!$matched) { 2079b9e2331dSJoe Perches $deduplicate_name_hash{lc($name)} = [ $name, $address ]; 2080b9e2331dSJoe Perches $deduplicate_address_hash{lc($address)} = [ $name, $address ]; 2081b9e2331dSJoe Perches } 2082b9e2331dSJoe Perches $email = format_email($name, $address, 1); 2083b9e2331dSJoe Perches $email = mailmap_email($email); 2084b9e2331dSJoe Perches return $email; 2085b9e2331dSJoe Perches} 2086b9e2331dSJoe Perches 2087683c6f8fSJoe Perchessub save_commits_by_author { 2088683c6f8fSJoe Perches my (@lines) = @_; 2089683c6f8fSJoe Perches 2090683c6f8fSJoe Perches my @authors = (); 2091683c6f8fSJoe Perches my @commits = (); 2092683c6f8fSJoe Perches my @subjects = (); 2093683c6f8fSJoe Perches 2094683c6f8fSJoe Perches foreach my $line (@lines) { 2095683c6f8fSJoe Perches if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 2096683c6f8fSJoe Perches my $author = $1; 2097b9e2331dSJoe Perches $author = deduplicate_email($author); 2098683c6f8fSJoe Perches push(@authors, $author); 2099dace8e30SFlorian Mickler } 2100683c6f8fSJoe Perches push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 2101683c6f8fSJoe Perches push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 2102dace8e30SFlorian Mickler } 2103dace8e30SFlorian Mickler 2104683c6f8fSJoe Perches for (my $i = 0; $i < @authors; $i++) { 2105683c6f8fSJoe Perches my $exists = 0; 2106683c6f8fSJoe Perches foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 2107683c6f8fSJoe Perches if (@{$ref}[0] eq $commits[$i] && 2108683c6f8fSJoe Perches @{$ref}[1] eq $subjects[$i]) { 2109683c6f8fSJoe Perches $exists = 1; 2110683c6f8fSJoe Perches last; 2111683c6f8fSJoe Perches } 2112683c6f8fSJoe Perches } 2113683c6f8fSJoe Perches if (!$exists) { 2114683c6f8fSJoe Perches push(@{$commit_author_hash{$authors[$i]}}, 2115683c6f8fSJoe Perches [ ($commits[$i], $subjects[$i]) ]); 2116683c6f8fSJoe Perches } 2117683c6f8fSJoe Perches } 2118683c6f8fSJoe Perches} 2119dace8e30SFlorian Mickler 2120683c6f8fSJoe Perchessub save_commits_by_signer { 2121683c6f8fSJoe Perches my (@lines) = @_; 2122683c6f8fSJoe Perches 2123683c6f8fSJoe Perches my $commit = ""; 2124683c6f8fSJoe Perches my $subject = ""; 2125683c6f8fSJoe Perches 2126683c6f8fSJoe Perches foreach my $line (@lines) { 2127683c6f8fSJoe Perches $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 2128683c6f8fSJoe Perches $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 2129683c6f8fSJoe Perches if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 2130683c6f8fSJoe Perches my @signatures = ($line); 2131683c6f8fSJoe Perches my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 2132683c6f8fSJoe Perches my @types = @$types_ref; 2133683c6f8fSJoe Perches my @signers = @$signers_ref; 2134683c6f8fSJoe Perches 2135683c6f8fSJoe Perches my $type = $types[0]; 2136683c6f8fSJoe Perches my $signer = $signers[0]; 2137683c6f8fSJoe Perches 2138b9e2331dSJoe Perches $signer = deduplicate_email($signer); 21396ef1c52eSJoe Perches 2140683c6f8fSJoe Perches my $exists = 0; 2141683c6f8fSJoe Perches foreach my $ref(@{$commit_signer_hash{$signer}}) { 2142683c6f8fSJoe Perches if (@{$ref}[0] eq $commit && 2143683c6f8fSJoe Perches @{$ref}[1] eq $subject && 2144683c6f8fSJoe Perches @{$ref}[2] eq $type) { 2145683c6f8fSJoe Perches $exists = 1; 2146683c6f8fSJoe Perches last; 2147683c6f8fSJoe Perches } 2148683c6f8fSJoe Perches } 2149683c6f8fSJoe Perches if (!$exists) { 2150683c6f8fSJoe Perches push(@{$commit_signer_hash{$signer}}, 2151683c6f8fSJoe Perches [ ($commit, $subject, $type) ]); 2152683c6f8fSJoe Perches } 2153683c6f8fSJoe Perches } 2154683c6f8fSJoe Perches } 2155dace8e30SFlorian Mickler} 2156dace8e30SFlorian Mickler 215760db31acSJoe Perchessub vcs_assign { 2158a8af2430SJoe Perches my ($role, $divisor, @lines) = @_; 2159a8af2430SJoe Perches 2160a8af2430SJoe Perches my %hash; 2161a8af2430SJoe Perches my $count = 0; 2162a8af2430SJoe Perches 2163a8af2430SJoe Perches return if (@lines <= 0); 2164a8af2430SJoe Perches 2165a8af2430SJoe Perches if ($divisor <= 0) { 216660db31acSJoe Perches warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 2167a8af2430SJoe Perches $divisor = 1; 21683c7385b8SJoe Perches } 21698cbb3a77SJoe Perches 21700e70e83dSJoe Perches @lines = mailmap(@lines); 21710e70e83dSJoe Perches 217263ab52dbSJoe Perches return if (@lines <= 0); 217363ab52dbSJoe Perches 21740e70e83dSJoe Perches @lines = sort(@lines); 2175afa81ee1SJoe Perches 217611ecf53cSJoe Perches # uniq -c 217711ecf53cSJoe Perches $hash{$_}++ for @lines; 217811ecf53cSJoe Perches 217911ecf53cSJoe Perches # sort -rn 218011ecf53cSJoe Perches foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 218111ecf53cSJoe Perches my $sign_offs = $hash{$line}; 2182a8af2430SJoe Perches my $percent = $sign_offs * 100 / $divisor; 21833c7385b8SJoe Perches 2184a8af2430SJoe Perches $percent = 100 if ($percent > 100); 2185435de078SJoe Perches next if (ignore_email_address($line)); 2186cb7301c7SJoe Perches $count++; 218711ecf53cSJoe Perches last if ($sign_offs < $email_git_min_signatures || 2188afa81ee1SJoe Perches $count > $email_git_max_maintainers || 2189a8af2430SJoe Perches $percent < $email_git_min_percent); 21903c7385b8SJoe Perches push_email_address($line, ''); 21913c7385b8SJoe Perches if ($output_rolestats) { 2192a8af2430SJoe Perches my $fmt_percent = sprintf("%.0f", $percent); 2193a8af2430SJoe Perches add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 2194a8af2430SJoe Perches } else { 21953c7385b8SJoe Perches add_role($line, $role); 2196cb7301c7SJoe Perches } 2197cb7301c7SJoe Perches } 2198a8af2430SJoe Perches} 2199a8af2430SJoe Perches 220060db31acSJoe Perchessub vcs_file_signoffs { 2201a8af2430SJoe Perches my ($file) = @_; 2202a8af2430SJoe Perches 2203c9ecefeaSJoe Perches my $authors_ref; 2204c9ecefeaSJoe Perches my $signers_ref; 2205c9ecefeaSJoe Perches my $stats_ref; 2206c9ecefeaSJoe Perches my @authors = (); 2207a8af2430SJoe Perches my @signers = (); 2208c9ecefeaSJoe Perches my @stats = (); 220960db31acSJoe Perches my $commits; 2210a8af2430SJoe Perches 2211683c6f8fSJoe Perches $vcs_used = vcs_exists(); 2212683c6f8fSJoe Perches return if (!$vcs_used); 2213a8af2430SJoe Perches 221460db31acSJoe Perches my $cmd = $VCS_cmds{"find_signers_cmd"}; 221560db31acSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 221660db31acSJoe Perches 2217c9ecefeaSJoe Perches ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2218c9ecefeaSJoe Perches 2219c9ecefeaSJoe Perches @signers = @{$signers_ref} if defined $signers_ref; 2220c9ecefeaSJoe Perches @authors = @{$authors_ref} if defined $authors_ref; 2221c9ecefeaSJoe Perches @stats = @{$stats_ref} if defined $stats_ref; 2222c9ecefeaSJoe Perches 2223c9ecefeaSJoe Perches# print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n"); 2224b9e2331dSJoe Perches 2225b9e2331dSJoe Perches foreach my $signer (@signers) { 2226b9e2331dSJoe Perches $signer = deduplicate_email($signer); 2227b9e2331dSJoe Perches } 2228b9e2331dSJoe Perches 222960db31acSJoe Perches vcs_assign("commit_signer", $commits, @signers); 2230c9ecefeaSJoe Perches vcs_assign("authored", $commits, @authors); 2231c9ecefeaSJoe Perches if ($#authors == $#stats) { 2232c9ecefeaSJoe Perches my $stat_pattern = $VCS_cmds{"stat_pattern"}; 2233c9ecefeaSJoe Perches $stat_pattern =~ s/(\$\w+)/$1/eeg; #interpolate $stat_pattern 2234c9ecefeaSJoe Perches 2235c9ecefeaSJoe Perches my $added = 0; 2236c9ecefeaSJoe Perches my $deleted = 0; 2237c9ecefeaSJoe Perches for (my $i = 0; $i <= $#stats; $i++) { 2238c9ecefeaSJoe Perches if ($stats[$i] =~ /$stat_pattern/) { 2239c9ecefeaSJoe Perches $added += $1; 2240c9ecefeaSJoe Perches $deleted += $2; 2241c9ecefeaSJoe Perches } 2242c9ecefeaSJoe Perches } 2243c9ecefeaSJoe Perches my @tmp_authors = uniq(@authors); 2244c9ecefeaSJoe Perches foreach my $author (@tmp_authors) { 2245c9ecefeaSJoe Perches $author = deduplicate_email($author); 2246c9ecefeaSJoe Perches } 2247c9ecefeaSJoe Perches @tmp_authors = uniq(@tmp_authors); 2248c9ecefeaSJoe Perches my @list_added = (); 2249c9ecefeaSJoe Perches my @list_deleted = (); 2250c9ecefeaSJoe Perches foreach my $author (@tmp_authors) { 2251c9ecefeaSJoe Perches my $auth_added = 0; 2252c9ecefeaSJoe Perches my $auth_deleted = 0; 2253c9ecefeaSJoe Perches for (my $i = 0; $i <= $#stats; $i++) { 2254c9ecefeaSJoe Perches if ($author eq deduplicate_email($authors[$i]) && 2255c9ecefeaSJoe Perches $stats[$i] =~ /$stat_pattern/) { 2256c9ecefeaSJoe Perches $auth_added += $1; 2257c9ecefeaSJoe Perches $auth_deleted += $2; 2258c9ecefeaSJoe Perches } 2259c9ecefeaSJoe Perches } 2260c9ecefeaSJoe Perches for (my $i = 0; $i < $auth_added; $i++) { 2261c9ecefeaSJoe Perches push(@list_added, $author); 2262c9ecefeaSJoe Perches } 2263c9ecefeaSJoe Perches for (my $i = 0; $i < $auth_deleted; $i++) { 2264c9ecefeaSJoe Perches push(@list_deleted, $author); 2265c9ecefeaSJoe Perches } 2266c9ecefeaSJoe Perches } 2267c9ecefeaSJoe Perches vcs_assign("added_lines", $added, @list_added); 2268c9ecefeaSJoe Perches vcs_assign("removed_lines", $deleted, @list_deleted); 2269c9ecefeaSJoe Perches } 2270a8af2430SJoe Perches} 2271f5492666SJoe Perches 227260db31acSJoe Perchessub vcs_file_blame { 2273f5492666SJoe Perches my ($file) = @_; 2274f5492666SJoe Perches 227560db31acSJoe Perches my @signers = (); 227663ab52dbSJoe Perches my @all_commits = (); 2277a8af2430SJoe Perches my @commits = (); 2278a8af2430SJoe Perches my $total_commits; 227963ab52dbSJoe Perches my $total_lines; 2280f5492666SJoe Perches 2281683c6f8fSJoe Perches $vcs_used = vcs_exists(); 2282683c6f8fSJoe Perches return if (!$vcs_used); 2283f5492666SJoe Perches 228463ab52dbSJoe Perches @all_commits = vcs_blame($file); 228563ab52dbSJoe Perches @commits = uniq(@all_commits); 2286a8af2430SJoe Perches $total_commits = @commits; 228763ab52dbSJoe Perches $total_lines = @all_commits; 2288a8af2430SJoe Perches 2289683c6f8fSJoe Perches if ($email_git_blame_signatures) { 2290683c6f8fSJoe Perches if (vcs_is_hg()) { 2291683c6f8fSJoe Perches my $commit_count; 2292c9ecefeaSJoe Perches my $commit_authors_ref; 2293c9ecefeaSJoe Perches my $commit_signers_ref; 2294c9ecefeaSJoe Perches my $stats_ref; 2295c9ecefeaSJoe Perches my @commit_authors = (); 2296683c6f8fSJoe Perches my @commit_signers = (); 2297683c6f8fSJoe Perches my $commit = join(" -r ", @commits); 2298683c6f8fSJoe Perches my $cmd; 2299683c6f8fSJoe Perches 2300683c6f8fSJoe Perches $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 2301683c6f8fSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 2302683c6f8fSJoe Perches 2303c9ecefeaSJoe Perches ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2304c9ecefeaSJoe Perches @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; 2305c9ecefeaSJoe Perches @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; 2306683c6f8fSJoe Perches 2307683c6f8fSJoe Perches push(@signers, @commit_signers); 2308683c6f8fSJoe Perches } else { 2309f5492666SJoe Perches foreach my $commit (@commits) { 2310a8af2430SJoe Perches my $commit_count; 2311c9ecefeaSJoe Perches my $commit_authors_ref; 2312c9ecefeaSJoe Perches my $commit_signers_ref; 2313c9ecefeaSJoe Perches my $stats_ref; 2314c9ecefeaSJoe Perches my @commit_authors = (); 2315a8af2430SJoe Perches my @commit_signers = (); 2316683c6f8fSJoe Perches my $cmd; 2317f5492666SJoe Perches 2318683c6f8fSJoe Perches $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 2319dace8e30SFlorian Mickler $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 232060db31acSJoe Perches 2321c9ecefeaSJoe Perches ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file); 2322c9ecefeaSJoe Perches @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref; 2323c9ecefeaSJoe Perches @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref; 232463ab52dbSJoe Perches 232560db31acSJoe Perches push(@signers, @commit_signers); 23260e70e83dSJoe Perches } 2327683c6f8fSJoe Perches } 2328683c6f8fSJoe Perches } 23298cbb3a77SJoe Perches 23303c7385b8SJoe Perches if ($from_filename) { 233163ab52dbSJoe Perches if ($output_rolestats) { 233263ab52dbSJoe Perches my @blame_signers; 2333683c6f8fSJoe Perches if (vcs_is_hg()) {{ # Double brace for last exit 2334683c6f8fSJoe Perches my $commit_count; 2335683c6f8fSJoe Perches my @commit_signers = (); 2336683c6f8fSJoe Perches @commits = uniq(@commits); 2337683c6f8fSJoe Perches @commits = sort(@commits); 2338683c6f8fSJoe Perches my $commit = join(" -r ", @commits); 2339683c6f8fSJoe Perches my $cmd; 2340683c6f8fSJoe Perches 2341683c6f8fSJoe Perches $cmd = $VCS_cmds{"find_commit_author_cmd"}; 2342683c6f8fSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 2343683c6f8fSJoe Perches 2344683c6f8fSJoe Perches my @lines = (); 2345683c6f8fSJoe Perches 2346683c6f8fSJoe Perches @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 2347683c6f8fSJoe Perches 2348683c6f8fSJoe Perches if (!$email_git_penguin_chiefs) { 2349683c6f8fSJoe Perches @lines = grep(!/${penguin_chiefs}/i, @lines); 2350683c6f8fSJoe Perches } 2351683c6f8fSJoe Perches 2352683c6f8fSJoe Perches last if !@lines; 2353683c6f8fSJoe Perches 2354683c6f8fSJoe Perches my @authors = (); 2355683c6f8fSJoe Perches foreach my $line (@lines) { 2356683c6f8fSJoe Perches if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 2357683c6f8fSJoe Perches my $author = $1; 2358b9e2331dSJoe Perches $author = deduplicate_email($author); 2359b9e2331dSJoe Perches push(@authors, $author); 2360683c6f8fSJoe Perches } 2361683c6f8fSJoe Perches } 2362683c6f8fSJoe Perches 2363683c6f8fSJoe Perches save_commits_by_author(@lines) if ($interactive); 2364683c6f8fSJoe Perches save_commits_by_signer(@lines) if ($interactive); 2365683c6f8fSJoe Perches 2366683c6f8fSJoe Perches push(@signers, @authors); 2367683c6f8fSJoe Perches }} 2368683c6f8fSJoe Perches else { 236963ab52dbSJoe Perches foreach my $commit (@commits) { 237063ab52dbSJoe Perches my $i; 237163ab52dbSJoe Perches my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 237263ab52dbSJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 237363ab52dbSJoe Perches my @author = vcs_find_author($cmd); 237463ab52dbSJoe Perches next if !@author; 2375b9e2331dSJoe Perches 2376b9e2331dSJoe Perches my $formatted_author = deduplicate_email($author[0]); 2377b9e2331dSJoe Perches 237863ab52dbSJoe Perches my $count = grep(/$commit/, @all_commits); 237963ab52dbSJoe Perches for ($i = 0; $i < $count ; $i++) { 2380b9e2331dSJoe Perches push(@blame_signers, $formatted_author); 238163ab52dbSJoe Perches } 238263ab52dbSJoe Perches } 2383683c6f8fSJoe Perches } 238463ab52dbSJoe Perches if (@blame_signers) { 238563ab52dbSJoe Perches vcs_assign("authored lines", $total_lines, @blame_signers); 238663ab52dbSJoe Perches } 238763ab52dbSJoe Perches } 2388b9e2331dSJoe Perches foreach my $signer (@signers) { 2389b9e2331dSJoe Perches $signer = deduplicate_email($signer); 2390b9e2331dSJoe Perches } 239160db31acSJoe Perches vcs_assign("commits", $total_commits, @signers); 23923c7385b8SJoe Perches } else { 2393b9e2331dSJoe Perches foreach my $signer (@signers) { 2394b9e2331dSJoe Perches $signer = deduplicate_email($signer); 2395b9e2331dSJoe Perches } 239660db31acSJoe Perches vcs_assign("modified commits", $total_commits, @signers); 2397cb7301c7SJoe Perches } 2398cb7301c7SJoe Perches} 2399cb7301c7SJoe Perches 24004cad35a7SJoe Perchessub vcs_file_exists { 24014cad35a7SJoe Perches my ($file) = @_; 24024cad35a7SJoe Perches 24034cad35a7SJoe Perches my $exists; 24044cad35a7SJoe Perches 24054cad35a7SJoe Perches my $vcs_used = vcs_exists(); 24064cad35a7SJoe Perches return 0 if (!$vcs_used); 24074cad35a7SJoe Perches 24084cad35a7SJoe Perches my $cmd = $VCS_cmds{"file_exists_cmd"}; 24094cad35a7SJoe Perches $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 24108582fb59SJoe Perches $cmd .= " 2>&1"; 24114cad35a7SJoe Perches $exists = &{$VCS_cmds{"execute_cmd"}}($cmd); 24124cad35a7SJoe Perches 24138582fb59SJoe Perches return 0 if ($? != 0); 24148582fb59SJoe Perches 24154cad35a7SJoe Perches return $exists; 24164cad35a7SJoe Perches} 24174cad35a7SJoe Perches 2418e1f75904STom Saegersub vcs_list_files { 2419e1f75904STom Saeger my ($file) = @_; 2420e1f75904STom Saeger 2421e1f75904STom Saeger my @lsfiles = (); 2422e1f75904STom Saeger 2423e1f75904STom Saeger my $vcs_used = vcs_exists(); 2424e1f75904STom Saeger return 0 if (!$vcs_used); 2425e1f75904STom Saeger 2426e1f75904STom Saeger my $cmd = $VCS_cmds{"list_files_cmd"}; 2427e1f75904STom Saeger $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 2428e1f75904STom Saeger @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd); 2429e1f75904STom Saeger 2430e1f75904STom Saeger return () if ($? != 0); 2431e1f75904STom Saeger 2432e1f75904STom Saeger return @lsfiles; 2433e1f75904STom Saeger} 2434e1f75904STom Saeger 2435cb7301c7SJoe Perchessub uniq { 2436a8af2430SJoe Perches my (@parms) = @_; 2437cb7301c7SJoe Perches 2438cb7301c7SJoe Perches my %saw; 2439cb7301c7SJoe Perches @parms = grep(!$saw{$_}++, @parms); 2440cb7301c7SJoe Perches return @parms; 2441cb7301c7SJoe Perches} 2442cb7301c7SJoe Perches 2443cb7301c7SJoe Perchessub sort_and_uniq { 2444a8af2430SJoe Perches my (@parms) = @_; 2445cb7301c7SJoe Perches 2446cb7301c7SJoe Perches my %saw; 2447cb7301c7SJoe Perches @parms = sort @parms; 2448cb7301c7SJoe Perches @parms = grep(!$saw{$_}++, @parms); 2449cb7301c7SJoe Perches return @parms; 2450cb7301c7SJoe Perches} 2451cb7301c7SJoe Perches 245203372dbbSJoe Perchessub clean_file_emails { 245303372dbbSJoe Perches my (@file_emails) = @_; 245403372dbbSJoe Perches my @fmt_emails = (); 245503372dbbSJoe Perches 245603372dbbSJoe Perches foreach my $email (@file_emails) { 245703372dbbSJoe Perches $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 245803372dbbSJoe Perches my ($name, $address) = parse_email($email); 245903372dbbSJoe Perches if ($name eq '"[,\.]"') { 246003372dbbSJoe Perches $name = ""; 246103372dbbSJoe Perches } 246203372dbbSJoe Perches 246303372dbbSJoe Perches my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 246403372dbbSJoe Perches if (@nw > 2) { 246503372dbbSJoe Perches my $first = $nw[@nw - 3]; 246603372dbbSJoe Perches my $middle = $nw[@nw - 2]; 246703372dbbSJoe Perches my $last = $nw[@nw - 1]; 246803372dbbSJoe Perches 246903372dbbSJoe Perches if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 247003372dbbSJoe Perches (length($first) == 2 && substr($first, -1) eq ".")) || 247103372dbbSJoe Perches (length($middle) == 1 || 247203372dbbSJoe Perches (length($middle) == 2 && substr($middle, -1) eq "."))) { 247303372dbbSJoe Perches $name = "$first $middle $last"; 247403372dbbSJoe Perches } else { 247503372dbbSJoe Perches $name = "$middle $last"; 247603372dbbSJoe Perches } 247703372dbbSJoe Perches } 247803372dbbSJoe Perches 247903372dbbSJoe Perches if (substr($name, -1) =~ /[,\.]/) { 248003372dbbSJoe Perches $name = substr($name, 0, length($name) - 1); 248103372dbbSJoe Perches } elsif (substr($name, -2) =~ /[,\.]"/) { 248203372dbbSJoe Perches $name = substr($name, 0, length($name) - 2) . '"'; 248303372dbbSJoe Perches } 248403372dbbSJoe Perches 248503372dbbSJoe Perches if (substr($name, 0, 1) =~ /[,\.]/) { 248603372dbbSJoe Perches $name = substr($name, 1, length($name) - 1); 248703372dbbSJoe Perches } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 248803372dbbSJoe Perches $name = '"' . substr($name, 2, length($name) - 2); 248903372dbbSJoe Perches } 249003372dbbSJoe Perches 249103372dbbSJoe Perches my $fmt_email = format_email($name, $address, $email_usename); 249203372dbbSJoe Perches push(@fmt_emails, $fmt_email); 249303372dbbSJoe Perches } 249403372dbbSJoe Perches return @fmt_emails; 249503372dbbSJoe Perches} 249603372dbbSJoe Perches 24973c7385b8SJoe Perchessub merge_email { 24983c7385b8SJoe Perches my @lines; 24993c7385b8SJoe Perches my %saw; 25003c7385b8SJoe Perches 25013c7385b8SJoe Perches for (@_) { 25023c7385b8SJoe Perches my ($address, $role) = @$_; 25033c7385b8SJoe Perches if (!$saw{$address}) { 25043c7385b8SJoe Perches if ($output_roles) { 250560db31acSJoe Perches push(@lines, "$address ($role)"); 25063c7385b8SJoe Perches } else { 250760db31acSJoe Perches push(@lines, $address); 25083c7385b8SJoe Perches } 25093c7385b8SJoe Perches $saw{$address} = 1; 25103c7385b8SJoe Perches } 25113c7385b8SJoe Perches } 25123c7385b8SJoe Perches 25133c7385b8SJoe Perches return @lines; 25143c7385b8SJoe Perches} 25153c7385b8SJoe Perches 2516cb7301c7SJoe Perchessub output { 2517a8af2430SJoe Perches my (@parms) = @_; 2518cb7301c7SJoe Perches 2519cb7301c7SJoe Perches if ($output_multiline) { 2520cb7301c7SJoe Perches foreach my $line (@parms) { 2521cb7301c7SJoe Perches print("${line}\n"); 2522cb7301c7SJoe Perches } 2523cb7301c7SJoe Perches } else { 2524cb7301c7SJoe Perches print(join($output_separator, @parms)); 2525cb7301c7SJoe Perches print("\n"); 2526cb7301c7SJoe Perches } 2527cb7301c7SJoe Perches} 25281b5e1cf6SJoe Perches 25291b5e1cf6SJoe Perchesmy $rfc822re; 25301b5e1cf6SJoe Perches 25311b5e1cf6SJoe Perchessub make_rfc822re { 25321b5e1cf6SJoe Perches# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 25331b5e1cf6SJoe Perches# comment. We must allow for rfc822_lwsp (or comments) after each of these. 25341b5e1cf6SJoe Perches# This regexp will only work on addresses which have had comments stripped 25351b5e1cf6SJoe Perches# and replaced with rfc822_lwsp. 25361b5e1cf6SJoe Perches 25371b5e1cf6SJoe Perches my $specials = '()<>@,;:\\\\".\\[\\]'; 25381b5e1cf6SJoe Perches my $controls = '\\000-\\037\\177'; 25391b5e1cf6SJoe Perches 25401b5e1cf6SJoe Perches my $dtext = "[^\\[\\]\\r\\\\]"; 25411b5e1cf6SJoe Perches my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 25421b5e1cf6SJoe Perches 25431b5e1cf6SJoe Perches my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 25441b5e1cf6SJoe Perches 25451b5e1cf6SJoe Perches# Use zero-width assertion to spot the limit of an atom. A simple 25461b5e1cf6SJoe Perches# $rfc822_lwsp* causes the regexp engine to hang occasionally. 25471b5e1cf6SJoe Perches my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 25481b5e1cf6SJoe Perches my $word = "(?:$atom|$quoted_string)"; 25491b5e1cf6SJoe Perches my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 25501b5e1cf6SJoe Perches 25511b5e1cf6SJoe Perches my $sub_domain = "(?:$atom|$domain_literal)"; 25521b5e1cf6SJoe Perches my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 25531b5e1cf6SJoe Perches 25541b5e1cf6SJoe Perches my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 25551b5e1cf6SJoe Perches 25561b5e1cf6SJoe Perches my $phrase = "$word*"; 25571b5e1cf6SJoe Perches my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 25581b5e1cf6SJoe Perches my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 25591b5e1cf6SJoe Perches my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 25601b5e1cf6SJoe Perches 25611b5e1cf6SJoe Perches my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 25621b5e1cf6SJoe Perches my $address = "(?:$mailbox|$group)"; 25631b5e1cf6SJoe Perches 25641b5e1cf6SJoe Perches return "$rfc822_lwsp*$address"; 25651b5e1cf6SJoe Perches} 25661b5e1cf6SJoe Perches 25671b5e1cf6SJoe Perchessub rfc822_strip_comments { 25681b5e1cf6SJoe Perches my $s = shift; 25691b5e1cf6SJoe Perches# Recursively remove comments, and replace with a single space. The simpler 25701b5e1cf6SJoe Perches# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 25711b5e1cf6SJoe Perches# chars in atoms, for example. 25721b5e1cf6SJoe Perches 25731b5e1cf6SJoe Perches while ($s =~ s/^((?:[^"\\]|\\.)* 25741b5e1cf6SJoe Perches (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 25751b5e1cf6SJoe Perches \((?:[^()\\]|\\.)*\)/$1 /osx) {} 25761b5e1cf6SJoe Perches return $s; 25771b5e1cf6SJoe Perches} 25781b5e1cf6SJoe Perches 25791b5e1cf6SJoe Perches# valid: returns true if the parameter is an RFC822 valid address 25801b5e1cf6SJoe Perches# 258122dd5b0cSStephen Hemmingersub rfc822_valid { 25821b5e1cf6SJoe Perches my $s = rfc822_strip_comments(shift); 25831b5e1cf6SJoe Perches 25841b5e1cf6SJoe Perches if (!$rfc822re) { 25851b5e1cf6SJoe Perches $rfc822re = make_rfc822re(); 25861b5e1cf6SJoe Perches } 25871b5e1cf6SJoe Perches 25881b5e1cf6SJoe Perches return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 25891b5e1cf6SJoe Perches} 25901b5e1cf6SJoe Perches 25911b5e1cf6SJoe Perches# validlist: In scalar context, returns true if the parameter is an RFC822 25921b5e1cf6SJoe Perches# valid list of addresses. 25931b5e1cf6SJoe Perches# 25941b5e1cf6SJoe Perches# In list context, returns an empty list on failure (an invalid 25951b5e1cf6SJoe Perches# address was found); otherwise a list whose first element is the 25961b5e1cf6SJoe Perches# number of addresses found and whose remaining elements are the 25971b5e1cf6SJoe Perches# addresses. This is needed to disambiguate failure (invalid) 25981b5e1cf6SJoe Perches# from success with no addresses found, because an empty string is 25991b5e1cf6SJoe Perches# a valid list. 26001b5e1cf6SJoe Perches 260122dd5b0cSStephen Hemmingersub rfc822_validlist { 26021b5e1cf6SJoe Perches my $s = rfc822_strip_comments(shift); 26031b5e1cf6SJoe Perches 26041b5e1cf6SJoe Perches if (!$rfc822re) { 26051b5e1cf6SJoe Perches $rfc822re = make_rfc822re(); 26061b5e1cf6SJoe Perches } 26071b5e1cf6SJoe Perches # * null list items are valid according to the RFC 26081b5e1cf6SJoe Perches # * the '1' business is to aid in distinguishing failure from no results 26091b5e1cf6SJoe Perches 26101b5e1cf6SJoe Perches my @r; 26111b5e1cf6SJoe Perches if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 26121b5e1cf6SJoe Perches $s =~ m/^$rfc822_char*$/) { 26131b5e1cf6SJoe Perches while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 261460db31acSJoe Perches push(@r, $1); 26151b5e1cf6SJoe Perches } 26161b5e1cf6SJoe Perches return wantarray ? (scalar(@r), @r) : 1; 26171b5e1cf6SJoe Perches } 26181b5e1cf6SJoe Perches return wantarray ? () : 0; 26191b5e1cf6SJoe Perches} 2620