1b7d5a9c2SKamil Rytarowski#!/usr/bin/env perl 2c6a99b60SMichael S. Tsirkin# (c) 2007, Joe Perches <joe@perches.com> 3c6a99b60SMichael S. Tsirkin# created from checkpatch.pl 4c6a99b60SMichael S. Tsirkin# 5c6a99b60SMichael S. Tsirkin# Print selected MAINTAINERS information for 6c6a99b60SMichael S. Tsirkin# the files modified in a patch or for a file 7c6a99b60SMichael S. Tsirkin# 8c6a99b60SMichael S. Tsirkin# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 9c6a99b60SMichael S. Tsirkin# perl scripts/get_maintainer.pl [OPTIONS] -f <file> 10c6a99b60SMichael S. Tsirkin# 11c6a99b60SMichael S. Tsirkin# Licensed under the terms of the GNU GPL License version 2 12c6a99b60SMichael S. Tsirkin 13c6a99b60SMichael S. Tsirkinuse strict; 14b7d5a9c2SKamil Rytarowskiuse warnings; 15c6a99b60SMichael S. Tsirkin 16c6a99b60SMichael S. Tsirkinmy $P = $0; 17c6a99b60SMichael S. Tsirkinmy $V = '0.26'; 18c6a99b60SMichael S. Tsirkin 19c6a99b60SMichael S. Tsirkinuse Getopt::Long qw(:config no_auto_abbrev); 20c6a99b60SMichael S. Tsirkin 21c6a99b60SMichael S. Tsirkinmy $lk_path = "./"; 22c6a99b60SMichael S. Tsirkinmy $email = 1; 23c6a99b60SMichael S. Tsirkinmy $email_usename = 1; 24c6a99b60SMichael S. Tsirkinmy $email_maintainer = 1; 256668a2afSJoe Perchesmy $email_reviewer = 1; 26c6a99b60SMichael S. Tsirkinmy $email_list = 1; 27c6a99b60SMichael S. Tsirkinmy $email_subscriber_list = 0; 28c6a99b60SMichael S. Tsirkinmy $email_git = 0; 29c6a99b60SMichael S. Tsirkinmy $email_git_all_signature_types = 0; 30c6a99b60SMichael S. Tsirkinmy $email_git_blame = 0; 31c6a99b60SMichael S. Tsirkinmy $email_git_blame_signatures = 1; 32c6a99b60SMichael S. Tsirkinmy $email_git_fallback = 1; 33c6a99b60SMichael S. Tsirkinmy $email_git_min_signatures = 1; 34c6a99b60SMichael S. Tsirkinmy $email_git_max_maintainers = 5; 35c6a99b60SMichael S. Tsirkinmy $email_git_min_percent = 5; 36c6a99b60SMichael S. Tsirkinmy $email_git_since = "1-year-ago"; 37c6a99b60SMichael S. Tsirkinmy $email_hg_since = "-365"; 38c6a99b60SMichael S. Tsirkinmy $interactive = 0; 39c6a99b60SMichael S. Tsirkinmy $email_remove_duplicates = 1; 40c6a99b60SMichael S. Tsirkinmy $email_use_mailmap = 1; 41c6a99b60SMichael S. Tsirkinmy $output_multiline = 1; 42c6a99b60SMichael S. Tsirkinmy $output_separator = ", "; 43c6a99b60SMichael S. Tsirkinmy $output_roles = 0; 44c6a99b60SMichael S. Tsirkinmy $output_rolestats = 1; 45c6a99b60SMichael S. Tsirkinmy $scm = 0; 46c6a99b60SMichael S. Tsirkinmy $web = 0; 47c6a99b60SMichael S. Tsirkinmy $subsystem = 0; 48c6a99b60SMichael S. Tsirkinmy $status = 0; 49c6a99b60SMichael S. Tsirkinmy $keywords = 1; 50c6a99b60SMichael S. Tsirkinmy $sections = 0; 51c6a99b60SMichael S. Tsirkinmy $file_emails = 0; 52c6a99b60SMichael S. Tsirkinmy $from_filename = 0; 53c6a99b60SMichael S. Tsirkinmy $pattern_depth = 0; 54c6a99b60SMichael S. Tsirkinmy $version = 0; 55c6a99b60SMichael S. Tsirkinmy $help = 0; 56c6a99b60SMichael S. Tsirkin 57c6a99b60SMichael S. Tsirkinmy $vcs_used = 0; 58c6a99b60SMichael S. Tsirkin 59c6a99b60SMichael S. Tsirkinmy $exit = 0; 60c6a99b60SMichael S. Tsirkin 61c6a99b60SMichael S. Tsirkinmy %commit_author_hash; 62c6a99b60SMichael S. Tsirkinmy %commit_signer_hash; 63c6a99b60SMichael S. Tsirkin 64c6a99b60SMichael S. Tsirkin# Signature types of people who are either 65c6a99b60SMichael S. Tsirkin# a) responsible for the code in question, or 66c6a99b60SMichael S. Tsirkin# b) familiar enough with it to give relevant feedback 67c6a99b60SMichael S. Tsirkinmy @signature_tags = (); 68c6a99b60SMichael S. Tsirkinpush(@signature_tags, "Signed-off-by:"); 69c6a99b60SMichael S. Tsirkinpush(@signature_tags, "Reviewed-by:"); 70c6a99b60SMichael S. Tsirkinpush(@signature_tags, "Acked-by:"); 71c6a99b60SMichael S. Tsirkin 72c84a2b1aSMichael S. Tsirkinmy $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 73c84a2b1aSMichael S. Tsirkin 74c6a99b60SMichael S. Tsirkin# rfc822 email address - preloaded methods go here. 75c6a99b60SMichael S. Tsirkinmy $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 76c6a99b60SMichael S. Tsirkinmy $rfc822_char = '[\\000-\\377]'; 77c6a99b60SMichael S. Tsirkin 78c6a99b60SMichael S. Tsirkin# VCS command support: class-like functions and strings 79c6a99b60SMichael S. Tsirkin 80c6a99b60SMichael S. Tsirkinmy %VCS_cmds; 81c6a99b60SMichael S. Tsirkin 82c6a99b60SMichael S. Tsirkinmy %VCS_cmds_git = ( 83c6a99b60SMichael S. Tsirkin "execute_cmd" => \&git_execute_cmd, 84b73f059cSAlexey Kardashevskiy "available" => '(which("git") ne "") && (-e ".git")', 85c6a99b60SMichael S. Tsirkin "find_signers_cmd" => 86c84a2b1aSMichael S. Tsirkin "git log --no-color --follow --since=\$email_git_since " . 87c6a99b60SMichael S. Tsirkin '--format="GitCommit: %H%n' . 88c6a99b60SMichael S. Tsirkin 'GitAuthor: %an <%ae>%n' . 89c6a99b60SMichael S. Tsirkin 'GitDate: %aD%n' . 90c6a99b60SMichael S. Tsirkin 'GitSubject: %s%n' . 91c6a99b60SMichael S. Tsirkin '%b%n"' . 92c6a99b60SMichael S. Tsirkin " -- \$file", 93c6a99b60SMichael S. Tsirkin "find_commit_signers_cmd" => 94c6a99b60SMichael S. Tsirkin "git log --no-color " . 95c6a99b60SMichael S. Tsirkin '--format="GitCommit: %H%n' . 96c6a99b60SMichael S. Tsirkin 'GitAuthor: %an <%ae>%n' . 97c6a99b60SMichael S. Tsirkin 'GitDate: %aD%n' . 98c6a99b60SMichael S. Tsirkin 'GitSubject: %s%n' . 99c6a99b60SMichael S. Tsirkin '%b%n"' . 100c6a99b60SMichael S. Tsirkin " -1 \$commit", 101c6a99b60SMichael S. Tsirkin "find_commit_author_cmd" => 102c6a99b60SMichael S. Tsirkin "git log --no-color " . 103c6a99b60SMichael S. Tsirkin '--format="GitCommit: %H%n' . 104c6a99b60SMichael S. Tsirkin 'GitAuthor: %an <%ae>%n' . 105c6a99b60SMichael S. Tsirkin 'GitDate: %aD%n' . 106c6a99b60SMichael S. Tsirkin 'GitSubject: %s%n"' . 107c6a99b60SMichael S. Tsirkin " -1 \$commit", 108c6a99b60SMichael S. Tsirkin "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file", 109c6a99b60SMichael S. Tsirkin "blame_file_cmd" => "git blame -l \$file", 110c6a99b60SMichael S. Tsirkin "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})", 111c6a99b60SMichael S. Tsirkin "blame_commit_pattern" => "^([0-9a-f]+) ", 112c6a99b60SMichael S. Tsirkin "author_pattern" => "^GitAuthor: (.*)", 113c6a99b60SMichael S. Tsirkin "subject_pattern" => "^GitSubject: (.*)", 114c6a99b60SMichael S. Tsirkin); 115c6a99b60SMichael S. Tsirkin 116c6a99b60SMichael S. Tsirkinmy %VCS_cmds_hg = ( 117c6a99b60SMichael S. Tsirkin "execute_cmd" => \&hg_execute_cmd, 118c6a99b60SMichael S. Tsirkin "available" => '(which("hg") ne "") && (-d ".hg")', 119c6a99b60SMichael S. Tsirkin "find_signers_cmd" => 120c6a99b60SMichael S. Tsirkin "hg log --date=\$email_hg_since " . 121c6a99b60SMichael S. Tsirkin "--template='HgCommit: {node}\\n" . 122c6a99b60SMichael S. Tsirkin "HgAuthor: {author}\\n" . 123c6a99b60SMichael S. Tsirkin "HgSubject: {desc}\\n'" . 124c6a99b60SMichael S. Tsirkin " -- \$file", 125c6a99b60SMichael S. Tsirkin "find_commit_signers_cmd" => 126c6a99b60SMichael S. Tsirkin "hg log " . 127c6a99b60SMichael S. Tsirkin "--template='HgSubject: {desc}\\n'" . 128c6a99b60SMichael S. Tsirkin " -r \$commit", 129c6a99b60SMichael S. Tsirkin "find_commit_author_cmd" => 130c6a99b60SMichael S. Tsirkin "hg log " . 131c6a99b60SMichael S. Tsirkin "--template='HgCommit: {node}\\n" . 132c6a99b60SMichael S. Tsirkin "HgAuthor: {author}\\n" . 133c6a99b60SMichael S. Tsirkin "HgSubject: {desc|firstline}\\n'" . 134c6a99b60SMichael S. Tsirkin " -r \$commit", 135c6a99b60SMichael S. Tsirkin "blame_range_cmd" => "", # not supported 136c6a99b60SMichael S. Tsirkin "blame_file_cmd" => "hg blame -n \$file", 137c6a99b60SMichael S. Tsirkin "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})", 138c6a99b60SMichael S. Tsirkin "blame_commit_pattern" => "^([ 0-9a-f]+):", 139c6a99b60SMichael S. Tsirkin "author_pattern" => "^HgAuthor: (.*)", 140c6a99b60SMichael S. Tsirkin "subject_pattern" => "^HgSubject: (.*)", 141c6a99b60SMichael S. Tsirkin); 142c6a99b60SMichael S. Tsirkin 143c6a99b60SMichael S. Tsirkinmy $conf = which_conf(".get_maintainer.conf"); 144c6a99b60SMichael S. Tsirkinif (-f $conf) { 145c6a99b60SMichael S. Tsirkin my @conf_args; 146c6a99b60SMichael S. Tsirkin open(my $conffile, '<', "$conf") 147c6a99b60SMichael S. Tsirkin or warn "$P: Can't find a readable .get_maintainer.conf file $!\n"; 148c6a99b60SMichael S. Tsirkin 149c6a99b60SMichael S. Tsirkin while (<$conffile>) { 150c6a99b60SMichael S. Tsirkin my $line = $_; 151c6a99b60SMichael S. Tsirkin 152c6a99b60SMichael S. Tsirkin $line =~ s/\s*\n?$//g; 153c6a99b60SMichael S. Tsirkin $line =~ s/^\s*//g; 154c6a99b60SMichael S. Tsirkin $line =~ s/\s+/ /g; 155c6a99b60SMichael S. Tsirkin 156c6a99b60SMichael S. Tsirkin next if ($line =~ m/^\s*#/); 157c6a99b60SMichael S. Tsirkin next if ($line =~ m/^\s*$/); 158c6a99b60SMichael S. Tsirkin 159c6a99b60SMichael S. Tsirkin my @words = split(" ", $line); 160c6a99b60SMichael S. Tsirkin foreach my $word (@words) { 161c6a99b60SMichael S. Tsirkin last if ($word =~ m/^#/); 162c6a99b60SMichael S. Tsirkin push (@conf_args, $word); 163c6a99b60SMichael S. Tsirkin } 164c6a99b60SMichael S. Tsirkin } 165c6a99b60SMichael S. Tsirkin close($conffile); 166c6a99b60SMichael S. Tsirkin unshift(@ARGV, @conf_args) if @conf_args; 167c6a99b60SMichael S. Tsirkin} 168c6a99b60SMichael S. Tsirkin 169c6a99b60SMichael S. Tsirkinif (!GetOptions( 170c6a99b60SMichael S. Tsirkin 'email!' => \$email, 171c6a99b60SMichael S. Tsirkin 'git!' => \$email_git, 172c6a99b60SMichael S. Tsirkin 'git-all-signature-types!' => \$email_git_all_signature_types, 173c6a99b60SMichael S. Tsirkin 'git-blame!' => \$email_git_blame, 174c6a99b60SMichael S. Tsirkin 'git-blame-signatures!' => \$email_git_blame_signatures, 175c6a99b60SMichael S. Tsirkin 'git-fallback!' => \$email_git_fallback, 176c6a99b60SMichael S. Tsirkin 'git-min-signatures=i' => \$email_git_min_signatures, 177c6a99b60SMichael S. Tsirkin 'git-max-maintainers=i' => \$email_git_max_maintainers, 178c6a99b60SMichael S. Tsirkin 'git-min-percent=i' => \$email_git_min_percent, 179c6a99b60SMichael S. Tsirkin 'git-since=s' => \$email_git_since, 180c6a99b60SMichael S. Tsirkin 'hg-since=s' => \$email_hg_since, 181c6a99b60SMichael S. Tsirkin 'i|interactive!' => \$interactive, 182c6a99b60SMichael S. Tsirkin 'remove-duplicates!' => \$email_remove_duplicates, 183c6a99b60SMichael S. Tsirkin 'mailmap!' => \$email_use_mailmap, 184c6a99b60SMichael S. Tsirkin 'm!' => \$email_maintainer, 1856668a2afSJoe Perches 'r!' => \$email_reviewer, 186c6a99b60SMichael S. Tsirkin 'n!' => \$email_usename, 187c6a99b60SMichael S. Tsirkin 'l!' => \$email_list, 188c6a99b60SMichael S. Tsirkin 's!' => \$email_subscriber_list, 189c6a99b60SMichael S. Tsirkin 'multiline!' => \$output_multiline, 190c6a99b60SMichael S. Tsirkin 'roles!' => \$output_roles, 191c6a99b60SMichael S. Tsirkin 'rolestats!' => \$output_rolestats, 192c6a99b60SMichael S. Tsirkin 'separator=s' => \$output_separator, 193c6a99b60SMichael S. Tsirkin 'subsystem!' => \$subsystem, 194c6a99b60SMichael S. Tsirkin 'status!' => \$status, 195c6a99b60SMichael S. Tsirkin 'scm!' => \$scm, 196c6a99b60SMichael S. Tsirkin 'web!' => \$web, 197c6a99b60SMichael S. Tsirkin 'pattern-depth=i' => \$pattern_depth, 198c6a99b60SMichael S. Tsirkin 'k|keywords!' => \$keywords, 199c6a99b60SMichael S. Tsirkin 'sections!' => \$sections, 200c6a99b60SMichael S. Tsirkin 'fe|file-emails!' => \$file_emails, 201c6a99b60SMichael S. Tsirkin 'f|file' => \$from_filename, 202c6a99b60SMichael S. Tsirkin 'v|version' => \$version, 203c6a99b60SMichael S. Tsirkin 'h|help|usage' => \$help, 204c6a99b60SMichael S. Tsirkin )) { 205c6a99b60SMichael S. Tsirkin die "$P: invalid argument - use --help if necessary\n"; 206c6a99b60SMichael S. Tsirkin} 207c6a99b60SMichael S. Tsirkin 208c6a99b60SMichael S. Tsirkinif ($help != 0) { 209c6a99b60SMichael S. Tsirkin usage(); 210c6a99b60SMichael S. Tsirkin exit 0; 211c6a99b60SMichael S. Tsirkin} 212c6a99b60SMichael S. Tsirkin 213c6a99b60SMichael S. Tsirkinif ($version != 0) { 214c6a99b60SMichael S. Tsirkin print("${P} ${V}\n"); 215c6a99b60SMichael S. Tsirkin exit 0; 216c6a99b60SMichael S. Tsirkin} 217c6a99b60SMichael S. Tsirkin 218c6a99b60SMichael S. Tsirkinif (-t STDIN && !@ARGV) { 219c6a99b60SMichael S. Tsirkin # We're talking to a terminal, but have no command line arguments. 220c6a99b60SMichael S. Tsirkin die "$P: missing patchfile or -f file - use --help if necessary\n"; 221c6a99b60SMichael S. Tsirkin} 222c6a99b60SMichael S. Tsirkin 223c6a99b60SMichael S. Tsirkin$output_multiline = 0 if ($output_separator ne ", "); 224c6a99b60SMichael S. Tsirkin$output_rolestats = 1 if ($interactive); 225c6a99b60SMichael S. Tsirkin$output_roles = 1 if ($output_rolestats); 226c6a99b60SMichael S. Tsirkin 227c6a99b60SMichael S. Tsirkinif ($sections) { 228c6a99b60SMichael S. Tsirkin $email = 0; 229c6a99b60SMichael S. Tsirkin $email_list = 0; 230c6a99b60SMichael S. Tsirkin $scm = 0; 231c6a99b60SMichael S. Tsirkin $status = 0; 232c6a99b60SMichael S. Tsirkin $subsystem = 0; 233c6a99b60SMichael S. Tsirkin $web = 0; 234c6a99b60SMichael S. Tsirkin $keywords = 0; 235c6a99b60SMichael S. Tsirkin $interactive = 0; 236c6a99b60SMichael S. Tsirkin} else { 237c6a99b60SMichael S. Tsirkin my $selections = $email + $scm + $status + $subsystem + $web; 238c6a99b60SMichael S. Tsirkin if ($selections == 0) { 239c6a99b60SMichael S. Tsirkin die "$P: Missing required option: email, scm, status, subsystem or web\n"; 240c6a99b60SMichael S. Tsirkin } 241c6a99b60SMichael S. Tsirkin} 242c6a99b60SMichael S. Tsirkin 243c6a99b60SMichael S. Tsirkinif ($email && 2446668a2afSJoe Perches ($email_maintainer + $email_reviewer + 2456668a2afSJoe Perches $email_list + $email_subscriber_list + 24680b57ddaSThomas Huth $email_git + $email_git_blame) == 0) { 247c6a99b60SMichael S. Tsirkin die "$P: Please select at least 1 email option\n"; 248c6a99b60SMichael S. Tsirkin} 249c6a99b60SMichael S. Tsirkin 250990def58SMichael S. Tsirkinif (!top_of_tree($lk_path)) { 251c6a99b60SMichael S. Tsirkin die "$P: The current directory does not appear to be " 252990def58SMichael S. Tsirkin . "a QEMU source tree.\n"; 253c6a99b60SMichael S. Tsirkin} 254c6a99b60SMichael S. Tsirkin 255c6a99b60SMichael S. Tsirkin## Read MAINTAINERS for type/value pairs 256c6a99b60SMichael S. Tsirkin 257c6a99b60SMichael S. Tsirkinmy @typevalue = (); 258c6a99b60SMichael S. Tsirkinmy %keyword_hash; 259c6a99b60SMichael S. Tsirkin 260c6a99b60SMichael S. Tsirkinopen (my $maint, '<', "${lk_path}MAINTAINERS") 261c6a99b60SMichael S. Tsirkin or die "$P: Can't open MAINTAINERS: $!\n"; 262c6a99b60SMichael S. Tsirkinwhile (<$maint>) { 263c6a99b60SMichael S. Tsirkin my $line = $_; 264c6a99b60SMichael S. Tsirkin 265ba10f729SPaolo Bonzini if ($line =~ m/^(.):\s*(.*)/) { 266c6a99b60SMichael S. Tsirkin my $type = $1; 267c6a99b60SMichael S. Tsirkin my $value = $2; 268c6a99b60SMichael S. Tsirkin 269c6a99b60SMichael S. Tsirkin ##Filename pattern matching 270c6a99b60SMichael S. Tsirkin if ($type eq "F" || $type eq "X") { 271c6a99b60SMichael S. Tsirkin $value =~ s@\.@\\\.@g; ##Convert . to \. 272c6a99b60SMichael S. Tsirkin $value =~ s/\*/\.\*/g; ##Convert * to .* 273c6a99b60SMichael S. Tsirkin $value =~ s/\?/\./g; ##Convert ? to . 274c6a99b60SMichael S. Tsirkin ##if pattern is a directory and it lacks a trailing slash, add one 275c6a99b60SMichael S. Tsirkin if ((-d $value)) { 276c6a99b60SMichael S. Tsirkin $value =~ s@([^/])$@$1/@; 277c6a99b60SMichael S. Tsirkin } 278c6a99b60SMichael S. Tsirkin } elsif ($type eq "K") { 279c6a99b60SMichael S. Tsirkin $keyword_hash{@typevalue} = $value; 280c6a99b60SMichael S. Tsirkin } 281c6a99b60SMichael S. Tsirkin push(@typevalue, "$type:$value"); 282c6a99b60SMichael S. Tsirkin } elsif (!/^(\s)*$/) { 283c6a99b60SMichael S. Tsirkin $line =~ s/\n$//g; 284c6a99b60SMichael S. Tsirkin push(@typevalue, $line); 285c6a99b60SMichael S. Tsirkin } 286c6a99b60SMichael S. Tsirkin} 287c6a99b60SMichael S. Tsirkinclose($maint); 288c6a99b60SMichael S. Tsirkin 289c6a99b60SMichael S. Tsirkin 290c6a99b60SMichael S. Tsirkin# 291c6a99b60SMichael S. Tsirkin# Read mail address map 292c6a99b60SMichael S. Tsirkin# 293c6a99b60SMichael S. Tsirkin 294c6a99b60SMichael S. Tsirkinmy $mailmap; 295c6a99b60SMichael S. Tsirkin 296c6a99b60SMichael S. Tsirkinread_mailmap(); 297c6a99b60SMichael S. Tsirkin 298c6a99b60SMichael S. Tsirkinsub read_mailmap { 299c6a99b60SMichael S. Tsirkin $mailmap = { 300c6a99b60SMichael S. Tsirkin names => {}, 301c6a99b60SMichael S. Tsirkin addresses => {} 302c6a99b60SMichael S. Tsirkin }; 303c6a99b60SMichael S. Tsirkin 304c6a99b60SMichael S. Tsirkin return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap")); 305c6a99b60SMichael S. Tsirkin 306c6a99b60SMichael S. Tsirkin open(my $mailmap_file, '<', "${lk_path}.mailmap") 307c6a99b60SMichael S. Tsirkin or warn "$P: Can't open .mailmap: $!\n"; 308c6a99b60SMichael S. Tsirkin 309c6a99b60SMichael S. Tsirkin while (<$mailmap_file>) { 310c6a99b60SMichael S. Tsirkin s/#.*$//; #strip comments 311c6a99b60SMichael S. Tsirkin s/^\s+|\s+$//g; #trim 312c6a99b60SMichael S. Tsirkin 313c6a99b60SMichael S. Tsirkin next if (/^\s*$/); #skip empty lines 314c6a99b60SMichael S. Tsirkin #entries have one of the following formats: 315c6a99b60SMichael S. Tsirkin # name1 <mail1> 316c6a99b60SMichael S. Tsirkin # <mail1> <mail2> 317c6a99b60SMichael S. Tsirkin # name1 <mail1> <mail2> 318c6a99b60SMichael S. Tsirkin # name1 <mail1> name2 <mail2> 319c6a99b60SMichael S. Tsirkin # (see man git-shortlog) 320c84a2b1aSMichael S. Tsirkin 321c84a2b1aSMichael S. Tsirkin if (/^([^<]+)<([^>]+)>$/) { 322c6a99b60SMichael S. Tsirkin my $real_name = $1; 323c6a99b60SMichael S. Tsirkin my $address = $2; 324c6a99b60SMichael S. Tsirkin 325c6a99b60SMichael S. Tsirkin $real_name =~ s/\s+$//; 326c6a99b60SMichael S. Tsirkin ($real_name, $address) = parse_email("$real_name <$address>"); 327c6a99b60SMichael S. Tsirkin $mailmap->{names}->{$address} = $real_name; 328c6a99b60SMichael S. Tsirkin 329c84a2b1aSMichael S. Tsirkin } elsif (/^<([^>]+)>\s*<([^>]+)>$/) { 330c6a99b60SMichael S. Tsirkin my $real_address = $1; 331c6a99b60SMichael S. Tsirkin my $wrong_address = $2; 332c6a99b60SMichael S. Tsirkin 333c6a99b60SMichael S. Tsirkin $mailmap->{addresses}->{$wrong_address} = $real_address; 334c6a99b60SMichael S. Tsirkin 335c84a2b1aSMichael S. Tsirkin } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) { 336c6a99b60SMichael S. Tsirkin my $real_name = $1; 337c6a99b60SMichael S. Tsirkin my $real_address = $2; 338c6a99b60SMichael S. Tsirkin my $wrong_address = $3; 339c6a99b60SMichael S. Tsirkin 340c6a99b60SMichael S. Tsirkin $real_name =~ s/\s+$//; 341c6a99b60SMichael S. Tsirkin ($real_name, $real_address) = 342c6a99b60SMichael S. Tsirkin parse_email("$real_name <$real_address>"); 343c6a99b60SMichael S. Tsirkin $mailmap->{names}->{$wrong_address} = $real_name; 344c6a99b60SMichael S. Tsirkin $mailmap->{addresses}->{$wrong_address} = $real_address; 345c6a99b60SMichael S. Tsirkin 346c84a2b1aSMichael S. Tsirkin } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) { 347c6a99b60SMichael S. Tsirkin my $real_name = $1; 348c6a99b60SMichael S. Tsirkin my $real_address = $2; 349c6a99b60SMichael S. Tsirkin my $wrong_name = $3; 350c6a99b60SMichael S. Tsirkin my $wrong_address = $4; 351c6a99b60SMichael S. Tsirkin 352c6a99b60SMichael S. Tsirkin $real_name =~ s/\s+$//; 353c6a99b60SMichael S. Tsirkin ($real_name, $real_address) = 354c6a99b60SMichael S. Tsirkin parse_email("$real_name <$real_address>"); 355c6a99b60SMichael S. Tsirkin 356c6a99b60SMichael S. Tsirkin $wrong_name =~ s/\s+$//; 357c6a99b60SMichael S. Tsirkin ($wrong_name, $wrong_address) = 358c6a99b60SMichael S. Tsirkin parse_email("$wrong_name <$wrong_address>"); 359c6a99b60SMichael S. Tsirkin 360c6a99b60SMichael S. Tsirkin my $wrong_email = format_email($wrong_name, $wrong_address, 1); 361c6a99b60SMichael S. Tsirkin $mailmap->{names}->{$wrong_email} = $real_name; 362c6a99b60SMichael S. Tsirkin $mailmap->{addresses}->{$wrong_email} = $real_address; 363c6a99b60SMichael S. Tsirkin } 364c6a99b60SMichael S. Tsirkin } 365c6a99b60SMichael S. Tsirkin close($mailmap_file); 366c6a99b60SMichael S. Tsirkin} 367c6a99b60SMichael S. Tsirkin 368c6a99b60SMichael S. Tsirkin## use the filenames on the command line or find the filenames in the patchfiles 369c6a99b60SMichael S. Tsirkin 370c6a99b60SMichael S. Tsirkinmy @files = (); 371c6a99b60SMichael S. Tsirkinmy @range = (); 372c6a99b60SMichael S. Tsirkinmy @keyword_tvi = (); 373c6a99b60SMichael S. Tsirkinmy @file_emails = (); 374c6a99b60SMichael S. Tsirkin 375c6a99b60SMichael S. Tsirkinif (!@ARGV) { 376c6a99b60SMichael S. Tsirkin push(@ARGV, "&STDIN"); 377c6a99b60SMichael S. Tsirkin} 378c6a99b60SMichael S. Tsirkin 379c6a99b60SMichael S. Tsirkinforeach my $file (@ARGV) { 380c6a99b60SMichael S. Tsirkin if ($file ne "&STDIN") { 381c6a99b60SMichael S. Tsirkin ##if $file is a directory and it lacks a trailing slash, add one 382c6a99b60SMichael S. Tsirkin if ((-d $file)) { 383c6a99b60SMichael S. Tsirkin $file =~ s@([^/])$@$1/@; 38436b4cf19SIan Jackson } elsif (!(stat $file)) { 38536b4cf19SIan Jackson die "$P: file '${file}' not found: $!\n"; 386c6a99b60SMichael S. Tsirkin } 387c6a99b60SMichael S. Tsirkin } 388c6a99b60SMichael S. Tsirkin if ($from_filename) { 389c6a99b60SMichael S. Tsirkin push(@files, $file); 390c6a99b60SMichael S. Tsirkin if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) { 391c6a99b60SMichael S. Tsirkin open(my $f, '<', $file) 392c6a99b60SMichael S. Tsirkin or die "$P: Can't open $file: $!\n"; 393c6a99b60SMichael S. Tsirkin my $text = do { local($/) ; <$f> }; 394c6a99b60SMichael S. Tsirkin close($f); 395c6a99b60SMichael S. Tsirkin if ($keywords) { 396c6a99b60SMichael S. Tsirkin foreach my $line (keys %keyword_hash) { 397c6a99b60SMichael S. Tsirkin if ($text =~ m/$keyword_hash{$line}/x) { 398c6a99b60SMichael S. Tsirkin push(@keyword_tvi, $line); 399c6a99b60SMichael S. Tsirkin } 400c6a99b60SMichael S. Tsirkin } 401c6a99b60SMichael S. Tsirkin } 402c6a99b60SMichael S. Tsirkin if ($file_emails) { 403c6a99b60SMichael S. Tsirkin 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; 404c6a99b60SMichael S. Tsirkin push(@file_emails, clean_file_emails(@poss_addr)); 405c6a99b60SMichael S. Tsirkin } 406c6a99b60SMichael S. Tsirkin } 407c6a99b60SMichael S. Tsirkin } else { 408c6a99b60SMichael S. Tsirkin my $file_cnt = @files; 409c6a99b60SMichael S. Tsirkin my $lastfile; 410c6a99b60SMichael S. Tsirkin 411c6a99b60SMichael S. Tsirkin open(my $patch, "< $file") 412c6a99b60SMichael S. Tsirkin or die "$P: Can't open $file: $!\n"; 413c6a99b60SMichael S. Tsirkin 414c6a99b60SMichael S. Tsirkin # We can check arbitrary information before the patch 415c6a99b60SMichael S. Tsirkin # like the commit message, mail headers, etc... 416c6a99b60SMichael S. Tsirkin # This allows us to match arbitrary keywords against any part 417c6a99b60SMichael S. Tsirkin # of a git format-patch generated file (subject tags, etc...) 418c6a99b60SMichael S. Tsirkin 419c6a99b60SMichael S. Tsirkin my $patch_prefix = ""; #Parsing the intro 420c6a99b60SMichael S. Tsirkin 421c6a99b60SMichael S. Tsirkin while (<$patch>) { 422c6a99b60SMichael S. Tsirkin my $patch_line = $_; 423c6a99b60SMichael S. Tsirkin if (m/^\+\+\+\s+(\S+)/) { 424c6a99b60SMichael S. Tsirkin my $filename = $1; 425c6a99b60SMichael S. Tsirkin $filename =~ s@^[^/]*/@@; 426c6a99b60SMichael S. Tsirkin $filename =~ s@\n@@; 427c6a99b60SMichael S. Tsirkin $lastfile = $filename; 428c6a99b60SMichael S. Tsirkin push(@files, $filename); 429c6a99b60SMichael S. Tsirkin $patch_prefix = "^[+-].*"; #Now parsing the actual patch 430c6a99b60SMichael S. Tsirkin } elsif (m/^\@\@ -(\d+),(\d+)/) { 431c6a99b60SMichael S. Tsirkin if ($email_git_blame) { 432c6a99b60SMichael S. Tsirkin push(@range, "$lastfile:$1:$2"); 433c6a99b60SMichael S. Tsirkin } 434c6a99b60SMichael S. Tsirkin } elsif ($keywords) { 435c6a99b60SMichael S. Tsirkin foreach my $line (keys %keyword_hash) { 436c6a99b60SMichael S. Tsirkin if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) { 437c6a99b60SMichael S. Tsirkin push(@keyword_tvi, $line); 438c6a99b60SMichael S. Tsirkin } 439c6a99b60SMichael S. Tsirkin } 440c6a99b60SMichael S. Tsirkin } 441c6a99b60SMichael S. Tsirkin } 442c6a99b60SMichael S. Tsirkin close($patch); 443c6a99b60SMichael S. Tsirkin 444c6a99b60SMichael S. Tsirkin if ($file_cnt == @files) { 445c6a99b60SMichael S. Tsirkin warn "$P: file '${file}' doesn't appear to be a patch. " 446c6a99b60SMichael S. Tsirkin . "Add -f to options?\n"; 447c6a99b60SMichael S. Tsirkin } 448c6a99b60SMichael S. Tsirkin @files = sort_and_uniq(@files); 449c6a99b60SMichael S. Tsirkin } 450c6a99b60SMichael S. Tsirkin} 451c6a99b60SMichael S. Tsirkin 452c6a99b60SMichael S. Tsirkin@file_emails = uniq(@file_emails); 453c6a99b60SMichael S. Tsirkin 454c6a99b60SMichael S. Tsirkinmy %email_hash_name; 455c6a99b60SMichael S. Tsirkinmy %email_hash_address; 456c6a99b60SMichael S. Tsirkinmy @email_to = (); 457c6a99b60SMichael S. Tsirkinmy %hash_list_to; 458c6a99b60SMichael S. Tsirkinmy @list_to = (); 459c6a99b60SMichael S. Tsirkinmy @scm = (); 460c6a99b60SMichael S. Tsirkinmy @web = (); 461c6a99b60SMichael S. Tsirkinmy @subsystem = (); 462c6a99b60SMichael S. Tsirkinmy @status = (); 463c6a99b60SMichael S. Tsirkinmy %deduplicate_name_hash = (); 464c6a99b60SMichael S. Tsirkinmy %deduplicate_address_hash = (); 465c6a99b60SMichael S. Tsirkin 466c6a99b60SMichael S. Tsirkinmy @maintainers = get_maintainers(); 467c6a99b60SMichael S. Tsirkin 468c6a99b60SMichael S. Tsirkinif (@maintainers) { 469c6a99b60SMichael S. Tsirkin @maintainers = merge_email(@maintainers); 470c6a99b60SMichael S. Tsirkin output(@maintainers); 471c6a99b60SMichael S. Tsirkin} 472c6a99b60SMichael S. Tsirkin 473c6a99b60SMichael S. Tsirkinif ($scm) { 474c6a99b60SMichael S. Tsirkin @scm = uniq(@scm); 475c6a99b60SMichael S. Tsirkin output(@scm); 476c6a99b60SMichael S. Tsirkin} 477c6a99b60SMichael S. Tsirkin 478c6a99b60SMichael S. Tsirkinif ($status) { 479c6a99b60SMichael S. Tsirkin @status = uniq(@status); 480c6a99b60SMichael S. Tsirkin output(@status); 481c6a99b60SMichael S. Tsirkin} 482c6a99b60SMichael S. Tsirkin 483c6a99b60SMichael S. Tsirkinif ($subsystem) { 484c6a99b60SMichael S. Tsirkin @subsystem = uniq(@subsystem); 485c6a99b60SMichael S. Tsirkin output(@subsystem); 486c6a99b60SMichael S. Tsirkin} 487c6a99b60SMichael S. Tsirkin 488c6a99b60SMichael S. Tsirkinif ($web) { 489c6a99b60SMichael S. Tsirkin @web = uniq(@web); 490c6a99b60SMichael S. Tsirkin output(@web); 491c6a99b60SMichael S. Tsirkin} 492c6a99b60SMichael S. Tsirkin 493c6a99b60SMichael S. Tsirkinexit($exit); 494c6a99b60SMichael S. Tsirkin 495c6a99b60SMichael S. Tsirkinsub range_is_maintained { 496c6a99b60SMichael S. Tsirkin my ($start, $end) = @_; 497c6a99b60SMichael S. Tsirkin 498c6a99b60SMichael S. Tsirkin for (my $i = $start; $i < $end; $i++) { 499c6a99b60SMichael S. Tsirkin my $line = $typevalue[$i]; 500ba10f729SPaolo Bonzini if ($line =~ m/^(.):\s*(.*)/) { 501c6a99b60SMichael S. Tsirkin my $type = $1; 502c6a99b60SMichael S. Tsirkin my $value = $2; 503c6a99b60SMichael S. Tsirkin if ($type eq 'S') { 504c6a99b60SMichael S. Tsirkin if ($value =~ /(maintain|support)/i) { 505c6a99b60SMichael S. Tsirkin return 1; 506c6a99b60SMichael S. Tsirkin } 507c6a99b60SMichael S. Tsirkin } 508c6a99b60SMichael S. Tsirkin } 509c6a99b60SMichael S. Tsirkin } 510c6a99b60SMichael S. Tsirkin return 0; 511c6a99b60SMichael S. Tsirkin} 512c6a99b60SMichael S. Tsirkin 513c6a99b60SMichael S. Tsirkinsub range_has_maintainer { 514c6a99b60SMichael S. Tsirkin my ($start, $end) = @_; 515c6a99b60SMichael S. Tsirkin 516c6a99b60SMichael S. Tsirkin for (my $i = $start; $i < $end; $i++) { 517c6a99b60SMichael S. Tsirkin my $line = $typevalue[$i]; 518ba10f729SPaolo Bonzini if ($line =~ m/^(.):\s*(.*)/) { 519c6a99b60SMichael S. Tsirkin my $type = $1; 520c6a99b60SMichael S. Tsirkin my $value = $2; 521c6a99b60SMichael S. Tsirkin if ($type eq 'M') { 522c6a99b60SMichael S. Tsirkin return 1; 523c6a99b60SMichael S. Tsirkin } 524c6a99b60SMichael S. Tsirkin } 525c6a99b60SMichael S. Tsirkin } 526c6a99b60SMichael S. Tsirkin return 0; 527c6a99b60SMichael S. Tsirkin} 528c6a99b60SMichael S. Tsirkin 529c6a99b60SMichael S. Tsirkinsub get_maintainers { 530c6a99b60SMichael S. Tsirkin %email_hash_name = (); 531c6a99b60SMichael S. Tsirkin %email_hash_address = (); 532c6a99b60SMichael S. Tsirkin %commit_author_hash = (); 533c6a99b60SMichael S. Tsirkin %commit_signer_hash = (); 534c6a99b60SMichael S. Tsirkin @email_to = (); 535c6a99b60SMichael S. Tsirkin %hash_list_to = (); 536c6a99b60SMichael S. Tsirkin @list_to = (); 537c6a99b60SMichael S. Tsirkin @scm = (); 538c6a99b60SMichael S. Tsirkin @web = (); 539c6a99b60SMichael S. Tsirkin @subsystem = (); 540c6a99b60SMichael S. Tsirkin @status = (); 541c6a99b60SMichael S. Tsirkin %deduplicate_name_hash = (); 542c6a99b60SMichael S. Tsirkin %deduplicate_address_hash = (); 543c6a99b60SMichael S. Tsirkin if ($email_git_all_signature_types) { 544c6a99b60SMichael S. Tsirkin $signature_pattern = "(.+?)[Bb][Yy]:"; 545c6a99b60SMichael S. Tsirkin } else { 546c6a99b60SMichael S. Tsirkin $signature_pattern = "\(" . join("|", @signature_tags) . "\)"; 547c6a99b60SMichael S. Tsirkin } 548c6a99b60SMichael S. Tsirkin 549c6a99b60SMichael S. Tsirkin # Find responsible parties 550c6a99b60SMichael S. Tsirkin 551c6a99b60SMichael S. Tsirkin my %exact_pattern_match_hash = (); 552c6a99b60SMichael S. Tsirkin 553c6a99b60SMichael S. Tsirkin foreach my $file (@files) { 554c6a99b60SMichael S. Tsirkin 555c6a99b60SMichael S. Tsirkin my %hash; 556c6a99b60SMichael S. Tsirkin my $tvi = find_first_section(); 557c6a99b60SMichael S. Tsirkin while ($tvi < @typevalue) { 558c6a99b60SMichael S. Tsirkin my $start = find_starting_index($tvi); 559c6a99b60SMichael S. Tsirkin my $end = find_ending_index($tvi); 560c6a99b60SMichael S. Tsirkin my $exclude = 0; 561c6a99b60SMichael S. Tsirkin my $i; 562c6a99b60SMichael S. Tsirkin 563c6a99b60SMichael S. Tsirkin #Do not match excluded file patterns 564c6a99b60SMichael S. Tsirkin 565c6a99b60SMichael S. Tsirkin for ($i = $start; $i < $end; $i++) { 566c6a99b60SMichael S. Tsirkin my $line = $typevalue[$i]; 567ba10f729SPaolo Bonzini if ($line =~ m/^(.):\s*(.*)/) { 568c6a99b60SMichael S. Tsirkin my $type = $1; 569c6a99b60SMichael S. Tsirkin my $value = $2; 570c6a99b60SMichael S. Tsirkin if ($type eq 'X') { 571c6a99b60SMichael S. Tsirkin if (file_match_pattern($file, $value)) { 572c6a99b60SMichael S. Tsirkin $exclude = 1; 573c6a99b60SMichael S. Tsirkin last; 574c6a99b60SMichael S. Tsirkin } 575c6a99b60SMichael S. Tsirkin } 576c6a99b60SMichael S. Tsirkin } 577c6a99b60SMichael S. Tsirkin } 578c6a99b60SMichael S. Tsirkin 579c6a99b60SMichael S. Tsirkin if (!$exclude) { 580c6a99b60SMichael S. Tsirkin for ($i = $start; $i < $end; $i++) { 581c6a99b60SMichael S. Tsirkin my $line = $typevalue[$i]; 582ba10f729SPaolo Bonzini if ($line =~ m/^(.):\s*(.*)/) { 583c6a99b60SMichael S. Tsirkin my $type = $1; 584c6a99b60SMichael S. Tsirkin my $value = $2; 585c6a99b60SMichael S. Tsirkin if ($type eq 'F') { 586c6a99b60SMichael S. Tsirkin if (file_match_pattern($file, $value)) { 587c6a99b60SMichael S. Tsirkin my $value_pd = ($value =~ tr@/@@); 588c6a99b60SMichael S. Tsirkin my $file_pd = ($file =~ tr@/@@); 589c6a99b60SMichael S. Tsirkin $value_pd++ if (substr($value,-1,1) ne "/"); 590c6a99b60SMichael S. Tsirkin $value_pd = -1 if ($value =~ /^\.\*/); 591c6a99b60SMichael S. Tsirkin if ($value_pd >= $file_pd && 592c6a99b60SMichael S. Tsirkin range_is_maintained($start, $end) && 593c6a99b60SMichael S. Tsirkin range_has_maintainer($start, $end)) { 594c6a99b60SMichael S. Tsirkin $exact_pattern_match_hash{$file} = 1; 595c6a99b60SMichael S. Tsirkin } 596c6a99b60SMichael S. Tsirkin if ($pattern_depth == 0 || 597c6a99b60SMichael S. Tsirkin (($file_pd - $value_pd) < $pattern_depth)) { 598c6a99b60SMichael S. Tsirkin $hash{$tvi} = $value_pd; 599c6a99b60SMichael S. Tsirkin } 600c6a99b60SMichael S. Tsirkin } 601c6a99b60SMichael S. Tsirkin } 602c6a99b60SMichael S. Tsirkin } 603c6a99b60SMichael S. Tsirkin } 604c6a99b60SMichael S. Tsirkin } 605c6a99b60SMichael S. Tsirkin $tvi = $end + 1; 606c6a99b60SMichael S. Tsirkin } 607c6a99b60SMichael S. Tsirkin 608c6a99b60SMichael S. Tsirkin foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 609c6a99b60SMichael S. Tsirkin add_categories($line); 610c6a99b60SMichael S. Tsirkin if ($sections) { 611c6a99b60SMichael S. Tsirkin my $i; 612c6a99b60SMichael S. Tsirkin my $start = find_starting_index($line); 613c6a99b60SMichael S. Tsirkin my $end = find_ending_index($line); 614c6a99b60SMichael S. Tsirkin for ($i = $start; $i < $end; $i++) { 615c6a99b60SMichael S. Tsirkin my $line = $typevalue[$i]; 616c6a99b60SMichael S. Tsirkin if ($line =~ /^[FX]:/) { ##Restore file patterns 617c6a99b60SMichael S. Tsirkin $line =~ s/([^\\])\.([^\*])/$1\?$2/g; 618c6a99b60SMichael S. Tsirkin $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ? 619c6a99b60SMichael S. Tsirkin $line =~ s/\\\./\./g; ##Convert \. to . 620c6a99b60SMichael S. Tsirkin $line =~ s/\.\*/\*/g; ##Convert .* to * 621c6a99b60SMichael S. Tsirkin } 622c6a99b60SMichael S. Tsirkin $line =~ s/^([A-Z]):/$1:\t/g; 623c6a99b60SMichael S. Tsirkin print("$line\n"); 624c6a99b60SMichael S. Tsirkin } 625c6a99b60SMichael S. Tsirkin print("\n"); 626c6a99b60SMichael S. Tsirkin } 627c6a99b60SMichael S. Tsirkin } 628c6a99b60SMichael S. Tsirkin } 629c6a99b60SMichael S. Tsirkin 630c6a99b60SMichael S. Tsirkin if ($keywords) { 631c6a99b60SMichael S. Tsirkin @keyword_tvi = sort_and_uniq(@keyword_tvi); 632c6a99b60SMichael S. Tsirkin foreach my $line (@keyword_tvi) { 633c6a99b60SMichael S. Tsirkin add_categories($line); 634c6a99b60SMichael S. Tsirkin } 635c6a99b60SMichael S. Tsirkin } 636c6a99b60SMichael S. Tsirkin 637c6a99b60SMichael S. Tsirkin foreach my $email (@email_to, @list_to) { 638c6a99b60SMichael S. Tsirkin $email->[0] = deduplicate_email($email->[0]); 639c6a99b60SMichael S. Tsirkin } 640c6a99b60SMichael S. Tsirkin 6418ad2c0f0SPaolo Bonzini if ($email) { 642c6561586SPaolo Bonzini if (! $interactive) { 6434db84796SPaolo Bonzini $email_git_fallback = 0 if @email_to > 0 || $email_git || $email_git_blame; 644c6561586SPaolo Bonzini if ($email_git_fallback) { 645c6561586SPaolo Bonzini print STDERR "get_maintainer.pl: No maintainers found, printing recent contributors.\n"; 646c6561586SPaolo Bonzini print STDERR "get_maintainer.pl: Do not blindly cc: them on patches! Use common sense.\n"; 647c6561586SPaolo Bonzini print STDERR "\n"; 648c6561586SPaolo Bonzini } 649c6561586SPaolo Bonzini } 650c6561586SPaolo Bonzini 651c6a99b60SMichael S. Tsirkin foreach my $file (@files) { 6528ad2c0f0SPaolo Bonzini if ($email_git || ($email_git_fallback && 6538ad2c0f0SPaolo Bonzini !$exact_pattern_match_hash{$file})) { 654c6a99b60SMichael S. Tsirkin vcs_file_signoffs($file); 655c6a99b60SMichael S. Tsirkin } 6568ad2c0f0SPaolo Bonzini if ($email_git_blame) { 657c6a99b60SMichael S. Tsirkin vcs_file_blame($file); 658c6a99b60SMichael S. Tsirkin } 659c6a99b60SMichael S. Tsirkin } 660c6a99b60SMichael S. Tsirkin 661c6a99b60SMichael S. Tsirkin foreach my $email (@file_emails) { 662c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($email); 663c6a99b60SMichael S. Tsirkin 664c6a99b60SMichael S. Tsirkin my $tmp_email = format_email($name, $address, $email_usename); 665c6a99b60SMichael S. Tsirkin push_email_address($tmp_email, ''); 666c6a99b60SMichael S. Tsirkin add_role($tmp_email, 'in file'); 667c6a99b60SMichael S. Tsirkin } 668c6a99b60SMichael S. Tsirkin } 669c6a99b60SMichael S. Tsirkin 670c6a99b60SMichael S. Tsirkin my @to = (); 671c6a99b60SMichael S. Tsirkin if ($email || $email_list) { 672c6a99b60SMichael S. Tsirkin if ($email) { 673c6a99b60SMichael S. Tsirkin @to = (@to, @email_to); 674c6a99b60SMichael S. Tsirkin } 675c6a99b60SMichael S. Tsirkin if ($email_list) { 676c6a99b60SMichael S. Tsirkin @to = (@to, @list_to); 677c6a99b60SMichael S. Tsirkin } 678c6a99b60SMichael S. Tsirkin } 679c6a99b60SMichael S. Tsirkin 680c6a99b60SMichael S. Tsirkin if ($interactive) { 681c6a99b60SMichael S. Tsirkin @to = interactive_get_maintainers(\@to); 682c6a99b60SMichael S. Tsirkin } 683c6a99b60SMichael S. Tsirkin 684c6a99b60SMichael S. Tsirkin return @to; 685c6a99b60SMichael S. Tsirkin} 686c6a99b60SMichael S. Tsirkin 687c6a99b60SMichael S. Tsirkinsub file_match_pattern { 688c6a99b60SMichael S. Tsirkin my ($file, $pattern) = @_; 689c6a99b60SMichael S. Tsirkin if (substr($pattern, -1) eq "/") { 690c6a99b60SMichael S. Tsirkin if ($file =~ m@^$pattern@) { 691c6a99b60SMichael S. Tsirkin return 1; 692c6a99b60SMichael S. Tsirkin } 693c6a99b60SMichael S. Tsirkin } else { 694c6a99b60SMichael S. Tsirkin if ($file =~ m@^$pattern@) { 695c6a99b60SMichael S. Tsirkin my $s1 = ($file =~ tr@/@@); 696c6a99b60SMichael S. Tsirkin my $s2 = ($pattern =~ tr@/@@); 697c6a99b60SMichael S. Tsirkin if ($s1 == $s2) { 698c6a99b60SMichael S. Tsirkin return 1; 699c6a99b60SMichael S. Tsirkin } 700c6a99b60SMichael S. Tsirkin } 701c6a99b60SMichael S. Tsirkin } 702c6a99b60SMichael S. Tsirkin return 0; 703c6a99b60SMichael S. Tsirkin} 704c6a99b60SMichael S. Tsirkin 705c6a99b60SMichael S. Tsirkinsub usage { 706c6a99b60SMichael S. Tsirkin print <<EOT; 707c6a99b60SMichael S. Tsirkinusage: $P [options] patchfile 708c6a99b60SMichael S. Tsirkin $P [options] -f file|directory 709c6a99b60SMichael S. Tsirkinversion: $V 710c6a99b60SMichael S. Tsirkin 711c6a99b60SMichael S. TsirkinMAINTAINER field selection options: 712c6a99b60SMichael S. Tsirkin --email => print email address(es) if any 713c6a99b60SMichael S. Tsirkin --git => include recent git \*-by: signers 714c6a99b60SMichael S. Tsirkin --git-all-signature-types => include signers regardless of signature type 715c6a99b60SMichael S. Tsirkin or use only ${signature_pattern} signers (default: $email_git_all_signature_types) 716c6a99b60SMichael S. Tsirkin --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback) 717c6a99b60SMichael S. Tsirkin --git-min-signatures => number of signatures required (default: $email_git_min_signatures) 718c6a99b60SMichael S. Tsirkin --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers) 719c6a99b60SMichael S. Tsirkin --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent) 720c6a99b60SMichael S. Tsirkin --git-blame => use git blame to find modified commits for patch or file 721c6a99b60SMichael S. Tsirkin --git-since => git history to use (default: $email_git_since) 722c6a99b60SMichael S. Tsirkin --hg-since => hg history to use (default: $email_hg_since) 723c6a99b60SMichael S. Tsirkin --interactive => display a menu (mostly useful if used with the --git option) 724c6a99b60SMichael S. Tsirkin --m => include maintainer(s) if any 7256668a2afSJoe Perches --r => include reviewer(s) if any 726c6a99b60SMichael S. Tsirkin --n => include name 'Full Name <addr\@domain.tld>' 727c6a99b60SMichael S. Tsirkin --l => include list(s) if any 728c6a99b60SMichael S. Tsirkin --s => include subscriber only list(s) if any 729c6a99b60SMichael S. Tsirkin --remove-duplicates => minimize duplicate email names/addresses 730c6a99b60SMichael S. Tsirkin --roles => show roles (status:subsystem, git-signer, list, etc...) 731c6a99b60SMichael S. Tsirkin --rolestats => show roles and statistics (commits/total_commits, %) 732c6a99b60SMichael S. Tsirkin --file-emails => add email addresses found in -f file (default: 0 (off)) 733c6a99b60SMichael S. Tsirkin --scm => print SCM tree(s) if any 734c6a99b60SMichael S. Tsirkin --status => print status if any 735c6a99b60SMichael S. Tsirkin --subsystem => print subsystem name if any 736c6a99b60SMichael S. Tsirkin --web => print website(s) if any 737c6a99b60SMichael S. Tsirkin 738c6a99b60SMichael S. TsirkinOutput type options: 739c6a99b60SMichael S. Tsirkin --separator [, ] => separator for multiple entries on 1 line 740c6a99b60SMichael S. Tsirkin using --separator also sets --nomultiline if --separator is not [, ] 741c6a99b60SMichael S. Tsirkin --multiline => print 1 entry per line 742c6a99b60SMichael S. Tsirkin 743c6a99b60SMichael S. TsirkinOther options: 744c6a99b60SMichael S. Tsirkin --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 745c6a99b60SMichael S. Tsirkin --keywords => scan patch for keywords (default: $keywords) 746c6a99b60SMichael S. Tsirkin --sections => print all of the subsystem sections with pattern matches 747c6a99b60SMichael S. Tsirkin --mailmap => use .mailmap file (default: $email_use_mailmap) 748c6a99b60SMichael S. Tsirkin --version => show version 749c6a99b60SMichael S. Tsirkin --help => show this help information 750c6a99b60SMichael S. Tsirkin 751c6a99b60SMichael S. TsirkinDefault options: 7529ff3a5e6SBrian Norris [--email --nogit --git-fallback --m --r --n --l --multiline --pattern-depth=0 753c6a99b60SMichael S. Tsirkin --remove-duplicates --rolestats] 754c6a99b60SMichael S. Tsirkin 755c6a99b60SMichael S. TsirkinNotes: 756c6a99b60SMichael S. Tsirkin Using "-f directory" may give unexpected results: 757c6a99b60SMichael S. Tsirkin Used with "--git", git signators for _all_ files in and below 758c6a99b60SMichael S. Tsirkin directory are examined as git recurses directories. 759c6a99b60SMichael S. Tsirkin Any specified X: (exclude) pattern matches are _not_ ignored. 760c6a99b60SMichael S. Tsirkin Used with "--nogit", directory is used as a pattern match, 761c6a99b60SMichael S. Tsirkin no individual file within the directory or subdirectory 762c6a99b60SMichael S. Tsirkin is matched. 763c6a99b60SMichael S. Tsirkin Used with "--git-blame", does not iterate all files in directory 764c6a99b60SMichael S. Tsirkin Using "--git-blame" is slow and may add old committers and authors 765c6a99b60SMichael S. Tsirkin that are no longer active maintainers to the output. 766c6a99b60SMichael S. Tsirkin Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 767c6a99b60SMichael S. Tsirkin other automated tools that expect only ["name"] <email address> 768c6a99b60SMichael S. Tsirkin may not work because of additional output after <email address>. 769c6a99b60SMichael S. Tsirkin Using "--rolestats" and "--git-blame" shows the #/total=% commits, 770c6a99b60SMichael S. Tsirkin not the percentage of the entire file authored. # of commits is 771c6a99b60SMichael S. Tsirkin not a good measure of amount of code authored. 1 major commit may 772c6a99b60SMichael S. Tsirkin contain a thousand lines, 5 trivial commits may modify a single line. 773c6a99b60SMichael S. Tsirkin If git is not installed, but mercurial (hg) is installed and an .hg 774c6a99b60SMichael S. Tsirkin repository exists, the following options apply to mercurial: 775c6a99b60SMichael S. Tsirkin --git, 776c6a99b60SMichael S. Tsirkin --git-min-signatures, --git-max-maintainers, --git-min-percent, and 777c6a99b60SMichael S. Tsirkin --git-blame 778c6a99b60SMichael S. Tsirkin Use --hg-since not --git-since to control date selection 779990def58SMichael S. Tsirkin File ".get_maintainer.conf", if it exists in the QEMU source root 780c6a99b60SMichael S. Tsirkin directory, can change whatever get_maintainer defaults are desired. 781c6a99b60SMichael S. Tsirkin Entries in this file can be any command line argument. 782c6a99b60SMichael S. Tsirkin This file is prepended to any additional command line arguments. 783c6a99b60SMichael S. Tsirkin Multiple lines and # comments are allowed. 784c6a99b60SMichael S. TsirkinEOT 785c6a99b60SMichael S. Tsirkin} 786c6a99b60SMichael S. Tsirkin 787990def58SMichael S. Tsirkinsub top_of_tree { 788c6a99b60SMichael S. Tsirkin my ($lk_path) = @_; 789c6a99b60SMichael S. Tsirkin 790c6a99b60SMichael S. Tsirkin if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 791c6a99b60SMichael S. Tsirkin $lk_path .= "/"; 792c6a99b60SMichael S. Tsirkin } 793c6a99b60SMichael S. Tsirkin if ( (-f "${lk_path}COPYING") 794c6a99b60SMichael S. Tsirkin && (-f "${lk_path}MAINTAINERS") 795c6a99b60SMichael S. Tsirkin && (-f "${lk_path}Makefile") 796990def58SMichael S. Tsirkin && (-d "${lk_path}docs") 797990def58SMichael S. Tsirkin && (-f "${lk_path}VERSION") 798bac068e0SAlexander Bulekov && (-d "${lk_path}linux-user/") 7998d7f2e76SPhilippe Mathieu-Daudé && (-d "${lk_path}system/")) { 800c6a99b60SMichael S. Tsirkin return 1; 801c6a99b60SMichael S. Tsirkin } 802c6a99b60SMichael S. Tsirkin return 0; 803c6a99b60SMichael S. Tsirkin} 804c6a99b60SMichael S. Tsirkin 805c6a99b60SMichael S. Tsirkinsub parse_email { 806c6a99b60SMichael S. Tsirkin my ($formatted_email) = @_; 807c6a99b60SMichael S. Tsirkin 808c6a99b60SMichael S. Tsirkin my $name = ""; 809c6a99b60SMichael S. Tsirkin my $address = ""; 810c6a99b60SMichael S. Tsirkin 811c6a99b60SMichael S. Tsirkin if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 812c6a99b60SMichael S. Tsirkin $name = $1; 813c6a99b60SMichael S. Tsirkin $address = $2; 814c6a99b60SMichael S. Tsirkin } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 815c6a99b60SMichael S. Tsirkin $address = $1; 816c6a99b60SMichael S. Tsirkin } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 817c6a99b60SMichael S. Tsirkin $address = $1; 818c6a99b60SMichael S. Tsirkin } 819c6a99b60SMichael S. Tsirkin 820c6a99b60SMichael S. Tsirkin $name =~ s/^\s+|\s+$//g; 821c6a99b60SMichael S. Tsirkin $name =~ s/^\"|\"$//g; 822c6a99b60SMichael S. Tsirkin $address =~ s/^\s+|\s+$//g; 823c6a99b60SMichael S. Tsirkin 824c6a99b60SMichael S. Tsirkin if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 825c6a99b60SMichael S. Tsirkin $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 826c6a99b60SMichael S. Tsirkin $name = "\"$name\""; 827c6a99b60SMichael S. Tsirkin } 828c6a99b60SMichael S. Tsirkin 829c6a99b60SMichael S. Tsirkin return ($name, $address); 830c6a99b60SMichael S. Tsirkin} 831c6a99b60SMichael S. Tsirkin 832c6a99b60SMichael S. Tsirkinsub format_email { 833c6a99b60SMichael S. Tsirkin my ($name, $address, $usename) = @_; 834c6a99b60SMichael S. Tsirkin 835c6a99b60SMichael S. Tsirkin my $formatted_email; 836c6a99b60SMichael S. Tsirkin 837c6a99b60SMichael S. Tsirkin $name =~ s/^\s+|\s+$//g; 838c6a99b60SMichael S. Tsirkin $name =~ s/^\"|\"$//g; 839c6a99b60SMichael S. Tsirkin $address =~ s/^\s+|\s+$//g; 840c6a99b60SMichael S. Tsirkin 841c6a99b60SMichael S. Tsirkin if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 842c6a99b60SMichael S. Tsirkin $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 843c6a99b60SMichael S. Tsirkin $name = "\"$name\""; 844c6a99b60SMichael S. Tsirkin } 845c6a99b60SMichael S. Tsirkin 846c6a99b60SMichael S. Tsirkin if ($usename) { 847c6a99b60SMichael S. Tsirkin if ("$name" eq "") { 848c6a99b60SMichael S. Tsirkin $formatted_email = "$address"; 849c6a99b60SMichael S. Tsirkin } else { 850c6a99b60SMichael S. Tsirkin $formatted_email = "$name <$address>"; 851c6a99b60SMichael S. Tsirkin } 852c6a99b60SMichael S. Tsirkin } else { 853c6a99b60SMichael S. Tsirkin $formatted_email = $address; 854c6a99b60SMichael S. Tsirkin } 855c6a99b60SMichael S. Tsirkin 856c6a99b60SMichael S. Tsirkin return $formatted_email; 857c6a99b60SMichael S. Tsirkin} 858c6a99b60SMichael S. Tsirkin 859c6a99b60SMichael S. Tsirkinsub find_first_section { 860c6a99b60SMichael S. Tsirkin my $index = 0; 861c6a99b60SMichael S. Tsirkin 862c6a99b60SMichael S. Tsirkin while ($index < @typevalue) { 863c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$index]; 864ba10f729SPaolo Bonzini if (($tv =~ m/^(.):\s*(.*)/)) { 865c6a99b60SMichael S. Tsirkin last; 866c6a99b60SMichael S. Tsirkin } 867c6a99b60SMichael S. Tsirkin $index++; 868c6a99b60SMichael S. Tsirkin } 869c6a99b60SMichael S. Tsirkin 870c6a99b60SMichael S. Tsirkin return $index; 871c6a99b60SMichael S. Tsirkin} 872c6a99b60SMichael S. Tsirkin 873c6a99b60SMichael S. Tsirkinsub find_starting_index { 874c6a99b60SMichael S. Tsirkin my ($index) = @_; 875c6a99b60SMichael S. Tsirkin 876c6a99b60SMichael S. Tsirkin while ($index > 0) { 877c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$index]; 878ba10f729SPaolo Bonzini if (!($tv =~ m/^(.):\s*(.*)/)) { 879c6a99b60SMichael S. Tsirkin last; 880c6a99b60SMichael S. Tsirkin } 881c6a99b60SMichael S. Tsirkin $index--; 882c6a99b60SMichael S. Tsirkin } 883c6a99b60SMichael S. Tsirkin 884c6a99b60SMichael S. Tsirkin return $index; 885c6a99b60SMichael S. Tsirkin} 886c6a99b60SMichael S. Tsirkin 887c6a99b60SMichael S. Tsirkinsub find_ending_index { 888c6a99b60SMichael S. Tsirkin my ($index) = @_; 889c6a99b60SMichael S. Tsirkin 890c6a99b60SMichael S. Tsirkin while ($index < @typevalue) { 891c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$index]; 892ba10f729SPaolo Bonzini if (!($tv =~ m/^(.):\s*(.*)/)) { 893c6a99b60SMichael S. Tsirkin last; 894c6a99b60SMichael S. Tsirkin } 895c6a99b60SMichael S. Tsirkin $index++; 896c6a99b60SMichael S. Tsirkin } 897c6a99b60SMichael S. Tsirkin 898c6a99b60SMichael S. Tsirkin return $index; 899c6a99b60SMichael S. Tsirkin} 900c6a99b60SMichael S. Tsirkin 901622e42a7SJoe Perchessub get_subsystem_name { 902622e42a7SJoe Perches my ($index) = @_; 903622e42a7SJoe Perches 904622e42a7SJoe Perches my $start = find_starting_index($index); 905622e42a7SJoe Perches 906622e42a7SJoe Perches my $subsystem = $typevalue[$start]; 907622e42a7SJoe Perches if (length($subsystem) > 20) { 908622e42a7SJoe Perches $subsystem = substr($subsystem, 0, 17); 909622e42a7SJoe Perches $subsystem =~ s/\s*$//; 9102845bab6SEmmanouil Pitsidianakis $subsystem =~ s/[()]//g; 911622e42a7SJoe Perches $subsystem = $subsystem . "..."; 912622e42a7SJoe Perches } 913622e42a7SJoe Perches return $subsystem; 914622e42a7SJoe Perches} 915622e42a7SJoe Perches 916c6a99b60SMichael S. Tsirkinsub get_maintainer_role { 917c6a99b60SMichael S. Tsirkin my ($index) = @_; 918c6a99b60SMichael S. Tsirkin 919c6a99b60SMichael S. Tsirkin my $i; 920c6a99b60SMichael S. Tsirkin my $start = find_starting_index($index); 921c6a99b60SMichael S. Tsirkin my $end = find_ending_index($index); 922c6a99b60SMichael S. Tsirkin 923c84a2b1aSMichael S. Tsirkin my $role = "unknown"; 924622e42a7SJoe Perches my $subsystem = get_subsystem_name($index); 925c6a99b60SMichael S. Tsirkin 926c6a99b60SMichael S. Tsirkin for ($i = $start + 1; $i < $end; $i++) { 927c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$i]; 928ba10f729SPaolo Bonzini if ($tv =~ m/^(.):\s*(.*)/) { 929c6a99b60SMichael S. Tsirkin my $ptype = $1; 930c6a99b60SMichael S. Tsirkin my $pvalue = $2; 931c6a99b60SMichael S. Tsirkin if ($ptype eq "S") { 932c6a99b60SMichael S. Tsirkin $role = $pvalue; 933c6a99b60SMichael S. Tsirkin } 934c6a99b60SMichael S. Tsirkin } 935c6a99b60SMichael S. Tsirkin } 936c6a99b60SMichael S. Tsirkin 937c6a99b60SMichael S. Tsirkin $role = lc($role); 938c6a99b60SMichael S. Tsirkin if ($role eq "supported") { 939c6a99b60SMichael S. Tsirkin $role = "supporter"; 940c6a99b60SMichael S. Tsirkin } elsif ($role eq "maintained") { 941c6a99b60SMichael S. Tsirkin $role = "maintainer"; 942c6a99b60SMichael S. Tsirkin } elsif ($role eq "odd fixes") { 943c6a99b60SMichael S. Tsirkin $role = "odd fixer"; 944c6a99b60SMichael S. Tsirkin } elsif ($role eq "orphan") { 945c6a99b60SMichael S. Tsirkin $role = "orphan minder"; 946c6a99b60SMichael S. Tsirkin } elsif ($role eq "obsolete") { 947c6a99b60SMichael S. Tsirkin $role = "obsolete minder"; 948c6a99b60SMichael S. Tsirkin } elsif ($role eq "buried alive in reporters") { 949c6a99b60SMichael S. Tsirkin $role = "chief penguin"; 950c6a99b60SMichael S. Tsirkin } 951c6a99b60SMichael S. Tsirkin 952c6a99b60SMichael S. Tsirkin return $role . ":" . $subsystem; 953c6a99b60SMichael S. Tsirkin} 954c6a99b60SMichael S. Tsirkin 955c6a99b60SMichael S. Tsirkinsub get_list_role { 956c6a99b60SMichael S. Tsirkin my ($index) = @_; 957c6a99b60SMichael S. Tsirkin 958622e42a7SJoe Perches my $subsystem = get_subsystem_name($index); 959c6a99b60SMichael S. Tsirkin 960c6a99b60SMichael S. Tsirkin if ($subsystem eq "THE REST") { 961c6a99b60SMichael S. Tsirkin $subsystem = ""; 962c6a99b60SMichael S. Tsirkin } 963c6a99b60SMichael S. Tsirkin 964c6a99b60SMichael S. Tsirkin return $subsystem; 965c6a99b60SMichael S. Tsirkin} 966c6a99b60SMichael S. Tsirkin 967c6a99b60SMichael S. Tsirkinsub add_categories { 968c6a99b60SMichael S. Tsirkin my ($index) = @_; 969c6a99b60SMichael S. Tsirkin 970c6a99b60SMichael S. Tsirkin my $i; 971c6a99b60SMichael S. Tsirkin my $start = find_starting_index($index); 972c6a99b60SMichael S. Tsirkin my $end = find_ending_index($index); 973c6a99b60SMichael S. Tsirkin 974c6a99b60SMichael S. Tsirkin push(@subsystem, $typevalue[$start]); 975c6a99b60SMichael S. Tsirkin 976c6a99b60SMichael S. Tsirkin for ($i = $start + 1; $i < $end; $i++) { 977c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$i]; 978ba10f729SPaolo Bonzini if ($tv =~ m/^(.):\s*(.*)/) { 979c6a99b60SMichael S. Tsirkin my $ptype = $1; 980c6a99b60SMichael S. Tsirkin my $pvalue = $2; 981c6a99b60SMichael S. Tsirkin if ($ptype eq "L") { 982c6a99b60SMichael S. Tsirkin my $list_address = $pvalue; 983c6a99b60SMichael S. Tsirkin my $list_additional = ""; 984c6a99b60SMichael S. Tsirkin my $list_role = get_list_role($i); 985c6a99b60SMichael S. Tsirkin 986c6a99b60SMichael S. Tsirkin if ($list_role ne "") { 987c6a99b60SMichael S. Tsirkin $list_role = ":" . $list_role; 988c6a99b60SMichael S. Tsirkin } 989c6a99b60SMichael S. Tsirkin if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 990c6a99b60SMichael S. Tsirkin $list_address = $1; 991c6a99b60SMichael S. Tsirkin $list_additional = $2; 992c6a99b60SMichael S. Tsirkin } 993c6a99b60SMichael S. Tsirkin if ($list_additional =~ m/subscribers-only/) { 994c6a99b60SMichael S. Tsirkin if ($email_subscriber_list) { 995c6a99b60SMichael S. Tsirkin if (!$hash_list_to{lc($list_address)}) { 996c6a99b60SMichael S. Tsirkin $hash_list_to{lc($list_address)} = 1; 997c6a99b60SMichael S. Tsirkin push(@list_to, [$list_address, 998c6a99b60SMichael S. Tsirkin "subscriber list${list_role}"]); 999c6a99b60SMichael S. Tsirkin } 1000c6a99b60SMichael S. Tsirkin } 1001c6a99b60SMichael S. Tsirkin } else { 1002c6a99b60SMichael S. Tsirkin if ($email_list) { 1003c6a99b60SMichael S. Tsirkin if (!$hash_list_to{lc($list_address)}) { 1004c6a99b60SMichael S. Tsirkin $hash_list_to{lc($list_address)} = 1; 1005c84a2b1aSMichael S. Tsirkin if ($list_additional =~ m/moderated/) { 1006c84a2b1aSMichael S. Tsirkin push(@list_to, [$list_address, 1007c84a2b1aSMichael S. Tsirkin "moderated list${list_role}"]); 1008c84a2b1aSMichael S. Tsirkin } else { 1009c6a99b60SMichael S. Tsirkin push(@list_to, [$list_address, 1010c6a99b60SMichael S. Tsirkin "open list${list_role}"]); 1011c6a99b60SMichael S. Tsirkin } 1012c6a99b60SMichael S. Tsirkin } 1013c6a99b60SMichael S. Tsirkin } 1014c84a2b1aSMichael S. Tsirkin } 1015c6a99b60SMichael S. Tsirkin } elsif ($ptype eq "M") { 1016c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($pvalue); 1017c6a99b60SMichael S. Tsirkin if ($name eq "") { 1018c6a99b60SMichael S. Tsirkin if ($i > 0) { 1019c6a99b60SMichael S. Tsirkin my $tv = $typevalue[$i - 1]; 1020ba10f729SPaolo Bonzini if ($tv =~ m/^(.):\s*(.*)/) { 1021c6a99b60SMichael S. Tsirkin if ($1 eq "P") { 1022c6a99b60SMichael S. Tsirkin $name = $2; 1023c6a99b60SMichael S. Tsirkin $pvalue = format_email($name, $address, $email_usename); 1024c6a99b60SMichael S. Tsirkin } 1025c6a99b60SMichael S. Tsirkin } 1026c6a99b60SMichael S. Tsirkin } 1027c6a99b60SMichael S. Tsirkin } 1028c6a99b60SMichael S. Tsirkin if ($email_maintainer) { 1029c6a99b60SMichael S. Tsirkin my $role = get_maintainer_role($i); 1030c6a99b60SMichael S. Tsirkin push_email_addresses($pvalue, $role); 1031c6a99b60SMichael S. Tsirkin } 10326668a2afSJoe Perches } elsif ($ptype eq "R") { 10336668a2afSJoe Perches my ($name, $address) = parse_email($pvalue); 10346668a2afSJoe Perches if ($name eq "") { 10356668a2afSJoe Perches if ($i > 0) { 10366668a2afSJoe Perches my $tv = $typevalue[$i - 1]; 10376668a2afSJoe Perches if ($tv =~ m/^(.):\s*(.*)/) { 10386668a2afSJoe Perches if ($1 eq "P") { 10396668a2afSJoe Perches $name = $2; 10406668a2afSJoe Perches $pvalue = format_email($name, $address, $email_usename); 10416668a2afSJoe Perches } 10426668a2afSJoe Perches } 10436668a2afSJoe Perches } 10446668a2afSJoe Perches } 10456668a2afSJoe Perches if ($email_reviewer) { 1046622e42a7SJoe Perches my $subsystem = get_subsystem_name($i); 1047622e42a7SJoe Perches push_email_addresses($pvalue, "reviewer:$subsystem"); 10486668a2afSJoe Perches } 1049c6a99b60SMichael S. Tsirkin } elsif ($ptype eq "T") { 1050c6a99b60SMichael S. Tsirkin push(@scm, $pvalue); 1051c6a99b60SMichael S. Tsirkin } elsif ($ptype eq "W") { 1052c6a99b60SMichael S. Tsirkin push(@web, $pvalue); 1053c6a99b60SMichael S. Tsirkin } elsif ($ptype eq "S") { 1054c6a99b60SMichael S. Tsirkin push(@status, $pvalue); 1055c6a99b60SMichael S. Tsirkin } 1056c6a99b60SMichael S. Tsirkin } 1057c6a99b60SMichael S. Tsirkin } 1058c6a99b60SMichael S. Tsirkin} 1059c6a99b60SMichael S. Tsirkin 1060c6a99b60SMichael S. Tsirkinsub email_inuse { 1061c6a99b60SMichael S. Tsirkin my ($name, $address) = @_; 1062c6a99b60SMichael S. Tsirkin 1063c6a99b60SMichael S. Tsirkin return 1 if (($name eq "") && ($address eq "")); 1064c6a99b60SMichael S. Tsirkin return 1 if (($name ne "") && exists($email_hash_name{lc($name)})); 1065c6a99b60SMichael S. Tsirkin return 1 if (($address ne "") && exists($email_hash_address{lc($address)})); 1066c6a99b60SMichael S. Tsirkin 1067c6a99b60SMichael S. Tsirkin return 0; 1068c6a99b60SMichael S. Tsirkin} 1069c6a99b60SMichael S. Tsirkin 1070c6a99b60SMichael S. Tsirkinsub push_email_address { 1071c6a99b60SMichael S. Tsirkin my ($line, $role) = @_; 1072c6a99b60SMichael S. Tsirkin 1073c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($line); 1074c6a99b60SMichael S. Tsirkin 1075c6a99b60SMichael S. Tsirkin if ($address eq "") { 1076c6a99b60SMichael S. Tsirkin return 0; 1077c6a99b60SMichael S. Tsirkin } 1078c6a99b60SMichael S. Tsirkin 1079c6a99b60SMichael S. Tsirkin if (!$email_remove_duplicates) { 1080c6a99b60SMichael S. Tsirkin push(@email_to, [format_email($name, $address, $email_usename), $role]); 1081c6a99b60SMichael S. Tsirkin } elsif (!email_inuse($name, $address)) { 1082c6a99b60SMichael S. Tsirkin push(@email_to, [format_email($name, $address, $email_usename), $role]); 1083c6a99b60SMichael S. Tsirkin $email_hash_name{lc($name)}++ if ($name ne ""); 1084c6a99b60SMichael S. Tsirkin $email_hash_address{lc($address)}++; 1085c6a99b60SMichael S. Tsirkin } 1086c6a99b60SMichael S. Tsirkin 1087c6a99b60SMichael S. Tsirkin return 1; 1088c6a99b60SMichael S. Tsirkin} 1089c6a99b60SMichael S. Tsirkin 1090c6a99b60SMichael S. Tsirkinsub push_email_addresses { 1091c6a99b60SMichael S. Tsirkin my ($address, $role) = @_; 1092c6a99b60SMichael S. Tsirkin 1093c6a99b60SMichael S. Tsirkin my @address_list = (); 1094c6a99b60SMichael S. Tsirkin 1095c6a99b60SMichael S. Tsirkin if (rfc822_valid($address)) { 1096c6a99b60SMichael S. Tsirkin push_email_address($address, $role); 1097c6a99b60SMichael S. Tsirkin } elsif (@address_list = rfc822_validlist($address)) { 1098c6a99b60SMichael S. Tsirkin my $array_count = shift(@address_list); 1099c6a99b60SMichael S. Tsirkin while (my $entry = shift(@address_list)) { 1100c6a99b60SMichael S. Tsirkin push_email_address($entry, $role); 1101c6a99b60SMichael S. Tsirkin } 1102c6a99b60SMichael S. Tsirkin } else { 1103c6a99b60SMichael S. Tsirkin if (!push_email_address($address, $role)) { 1104c6a99b60SMichael S. Tsirkin warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 1105c6a99b60SMichael S. Tsirkin } 1106c6a99b60SMichael S. Tsirkin } 1107c6a99b60SMichael S. Tsirkin} 1108c6a99b60SMichael S. Tsirkin 1109c6a99b60SMichael S. Tsirkinsub add_role { 1110c6a99b60SMichael S. Tsirkin my ($line, $role) = @_; 1111c6a99b60SMichael S. Tsirkin 1112c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($line); 1113c6a99b60SMichael S. Tsirkin my $email = format_email($name, $address, $email_usename); 1114c6a99b60SMichael S. Tsirkin 1115c6a99b60SMichael S. Tsirkin foreach my $entry (@email_to) { 1116c6a99b60SMichael S. Tsirkin if ($email_remove_duplicates) { 1117c6a99b60SMichael S. Tsirkin my ($entry_name, $entry_address) = parse_email($entry->[0]); 1118c6a99b60SMichael S. Tsirkin if (($name eq $entry_name || $address eq $entry_address) 1119c6a99b60SMichael S. Tsirkin && ($role eq "" || !($entry->[1] =~ m/$role/)) 1120c6a99b60SMichael S. Tsirkin ) { 1121c6a99b60SMichael S. Tsirkin if ($entry->[1] eq "") { 1122c6a99b60SMichael S. Tsirkin $entry->[1] = "$role"; 1123c6a99b60SMichael S. Tsirkin } else { 1124c6a99b60SMichael S. Tsirkin $entry->[1] = "$entry->[1],$role"; 1125c6a99b60SMichael S. Tsirkin } 1126c6a99b60SMichael S. Tsirkin } 1127c6a99b60SMichael S. Tsirkin } else { 1128c6a99b60SMichael S. Tsirkin if ($email eq $entry->[0] 1129c6a99b60SMichael S. Tsirkin && ($role eq "" || !($entry->[1] =~ m/$role/)) 1130c6a99b60SMichael S. Tsirkin ) { 1131c6a99b60SMichael S. Tsirkin if ($entry->[1] eq "") { 1132c6a99b60SMichael S. Tsirkin $entry->[1] = "$role"; 1133c6a99b60SMichael S. Tsirkin } else { 1134c6a99b60SMichael S. Tsirkin $entry->[1] = "$entry->[1],$role"; 1135c6a99b60SMichael S. Tsirkin } 1136c6a99b60SMichael S. Tsirkin } 1137c6a99b60SMichael S. Tsirkin } 1138c6a99b60SMichael S. Tsirkin } 1139c6a99b60SMichael S. Tsirkin} 1140c6a99b60SMichael S. Tsirkin 1141c6a99b60SMichael S. Tsirkinsub which { 1142c6a99b60SMichael S. Tsirkin my ($bin) = @_; 1143c6a99b60SMichael S. Tsirkin 1144c6a99b60SMichael S. Tsirkin foreach my $path (split(/:/, $ENV{PATH})) { 1145c6a99b60SMichael S. Tsirkin if (-e "$path/$bin") { 1146c6a99b60SMichael S. Tsirkin return "$path/$bin"; 1147c6a99b60SMichael S. Tsirkin } 1148c6a99b60SMichael S. Tsirkin } 1149c6a99b60SMichael S. Tsirkin 1150c6a99b60SMichael S. Tsirkin return ""; 1151c6a99b60SMichael S. Tsirkin} 1152c6a99b60SMichael S. Tsirkin 1153c6a99b60SMichael S. Tsirkinsub which_conf { 1154c6a99b60SMichael S. Tsirkin my ($conf) = @_; 1155c6a99b60SMichael S. Tsirkin 1156c6a99b60SMichael S. Tsirkin foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { 1157c6a99b60SMichael S. Tsirkin if (-e "$path/$conf") { 1158c6a99b60SMichael S. Tsirkin return "$path/$conf"; 1159c6a99b60SMichael S. Tsirkin } 1160c6a99b60SMichael S. Tsirkin } 1161c6a99b60SMichael S. Tsirkin 1162c6a99b60SMichael S. Tsirkin return ""; 1163c6a99b60SMichael S. Tsirkin} 1164c6a99b60SMichael S. Tsirkin 1165c6a99b60SMichael S. Tsirkinsub mailmap_email { 1166c6a99b60SMichael S. Tsirkin my ($line) = @_; 1167c6a99b60SMichael S. Tsirkin 1168c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($line); 1169c6a99b60SMichael S. Tsirkin my $email = format_email($name, $address, 1); 1170c6a99b60SMichael S. Tsirkin my $real_name = $name; 1171c6a99b60SMichael S. Tsirkin my $real_address = $address; 1172c6a99b60SMichael S. Tsirkin 1173c6a99b60SMichael S. Tsirkin if (exists $mailmap->{names}->{$email} || 1174c6a99b60SMichael S. Tsirkin exists $mailmap->{addresses}->{$email}) { 1175c6a99b60SMichael S. Tsirkin if (exists $mailmap->{names}->{$email}) { 1176c6a99b60SMichael S. Tsirkin $real_name = $mailmap->{names}->{$email}; 1177c6a99b60SMichael S. Tsirkin } 1178c6a99b60SMichael S. Tsirkin if (exists $mailmap->{addresses}->{$email}) { 1179c6a99b60SMichael S. Tsirkin $real_address = $mailmap->{addresses}->{$email}; 1180c6a99b60SMichael S. Tsirkin } 1181c6a99b60SMichael S. Tsirkin } else { 1182c6a99b60SMichael S. Tsirkin if (exists $mailmap->{names}->{$address}) { 1183c6a99b60SMichael S. Tsirkin $real_name = $mailmap->{names}->{$address}; 1184c6a99b60SMichael S. Tsirkin } 1185c6a99b60SMichael S. Tsirkin if (exists $mailmap->{addresses}->{$address}) { 1186c6a99b60SMichael S. Tsirkin $real_address = $mailmap->{addresses}->{$address}; 1187c6a99b60SMichael S. Tsirkin } 1188c6a99b60SMichael S. Tsirkin } 1189c6a99b60SMichael S. Tsirkin return format_email($real_name, $real_address, 1); 1190c6a99b60SMichael S. Tsirkin} 1191c6a99b60SMichael S. Tsirkin 1192c6a99b60SMichael S. Tsirkinsub mailmap { 1193c6a99b60SMichael S. Tsirkin my (@addresses) = @_; 1194c6a99b60SMichael S. Tsirkin 1195c6a99b60SMichael S. Tsirkin my @mapped_emails = (); 1196c6a99b60SMichael S. Tsirkin foreach my $line (@addresses) { 1197c6a99b60SMichael S. Tsirkin push(@mapped_emails, mailmap_email($line)); 1198c6a99b60SMichael S. Tsirkin } 1199c6a99b60SMichael S. Tsirkin merge_by_realname(@mapped_emails) if ($email_use_mailmap); 1200c6a99b60SMichael S. Tsirkin return @mapped_emails; 1201c6a99b60SMichael S. Tsirkin} 1202c6a99b60SMichael S. Tsirkin 1203c6a99b60SMichael S. Tsirkinsub merge_by_realname { 1204c6a99b60SMichael S. Tsirkin my %address_map; 1205c6a99b60SMichael S. Tsirkin my (@emails) = @_; 1206c6a99b60SMichael S. Tsirkin 1207c6a99b60SMichael S. Tsirkin foreach my $email (@emails) { 1208c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($email); 1209c6a99b60SMichael S. Tsirkin if (exists $address_map{$name}) { 1210c6a99b60SMichael S. Tsirkin $address = $address_map{$name}; 1211c6a99b60SMichael S. Tsirkin $email = format_email($name, $address, 1); 1212c6a99b60SMichael S. Tsirkin } else { 1213c6a99b60SMichael S. Tsirkin $address_map{$name} = $address; 1214c6a99b60SMichael S. Tsirkin } 1215c6a99b60SMichael S. Tsirkin } 1216c6a99b60SMichael S. Tsirkin} 1217c6a99b60SMichael S. Tsirkin 1218c6a99b60SMichael S. Tsirkinsub git_execute_cmd { 1219c6a99b60SMichael S. Tsirkin my ($cmd) = @_; 1220c6a99b60SMichael S. Tsirkin my @lines = (); 1221c6a99b60SMichael S. Tsirkin 1222c6a99b60SMichael S. Tsirkin my $output = `$cmd`; 1223c6a99b60SMichael S. Tsirkin $output =~ s/^\s*//gm; 1224c6a99b60SMichael S. Tsirkin @lines = split("\n", $output); 1225c6a99b60SMichael S. Tsirkin 1226c6a99b60SMichael S. Tsirkin return @lines; 1227c6a99b60SMichael S. Tsirkin} 1228c6a99b60SMichael S. Tsirkin 1229c6a99b60SMichael S. Tsirkinsub hg_execute_cmd { 1230c6a99b60SMichael S. Tsirkin my ($cmd) = @_; 1231c6a99b60SMichael S. Tsirkin my @lines = (); 1232c6a99b60SMichael S. Tsirkin 1233c6a99b60SMichael S. Tsirkin my $output = `$cmd`; 1234c6a99b60SMichael S. Tsirkin @lines = split("\n", $output); 1235c6a99b60SMichael S. Tsirkin 1236c6a99b60SMichael S. Tsirkin return @lines; 1237c6a99b60SMichael S. Tsirkin} 1238c6a99b60SMichael S. Tsirkin 1239c6a99b60SMichael S. Tsirkinsub extract_formatted_signatures { 1240c6a99b60SMichael S. Tsirkin my (@signature_lines) = @_; 1241c6a99b60SMichael S. Tsirkin 1242c6a99b60SMichael S. Tsirkin my @type = @signature_lines; 1243c6a99b60SMichael S. Tsirkin 1244c6a99b60SMichael S. Tsirkin s/\s*(.*):.*/$1/ for (@type); 1245c6a99b60SMichael S. Tsirkin 1246c6a99b60SMichael S. Tsirkin # cut -f2- -d":" 1247c6a99b60SMichael S. Tsirkin s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines); 1248c6a99b60SMichael S. Tsirkin 1249c6a99b60SMichael S. Tsirkin## Reformat email addresses (with names) to avoid badly written signatures 1250c6a99b60SMichael S. Tsirkin 1251c6a99b60SMichael S. Tsirkin foreach my $signer (@signature_lines) { 1252c6a99b60SMichael S. Tsirkin $signer = deduplicate_email($signer); 1253c6a99b60SMichael S. Tsirkin } 1254c6a99b60SMichael S. Tsirkin 1255c6a99b60SMichael S. Tsirkin return (\@type, \@signature_lines); 1256c6a99b60SMichael S. Tsirkin} 1257c6a99b60SMichael S. Tsirkin 1258c6a99b60SMichael S. Tsirkinsub vcs_find_signers { 1259c6a99b60SMichael S. Tsirkin my ($cmd) = @_; 1260c6a99b60SMichael S. Tsirkin my $commits; 1261c6a99b60SMichael S. Tsirkin my @lines = (); 1262c6a99b60SMichael S. Tsirkin my @signatures = (); 1263c6a99b60SMichael S. Tsirkin 1264c6a99b60SMichael S. Tsirkin @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1265c6a99b60SMichael S. Tsirkin 1266c6a99b60SMichael S. Tsirkin my $pattern = $VCS_cmds{"commit_pattern"}; 1267c6a99b60SMichael S. Tsirkin 1268c6a99b60SMichael S. Tsirkin $commits = grep(/$pattern/, @lines); # of commits 1269c6a99b60SMichael S. Tsirkin 1270c6a99b60SMichael S. Tsirkin @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines); 1271c6a99b60SMichael S. Tsirkin 1272c6a99b60SMichael S. Tsirkin return (0, @signatures) if !@signatures; 1273c6a99b60SMichael S. Tsirkin 1274c6a99b60SMichael S. Tsirkin save_commits_by_author(@lines) if ($interactive); 1275c6a99b60SMichael S. Tsirkin save_commits_by_signer(@lines) if ($interactive); 1276c6a99b60SMichael S. Tsirkin 1277c6a99b60SMichael S. Tsirkin my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1278c6a99b60SMichael S. Tsirkin 1279c6a99b60SMichael S. Tsirkin return ($commits, @$signers_ref); 1280c6a99b60SMichael S. Tsirkin} 1281c6a99b60SMichael S. Tsirkin 1282c6a99b60SMichael S. Tsirkinsub vcs_find_author { 1283c6a99b60SMichael S. Tsirkin my ($cmd) = @_; 1284c6a99b60SMichael S. Tsirkin my @lines = (); 1285c6a99b60SMichael S. Tsirkin 1286c6a99b60SMichael S. Tsirkin @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1287c6a99b60SMichael S. Tsirkin 1288c6a99b60SMichael S. Tsirkin return @lines if !@lines; 1289c6a99b60SMichael S. Tsirkin 1290c6a99b60SMichael S. Tsirkin my @authors = (); 1291c6a99b60SMichael S. Tsirkin foreach my $line (@lines) { 1292c6a99b60SMichael S. Tsirkin if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1293c6a99b60SMichael S. Tsirkin my $author = $1; 1294c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($author); 1295c6a99b60SMichael S. Tsirkin $author = format_email($name, $address, 1); 1296c6a99b60SMichael S. Tsirkin push(@authors, $author); 1297c6a99b60SMichael S. Tsirkin } 1298c6a99b60SMichael S. Tsirkin } 1299c6a99b60SMichael S. Tsirkin 1300c6a99b60SMichael S. Tsirkin save_commits_by_author(@lines) if ($interactive); 1301c6a99b60SMichael S. Tsirkin save_commits_by_signer(@lines) if ($interactive); 1302c6a99b60SMichael S. Tsirkin 1303c6a99b60SMichael S. Tsirkin return @authors; 1304c6a99b60SMichael S. Tsirkin} 1305c6a99b60SMichael S. Tsirkin 1306c6a99b60SMichael S. Tsirkinsub vcs_save_commits { 1307c6a99b60SMichael S. Tsirkin my ($cmd) = @_; 1308c6a99b60SMichael S. Tsirkin my @lines = (); 1309c6a99b60SMichael S. Tsirkin my @commits = (); 1310c6a99b60SMichael S. Tsirkin 1311c6a99b60SMichael S. Tsirkin @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1312c6a99b60SMichael S. Tsirkin 1313c6a99b60SMichael S. Tsirkin foreach my $line (@lines) { 1314c6a99b60SMichael S. Tsirkin if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 1315c6a99b60SMichael S. Tsirkin push(@commits, $1); 1316c6a99b60SMichael S. Tsirkin } 1317c6a99b60SMichael S. Tsirkin } 1318c6a99b60SMichael S. Tsirkin 1319c6a99b60SMichael S. Tsirkin return @commits; 1320c6a99b60SMichael S. Tsirkin} 1321c6a99b60SMichael S. Tsirkin 1322c6a99b60SMichael S. Tsirkinsub vcs_blame { 1323c6a99b60SMichael S. Tsirkin my ($file) = @_; 1324c6a99b60SMichael S. Tsirkin my $cmd; 1325c6a99b60SMichael S. Tsirkin my @commits = (); 1326c6a99b60SMichael S. Tsirkin 1327c6a99b60SMichael S. Tsirkin return @commits if (!(-f $file)); 1328c6a99b60SMichael S. Tsirkin 1329c6a99b60SMichael S. Tsirkin if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1330c6a99b60SMichael S. Tsirkin my @all_commits = (); 1331c6a99b60SMichael S. Tsirkin 1332c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"blame_file_cmd"}; 1333c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1334c6a99b60SMichael S. Tsirkin @all_commits = vcs_save_commits($cmd); 1335c6a99b60SMichael S. Tsirkin 1336c6a99b60SMichael S. Tsirkin foreach my $file_range_diff (@range) { 1337c6a99b60SMichael S. Tsirkin next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1338c6a99b60SMichael S. Tsirkin my $diff_file = $1; 1339c6a99b60SMichael S. Tsirkin my $diff_start = $2; 1340c6a99b60SMichael S. Tsirkin my $diff_length = $3; 1341c6a99b60SMichael S. Tsirkin next if ("$file" ne "$diff_file"); 1342c6a99b60SMichael S. Tsirkin for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1343c6a99b60SMichael S. Tsirkin push(@commits, $all_commits[$i]); 1344c6a99b60SMichael S. Tsirkin } 1345c6a99b60SMichael S. Tsirkin } 1346c6a99b60SMichael S. Tsirkin } elsif (@range) { 1347c6a99b60SMichael S. Tsirkin foreach my $file_range_diff (@range) { 1348c6a99b60SMichael S. Tsirkin next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1349c6a99b60SMichael S. Tsirkin my $diff_file = $1; 1350c6a99b60SMichael S. Tsirkin my $diff_start = $2; 1351c6a99b60SMichael S. Tsirkin my $diff_length = $3; 1352c6a99b60SMichael S. Tsirkin next if ("$file" ne "$diff_file"); 1353c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"blame_range_cmd"}; 1354c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1355c6a99b60SMichael S. Tsirkin push(@commits, vcs_save_commits($cmd)); 1356c6a99b60SMichael S. Tsirkin } 1357c6a99b60SMichael S. Tsirkin } else { 1358c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"blame_file_cmd"}; 1359c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1360c6a99b60SMichael S. Tsirkin @commits = vcs_save_commits($cmd); 1361c6a99b60SMichael S. Tsirkin } 1362c6a99b60SMichael S. Tsirkin 1363c6a99b60SMichael S. Tsirkin foreach my $commit (@commits) { 1364c6a99b60SMichael S. Tsirkin $commit =~ s/^\^//g; 1365c6a99b60SMichael S. Tsirkin } 1366c6a99b60SMichael S. Tsirkin 1367c6a99b60SMichael S. Tsirkin return @commits; 1368c6a99b60SMichael S. Tsirkin} 1369c6a99b60SMichael S. Tsirkin 1370c6a99b60SMichael S. Tsirkinmy $printed_novcs = 0; 1371c6a99b60SMichael S. Tsirkinsub vcs_exists { 1372c6a99b60SMichael S. Tsirkin %VCS_cmds = %VCS_cmds_git; 1373c6a99b60SMichael S. Tsirkin return 1 if eval $VCS_cmds{"available"}; 1374c6a99b60SMichael S. Tsirkin %VCS_cmds = %VCS_cmds_hg; 1375c6a99b60SMichael S. Tsirkin return 2 if eval $VCS_cmds{"available"}; 1376c6a99b60SMichael S. Tsirkin %VCS_cmds = (); 1377c6a99b60SMichael S. Tsirkin if (!$printed_novcs) { 1378c6a99b60SMichael S. Tsirkin warn("$P: No supported VCS found. Add --nogit to options?\n"); 1379c6a99b60SMichael S. Tsirkin warn("Using a git repository produces better results.\n"); 1380990def58SMichael S. Tsirkin warn("Try latest git repository using:\n"); 13817a53cd20SStefan Hajnoczi warn("git clone https://gitlab.com/qemu-project/qemu.git\n"); 1382c6a99b60SMichael S. Tsirkin $printed_novcs = 1; 1383c6a99b60SMichael S. Tsirkin } 1384c6a99b60SMichael S. Tsirkin return 0; 1385c6a99b60SMichael S. Tsirkin} 1386c6a99b60SMichael S. Tsirkin 1387c6a99b60SMichael S. Tsirkinsub vcs_is_git { 1388c6a99b60SMichael S. Tsirkin vcs_exists(); 1389c6a99b60SMichael S. Tsirkin return $vcs_used == 1; 1390c6a99b60SMichael S. Tsirkin} 1391c6a99b60SMichael S. Tsirkin 1392c6a99b60SMichael S. Tsirkinsub vcs_is_hg { 1393c6a99b60SMichael S. Tsirkin return $vcs_used == 2; 1394c6a99b60SMichael S. Tsirkin} 1395c6a99b60SMichael S. Tsirkin 1396c6a99b60SMichael S. Tsirkinsub interactive_get_maintainers { 1397c6a99b60SMichael S. Tsirkin my ($list_ref) = @_; 1398c6a99b60SMichael S. Tsirkin my @list = @$list_ref; 1399c6a99b60SMichael S. Tsirkin 1400c6a99b60SMichael S. Tsirkin vcs_exists(); 1401c6a99b60SMichael S. Tsirkin 1402c6a99b60SMichael S. Tsirkin my %selected; 1403c6a99b60SMichael S. Tsirkin my %authored; 1404c6a99b60SMichael S. Tsirkin my %signed; 1405c6a99b60SMichael S. Tsirkin my $count = 0; 1406c6a99b60SMichael S. Tsirkin my $maintained = 0; 1407c6a99b60SMichael S. Tsirkin foreach my $entry (@list) { 1408c6a99b60SMichael S. Tsirkin $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i); 1409c6a99b60SMichael S. Tsirkin $selected{$count} = 1; 1410c6a99b60SMichael S. Tsirkin $authored{$count} = 0; 1411c6a99b60SMichael S. Tsirkin $signed{$count} = 0; 1412c6a99b60SMichael S. Tsirkin $count++; 1413c6a99b60SMichael S. Tsirkin } 1414c6a99b60SMichael S. Tsirkin 1415c6a99b60SMichael S. Tsirkin #menu loop 1416c6a99b60SMichael S. Tsirkin my $done = 0; 1417c6a99b60SMichael S. Tsirkin my $print_options = 0; 1418c6a99b60SMichael S. Tsirkin my $redraw = 1; 1419c6a99b60SMichael S. Tsirkin while (!$done) { 1420c6a99b60SMichael S. Tsirkin $count = 0; 1421c6a99b60SMichael S. Tsirkin if ($redraw) { 1422c6a99b60SMichael S. Tsirkin printf STDERR "\n%1s %2s %-65s", 1423c6a99b60SMichael S. Tsirkin "*", "#", "email/list and role:stats"; 1424c6a99b60SMichael S. Tsirkin if ($email_git || 1425c6a99b60SMichael S. Tsirkin ($email_git_fallback && !$maintained) || 1426c6a99b60SMichael S. Tsirkin $email_git_blame) { 1427c6a99b60SMichael S. Tsirkin print STDERR "auth sign"; 1428c6a99b60SMichael S. Tsirkin } 1429c6a99b60SMichael S. Tsirkin print STDERR "\n"; 1430c6a99b60SMichael S. Tsirkin foreach my $entry (@list) { 1431c6a99b60SMichael S. Tsirkin my $email = $entry->[0]; 1432c6a99b60SMichael S. Tsirkin my $role = $entry->[1]; 1433c6a99b60SMichael S. Tsirkin my $sel = ""; 1434c6a99b60SMichael S. Tsirkin $sel = "*" if ($selected{$count}); 1435c6a99b60SMichael S. Tsirkin my $commit_author = $commit_author_hash{$email}; 1436c6a99b60SMichael S. Tsirkin my $commit_signer = $commit_signer_hash{$email}; 1437c6a99b60SMichael S. Tsirkin my $authored = 0; 1438c6a99b60SMichael S. Tsirkin my $signed = 0; 1439c6a99b60SMichael S. Tsirkin $authored++ for (@{$commit_author}); 1440c6a99b60SMichael S. Tsirkin $signed++ for (@{$commit_signer}); 1441c6a99b60SMichael S. Tsirkin printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email; 1442c6a99b60SMichael S. Tsirkin printf STDERR "%4d %4d", $authored, $signed 1443c6a99b60SMichael S. Tsirkin if ($authored > 0 || $signed > 0); 1444c6a99b60SMichael S. Tsirkin printf STDERR "\n %s\n", $role; 1445c6a99b60SMichael S. Tsirkin if ($authored{$count}) { 1446c6a99b60SMichael S. Tsirkin my $commit_author = $commit_author_hash{$email}; 1447c6a99b60SMichael S. Tsirkin foreach my $ref (@{$commit_author}) { 1448c6a99b60SMichael S. Tsirkin print STDERR " Author: @{$ref}[1]\n"; 1449c6a99b60SMichael S. Tsirkin } 1450c6a99b60SMichael S. Tsirkin } 1451c6a99b60SMichael S. Tsirkin if ($signed{$count}) { 1452c6a99b60SMichael S. Tsirkin my $commit_signer = $commit_signer_hash{$email}; 1453c6a99b60SMichael S. Tsirkin foreach my $ref (@{$commit_signer}) { 1454c6a99b60SMichael S. Tsirkin print STDERR " @{$ref}[2]: @{$ref}[1]\n"; 1455c6a99b60SMichael S. Tsirkin } 1456c6a99b60SMichael S. Tsirkin } 1457c6a99b60SMichael S. Tsirkin 1458c6a99b60SMichael S. Tsirkin $count++; 1459c6a99b60SMichael S. Tsirkin } 1460c6a99b60SMichael S. Tsirkin } 1461c6a99b60SMichael S. Tsirkin my $date_ref = \$email_git_since; 1462c6a99b60SMichael S. Tsirkin $date_ref = \$email_hg_since if (vcs_is_hg()); 1463c6a99b60SMichael S. Tsirkin if ($print_options) { 1464c6a99b60SMichael S. Tsirkin $print_options = 0; 1465c6a99b60SMichael S. Tsirkin if (vcs_exists()) { 1466c6a99b60SMichael S. Tsirkin print STDERR <<EOT 1467c6a99b60SMichael S. Tsirkin 1468c6a99b60SMichael S. TsirkinVersion Control options: 1469c6a99b60SMichael S. Tsirking use git history [$email_git] 1470c6a99b60SMichael S. Tsirkingf use git-fallback [$email_git_fallback] 1471c6a99b60SMichael S. Tsirkinb use git blame [$email_git_blame] 1472c6a99b60SMichael S. Tsirkinbs use blame signatures [$email_git_blame_signatures] 1473c6a99b60SMichael S. Tsirkinc# minimum commits [$email_git_min_signatures] 1474c6a99b60SMichael S. Tsirkin%# min percent [$email_git_min_percent] 1475c6a99b60SMichael S. Tsirkind# history to use [$$date_ref] 1476c6a99b60SMichael S. Tsirkinx# max maintainers [$email_git_max_maintainers] 1477c6a99b60SMichael S. Tsirkint all signature types [$email_git_all_signature_types] 1478c6a99b60SMichael S. Tsirkinm use .mailmap [$email_use_mailmap] 1479c6a99b60SMichael S. TsirkinEOT 1480c6a99b60SMichael S. Tsirkin } 1481c6a99b60SMichael S. Tsirkin print STDERR <<EOT 1482c6a99b60SMichael S. Tsirkin 1483c6a99b60SMichael S. TsirkinAdditional options: 1484c6a99b60SMichael S. Tsirkin0 toggle all 1485c6a99b60SMichael S. Tsirkintm toggle maintainers 1486c6a99b60SMichael S. Tsirkintg toggle git entries 1487c6a99b60SMichael S. Tsirkintl toggle open list entries 1488c6a99b60SMichael S. Tsirkints toggle subscriber list entries 1489c6a99b60SMichael S. Tsirkinf emails in file [$file_emails] 1490c6a99b60SMichael S. Tsirkink keywords in file [$keywords] 1491c6a99b60SMichael S. Tsirkinr remove duplicates [$email_remove_duplicates] 1492c6a99b60SMichael S. Tsirkinp# pattern match depth [$pattern_depth] 1493c6a99b60SMichael S. TsirkinEOT 1494c6a99b60SMichael S. Tsirkin } 1495c6a99b60SMichael S. Tsirkin print STDERR 1496c6a99b60SMichael S. Tsirkin"\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): "; 1497c6a99b60SMichael S. Tsirkin 1498c6a99b60SMichael S. Tsirkin my $input = <STDIN>; 1499c6a99b60SMichael S. Tsirkin chomp($input); 1500c6a99b60SMichael S. Tsirkin 1501c6a99b60SMichael S. Tsirkin $redraw = 1; 1502c6a99b60SMichael S. Tsirkin my $rerun = 0; 1503c6a99b60SMichael S. Tsirkin my @wish = split(/[, ]+/, $input); 1504c6a99b60SMichael S. Tsirkin foreach my $nr (@wish) { 1505c6a99b60SMichael S. Tsirkin $nr = lc($nr); 1506c6a99b60SMichael S. Tsirkin my $sel = substr($nr, 0, 1); 1507c6a99b60SMichael S. Tsirkin my $str = substr($nr, 1); 1508c6a99b60SMichael S. Tsirkin my $val = 0; 1509c6a99b60SMichael S. Tsirkin $val = $1 if $str =~ /^(\d+)$/; 1510c6a99b60SMichael S. Tsirkin 1511c6a99b60SMichael S. Tsirkin if ($sel eq "y") { 1512c6a99b60SMichael S. Tsirkin $interactive = 0; 1513c6a99b60SMichael S. Tsirkin $done = 1; 1514c6a99b60SMichael S. Tsirkin $output_rolestats = 0; 1515c6a99b60SMichael S. Tsirkin $output_roles = 0; 1516c6a99b60SMichael S. Tsirkin last; 1517c6a99b60SMichael S. Tsirkin } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) { 1518c6a99b60SMichael S. Tsirkin $selected{$nr - 1} = !$selected{$nr - 1}; 1519c6a99b60SMichael S. Tsirkin } elsif ($sel eq "*" || $sel eq '^') { 1520c6a99b60SMichael S. Tsirkin my $toggle = 0; 1521c6a99b60SMichael S. Tsirkin $toggle = 1 if ($sel eq '*'); 1522c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1523c6a99b60SMichael S. Tsirkin $selected{$i} = $toggle; 1524c6a99b60SMichael S. Tsirkin } 1525c6a99b60SMichael S. Tsirkin } elsif ($sel eq "0") { 1526c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1527c6a99b60SMichael S. Tsirkin $selected{$i} = !$selected{$i}; 1528c6a99b60SMichael S. Tsirkin } 1529c6a99b60SMichael S. Tsirkin } elsif ($sel eq "t") { 1530c6a99b60SMichael S. Tsirkin if (lc($str) eq "m") { 1531c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1532c6a99b60SMichael S. Tsirkin $selected{$i} = !$selected{$i} 1533c6a99b60SMichael S. Tsirkin if ($list[$i]->[1] =~ /^(maintainer|supporter)/i); 1534c6a99b60SMichael S. Tsirkin } 1535c6a99b60SMichael S. Tsirkin } elsif (lc($str) eq "g") { 1536c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1537c6a99b60SMichael S. Tsirkin $selected{$i} = !$selected{$i} 1538c6a99b60SMichael S. Tsirkin if ($list[$i]->[1] =~ /^(author|commit|signer)/i); 1539c6a99b60SMichael S. Tsirkin } 1540c6a99b60SMichael S. Tsirkin } elsif (lc($str) eq "l") { 1541c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1542c6a99b60SMichael S. Tsirkin $selected{$i} = !$selected{$i} 1543c6a99b60SMichael S. Tsirkin if ($list[$i]->[1] =~ /^(open list)/i); 1544c6a99b60SMichael S. Tsirkin } 1545c6a99b60SMichael S. Tsirkin } elsif (lc($str) eq "s") { 1546c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1547c6a99b60SMichael S. Tsirkin $selected{$i} = !$selected{$i} 1548c6a99b60SMichael S. Tsirkin if ($list[$i]->[1] =~ /^(subscriber list)/i); 1549c6a99b60SMichael S. Tsirkin } 1550c6a99b60SMichael S. Tsirkin } 1551c6a99b60SMichael S. Tsirkin } elsif ($sel eq "a") { 1552c6a99b60SMichael S. Tsirkin if ($val > 0 && $val <= $count) { 1553c6a99b60SMichael S. Tsirkin $authored{$val - 1} = !$authored{$val - 1}; 1554c6a99b60SMichael S. Tsirkin } elsif ($str eq '*' || $str eq '^') { 1555c6a99b60SMichael S. Tsirkin my $toggle = 0; 1556c6a99b60SMichael S. Tsirkin $toggle = 1 if ($str eq '*'); 1557c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1558c6a99b60SMichael S. Tsirkin $authored{$i} = $toggle; 1559c6a99b60SMichael S. Tsirkin } 1560c6a99b60SMichael S. Tsirkin } 1561c6a99b60SMichael S. Tsirkin } elsif ($sel eq "s") { 1562c6a99b60SMichael S. Tsirkin if ($val > 0 && $val <= $count) { 1563c6a99b60SMichael S. Tsirkin $signed{$val - 1} = !$signed{$val - 1}; 1564c6a99b60SMichael S. Tsirkin } elsif ($str eq '*' || $str eq '^') { 1565c6a99b60SMichael S. Tsirkin my $toggle = 0; 1566c6a99b60SMichael S. Tsirkin $toggle = 1 if ($str eq '*'); 1567c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < $count; $i++) { 1568c6a99b60SMichael S. Tsirkin $signed{$i} = $toggle; 1569c6a99b60SMichael S. Tsirkin } 1570c6a99b60SMichael S. Tsirkin } 1571c6a99b60SMichael S. Tsirkin } elsif ($sel eq "o") { 1572c6a99b60SMichael S. Tsirkin $print_options = 1; 1573c6a99b60SMichael S. Tsirkin $redraw = 1; 1574c6a99b60SMichael S. Tsirkin } elsif ($sel eq "g") { 1575c6a99b60SMichael S. Tsirkin if ($str eq "f") { 1576c6a99b60SMichael S. Tsirkin bool_invert(\$email_git_fallback); 1577c6a99b60SMichael S. Tsirkin } else { 1578c6a99b60SMichael S. Tsirkin bool_invert(\$email_git); 1579c6a99b60SMichael S. Tsirkin } 1580c6a99b60SMichael S. Tsirkin $rerun = 1; 1581c6a99b60SMichael S. Tsirkin } elsif ($sel eq "b") { 1582c6a99b60SMichael S. Tsirkin if ($str eq "s") { 1583c6a99b60SMichael S. Tsirkin bool_invert(\$email_git_blame_signatures); 1584c6a99b60SMichael S. Tsirkin } else { 1585c6a99b60SMichael S. Tsirkin bool_invert(\$email_git_blame); 1586c6a99b60SMichael S. Tsirkin } 1587c6a99b60SMichael S. Tsirkin $rerun = 1; 1588c6a99b60SMichael S. Tsirkin } elsif ($sel eq "c") { 1589c6a99b60SMichael S. Tsirkin if ($val > 0) { 1590c6a99b60SMichael S. Tsirkin $email_git_min_signatures = $val; 1591c6a99b60SMichael S. Tsirkin $rerun = 1; 1592c6a99b60SMichael S. Tsirkin } 1593c6a99b60SMichael S. Tsirkin } elsif ($sel eq "x") { 1594c6a99b60SMichael S. Tsirkin if ($val > 0) { 1595c6a99b60SMichael S. Tsirkin $email_git_max_maintainers = $val; 1596c6a99b60SMichael S. Tsirkin $rerun = 1; 1597c6a99b60SMichael S. Tsirkin } 1598c6a99b60SMichael S. Tsirkin } elsif ($sel eq "%") { 1599c6a99b60SMichael S. Tsirkin if ($str ne "" && $val >= 0) { 1600c6a99b60SMichael S. Tsirkin $email_git_min_percent = $val; 1601c6a99b60SMichael S. Tsirkin $rerun = 1; 1602c6a99b60SMichael S. Tsirkin } 1603c6a99b60SMichael S. Tsirkin } elsif ($sel eq "d") { 1604c6a99b60SMichael S. Tsirkin if (vcs_is_git()) { 1605c6a99b60SMichael S. Tsirkin $email_git_since = $str; 1606c6a99b60SMichael S. Tsirkin } elsif (vcs_is_hg()) { 1607c6a99b60SMichael S. Tsirkin $email_hg_since = $str; 1608c6a99b60SMichael S. Tsirkin } 1609c6a99b60SMichael S. Tsirkin $rerun = 1; 1610c6a99b60SMichael S. Tsirkin } elsif ($sel eq "t") { 1611c6a99b60SMichael S. Tsirkin bool_invert(\$email_git_all_signature_types); 1612c6a99b60SMichael S. Tsirkin $rerun = 1; 1613c6a99b60SMichael S. Tsirkin } elsif ($sel eq "f") { 1614c6a99b60SMichael S. Tsirkin bool_invert(\$file_emails); 1615c6a99b60SMichael S. Tsirkin $rerun = 1; 1616c6a99b60SMichael S. Tsirkin } elsif ($sel eq "r") { 1617c6a99b60SMichael S. Tsirkin bool_invert(\$email_remove_duplicates); 1618c6a99b60SMichael S. Tsirkin $rerun = 1; 1619c6a99b60SMichael S. Tsirkin } elsif ($sel eq "m") { 1620c6a99b60SMichael S. Tsirkin bool_invert(\$email_use_mailmap); 1621c6a99b60SMichael S. Tsirkin read_mailmap(); 1622c6a99b60SMichael S. Tsirkin $rerun = 1; 1623c6a99b60SMichael S. Tsirkin } elsif ($sel eq "k") { 1624c6a99b60SMichael S. Tsirkin bool_invert(\$keywords); 1625c6a99b60SMichael S. Tsirkin $rerun = 1; 1626c6a99b60SMichael S. Tsirkin } elsif ($sel eq "p") { 1627c6a99b60SMichael S. Tsirkin if ($str ne "" && $val >= 0) { 1628c6a99b60SMichael S. Tsirkin $pattern_depth = $val; 1629c6a99b60SMichael S. Tsirkin $rerun = 1; 1630c6a99b60SMichael S. Tsirkin } 1631c6a99b60SMichael S. Tsirkin } elsif ($sel eq "h" || $sel eq "?") { 1632c6a99b60SMichael S. Tsirkin print STDERR <<EOT 1633c6a99b60SMichael S. Tsirkin 1634c6a99b60SMichael S. TsirkinInteractive mode allows you to select the various maintainers, submitters, 1635c6a99b60SMichael S. Tsirkincommit signers and mailing lists that could be CC'd on a patch. 1636c6a99b60SMichael S. Tsirkin 1637c6a99b60SMichael S. TsirkinAny *'d entry is selected. 1638c6a99b60SMichael S. Tsirkin 1639c6a99b60SMichael S. TsirkinIf you have git or hg installed, you can choose to summarize the commit 1640c6a99b60SMichael S. Tsirkinhistory of files in the patch. Also, each line of the current file can 1641c6a99b60SMichael S. Tsirkinbe matched to its commit author and that commits signers with blame. 1642c6a99b60SMichael S. Tsirkin 1643c6a99b60SMichael S. TsirkinVarious knobs exist to control the length of time for active commit 1644c6a99b60SMichael S. Tsirkintracking, the maximum number of commit authors and signers to add, 1645c6a99b60SMichael S. Tsirkinand such. 1646c6a99b60SMichael S. Tsirkin 1647c6a99b60SMichael S. TsirkinEnter selections at the prompt until you are satisfied that the selected 1648c6a99b60SMichael S. Tsirkinmaintainers are appropriate. You may enter multiple selections separated 1649c6a99b60SMichael S. Tsirkinby either commas or spaces. 1650c6a99b60SMichael S. Tsirkin 1651c6a99b60SMichael S. TsirkinEOT 1652c6a99b60SMichael S. Tsirkin } else { 1653c6a99b60SMichael S. Tsirkin print STDERR "invalid option: '$nr'\n"; 1654c6a99b60SMichael S. Tsirkin $redraw = 0; 1655c6a99b60SMichael S. Tsirkin } 1656c6a99b60SMichael S. Tsirkin } 1657c6a99b60SMichael S. Tsirkin if ($rerun) { 1658c6a99b60SMichael S. Tsirkin print STDERR "git-blame can be very slow, please have patience..." 1659c6a99b60SMichael S. Tsirkin if ($email_git_blame); 1660c6a99b60SMichael S. Tsirkin goto &get_maintainers; 1661c6a99b60SMichael S. Tsirkin } 1662c6a99b60SMichael S. Tsirkin } 1663c6a99b60SMichael S. Tsirkin 1664c6a99b60SMichael S. Tsirkin #drop not selected entries 1665c6a99b60SMichael S. Tsirkin $count = 0; 1666c6a99b60SMichael S. Tsirkin my @new_emailto = (); 1667c6a99b60SMichael S. Tsirkin foreach my $entry (@list) { 1668c6a99b60SMichael S. Tsirkin if ($selected{$count}) { 1669c6a99b60SMichael S. Tsirkin push(@new_emailto, $list[$count]); 1670c6a99b60SMichael S. Tsirkin } 1671c6a99b60SMichael S. Tsirkin $count++; 1672c6a99b60SMichael S. Tsirkin } 1673c6a99b60SMichael S. Tsirkin return @new_emailto; 1674c6a99b60SMichael S. Tsirkin} 1675c6a99b60SMichael S. Tsirkin 1676c6a99b60SMichael S. Tsirkinsub bool_invert { 1677c6a99b60SMichael S. Tsirkin my ($bool_ref) = @_; 1678c6a99b60SMichael S. Tsirkin 1679c6a99b60SMichael S. Tsirkin if ($$bool_ref) { 1680c6a99b60SMichael S. Tsirkin $$bool_ref = 0; 1681c6a99b60SMichael S. Tsirkin } else { 1682c6a99b60SMichael S. Tsirkin $$bool_ref = 1; 1683c6a99b60SMichael S. Tsirkin } 1684c6a99b60SMichael S. Tsirkin} 1685c6a99b60SMichael S. Tsirkin 1686c6a99b60SMichael S. Tsirkinsub deduplicate_email { 1687c6a99b60SMichael S. Tsirkin my ($email) = @_; 1688c6a99b60SMichael S. Tsirkin 1689c6a99b60SMichael S. Tsirkin my $matched = 0; 1690c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($email); 1691c6a99b60SMichael S. Tsirkin $email = format_email($name, $address, 1); 1692c6a99b60SMichael S. Tsirkin $email = mailmap_email($email); 1693c6a99b60SMichael S. Tsirkin 1694c6a99b60SMichael S. Tsirkin return $email if (!$email_remove_duplicates); 1695c6a99b60SMichael S. Tsirkin 1696c6a99b60SMichael S. Tsirkin ($name, $address) = parse_email($email); 1697c6a99b60SMichael S. Tsirkin 1698c6a99b60SMichael S. Tsirkin if ($name ne "" && $deduplicate_name_hash{lc($name)}) { 1699c6a99b60SMichael S. Tsirkin $name = $deduplicate_name_hash{lc($name)}->[0]; 1700c6a99b60SMichael S. Tsirkin $address = $deduplicate_name_hash{lc($name)}->[1]; 1701c6a99b60SMichael S. Tsirkin $matched = 1; 1702c6a99b60SMichael S. Tsirkin } elsif ($deduplicate_address_hash{lc($address)}) { 1703c6a99b60SMichael S. Tsirkin $name = $deduplicate_address_hash{lc($address)}->[0]; 1704c6a99b60SMichael S. Tsirkin $address = $deduplicate_address_hash{lc($address)}->[1]; 1705c6a99b60SMichael S. Tsirkin $matched = 1; 1706c6a99b60SMichael S. Tsirkin } 1707c6a99b60SMichael S. Tsirkin if (!$matched) { 1708c6a99b60SMichael S. Tsirkin $deduplicate_name_hash{lc($name)} = [ $name, $address ]; 1709c6a99b60SMichael S. Tsirkin $deduplicate_address_hash{lc($address)} = [ $name, $address ]; 1710c6a99b60SMichael S. Tsirkin } 1711c6a99b60SMichael S. Tsirkin $email = format_email($name, $address, 1); 1712c6a99b60SMichael S. Tsirkin $email = mailmap_email($email); 1713c6a99b60SMichael S. Tsirkin return $email; 1714c6a99b60SMichael S. Tsirkin} 1715c6a99b60SMichael S. Tsirkin 1716c6a99b60SMichael S. Tsirkinsub save_commits_by_author { 1717c6a99b60SMichael S. Tsirkin my (@lines) = @_; 1718c6a99b60SMichael S. Tsirkin 1719c6a99b60SMichael S. Tsirkin my @authors = (); 1720c6a99b60SMichael S. Tsirkin my @commits = (); 1721c6a99b60SMichael S. Tsirkin my @subjects = (); 1722c6a99b60SMichael S. Tsirkin 1723c6a99b60SMichael S. Tsirkin foreach my $line (@lines) { 1724c6a99b60SMichael S. Tsirkin if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1725c6a99b60SMichael S. Tsirkin my $author = $1; 1726c6a99b60SMichael S. Tsirkin $author = deduplicate_email($author); 1727c6a99b60SMichael S. Tsirkin push(@authors, $author); 1728c6a99b60SMichael S. Tsirkin } 1729c6a99b60SMichael S. Tsirkin push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1730c6a99b60SMichael S. Tsirkin push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1731c6a99b60SMichael S. Tsirkin } 1732c6a99b60SMichael S. Tsirkin 1733c6a99b60SMichael S. Tsirkin for (my $i = 0; $i < @authors; $i++) { 1734c6a99b60SMichael S. Tsirkin my $exists = 0; 1735c6a99b60SMichael S. Tsirkin foreach my $ref(@{$commit_author_hash{$authors[$i]}}) { 1736c6a99b60SMichael S. Tsirkin if (@{$ref}[0] eq $commits[$i] && 1737c6a99b60SMichael S. Tsirkin @{$ref}[1] eq $subjects[$i]) { 1738c6a99b60SMichael S. Tsirkin $exists = 1; 1739c6a99b60SMichael S. Tsirkin last; 1740c6a99b60SMichael S. Tsirkin } 1741c6a99b60SMichael S. Tsirkin } 1742c6a99b60SMichael S. Tsirkin if (!$exists) { 1743c6a99b60SMichael S. Tsirkin push(@{$commit_author_hash{$authors[$i]}}, 1744c6a99b60SMichael S. Tsirkin [ ($commits[$i], $subjects[$i]) ]); 1745c6a99b60SMichael S. Tsirkin } 1746c6a99b60SMichael S. Tsirkin } 1747c6a99b60SMichael S. Tsirkin} 1748c6a99b60SMichael S. Tsirkin 1749c6a99b60SMichael S. Tsirkinsub save_commits_by_signer { 1750c6a99b60SMichael S. Tsirkin my (@lines) = @_; 1751c6a99b60SMichael S. Tsirkin 1752c6a99b60SMichael S. Tsirkin my $commit = ""; 1753c6a99b60SMichael S. Tsirkin my $subject = ""; 1754c6a99b60SMichael S. Tsirkin 1755c6a99b60SMichael S. Tsirkin foreach my $line (@lines) { 1756c6a99b60SMichael S. Tsirkin $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/); 1757c6a99b60SMichael S. Tsirkin $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/); 1758c6a99b60SMichael S. Tsirkin if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) { 1759c6a99b60SMichael S. Tsirkin my @signatures = ($line); 1760c6a99b60SMichael S. Tsirkin my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures); 1761c6a99b60SMichael S. Tsirkin my @types = @$types_ref; 1762c6a99b60SMichael S. Tsirkin my @signers = @$signers_ref; 1763c6a99b60SMichael S. Tsirkin 1764c6a99b60SMichael S. Tsirkin my $type = $types[0]; 1765c6a99b60SMichael S. Tsirkin my $signer = $signers[0]; 1766c6a99b60SMichael S. Tsirkin 1767c6a99b60SMichael S. Tsirkin $signer = deduplicate_email($signer); 1768c6a99b60SMichael S. Tsirkin 1769c6a99b60SMichael S. Tsirkin my $exists = 0; 1770c6a99b60SMichael S. Tsirkin foreach my $ref(@{$commit_signer_hash{$signer}}) { 1771c6a99b60SMichael S. Tsirkin if (@{$ref}[0] eq $commit && 1772c6a99b60SMichael S. Tsirkin @{$ref}[1] eq $subject && 1773c6a99b60SMichael S. Tsirkin @{$ref}[2] eq $type) { 1774c6a99b60SMichael S. Tsirkin $exists = 1; 1775c6a99b60SMichael S. Tsirkin last; 1776c6a99b60SMichael S. Tsirkin } 1777c6a99b60SMichael S. Tsirkin } 1778c6a99b60SMichael S. Tsirkin if (!$exists) { 1779c6a99b60SMichael S. Tsirkin push(@{$commit_signer_hash{$signer}}, 1780c6a99b60SMichael S. Tsirkin [ ($commit, $subject, $type) ]); 1781c6a99b60SMichael S. Tsirkin } 1782c6a99b60SMichael S. Tsirkin } 1783c6a99b60SMichael S. Tsirkin } 1784c6a99b60SMichael S. Tsirkin} 1785c6a99b60SMichael S. Tsirkin 1786c6a99b60SMichael S. Tsirkinsub vcs_assign { 1787c6a99b60SMichael S. Tsirkin my ($role, $divisor, @lines) = @_; 1788c6a99b60SMichael S. Tsirkin 1789c6a99b60SMichael S. Tsirkin my %hash; 1790c6a99b60SMichael S. Tsirkin my $count = 0; 1791c6a99b60SMichael S. Tsirkin 1792c6a99b60SMichael S. Tsirkin return if (@lines <= 0); 1793c6a99b60SMichael S. Tsirkin 1794c6a99b60SMichael S. Tsirkin if ($divisor <= 0) { 1795c6a99b60SMichael S. Tsirkin warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 1796c6a99b60SMichael S. Tsirkin $divisor = 1; 1797c6a99b60SMichael S. Tsirkin } 1798c6a99b60SMichael S. Tsirkin 1799c6a99b60SMichael S. Tsirkin @lines = mailmap(@lines); 1800c6a99b60SMichael S. Tsirkin 1801c6a99b60SMichael S. Tsirkin return if (@lines <= 0); 1802c6a99b60SMichael S. Tsirkin 1803c6a99b60SMichael S. Tsirkin @lines = sort(@lines); 1804c6a99b60SMichael S. Tsirkin 1805c6a99b60SMichael S. Tsirkin # uniq -c 1806c6a99b60SMichael S. Tsirkin $hash{$_}++ for @lines; 1807c6a99b60SMichael S. Tsirkin 1808c6a99b60SMichael S. Tsirkin # sort -rn 1809c6a99b60SMichael S. Tsirkin foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 1810c6a99b60SMichael S. Tsirkin my $sign_offs = $hash{$line}; 1811c6a99b60SMichael S. Tsirkin my $percent = $sign_offs * 100 / $divisor; 1812c6a99b60SMichael S. Tsirkin 1813c6a99b60SMichael S. Tsirkin $percent = 100 if ($percent > 100); 1814c6a99b60SMichael S. Tsirkin $count++; 1815c6a99b60SMichael S. Tsirkin last if ($sign_offs < $email_git_min_signatures || 1816c6a99b60SMichael S. Tsirkin $count > $email_git_max_maintainers || 1817c6a99b60SMichael S. Tsirkin $percent < $email_git_min_percent); 1818c6a99b60SMichael S. Tsirkin push_email_address($line, ''); 1819c6a99b60SMichael S. Tsirkin if ($output_rolestats) { 1820c6a99b60SMichael S. Tsirkin my $fmt_percent = sprintf("%.0f", $percent); 1821c6a99b60SMichael S. Tsirkin add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1822c6a99b60SMichael S. Tsirkin } else { 1823c6a99b60SMichael S. Tsirkin add_role($line, $role); 1824c6a99b60SMichael S. Tsirkin } 1825c6a99b60SMichael S. Tsirkin } 1826c6a99b60SMichael S. Tsirkin} 1827c6a99b60SMichael S. Tsirkin 1828c6a99b60SMichael S. Tsirkinsub vcs_file_signoffs { 1829c6a99b60SMichael S. Tsirkin my ($file) = @_; 1830c6a99b60SMichael S. Tsirkin 1831c6a99b60SMichael S. Tsirkin my @signers = (); 1832c6a99b60SMichael S. Tsirkin my $commits; 1833c6a99b60SMichael S. Tsirkin 1834c6a99b60SMichael S. Tsirkin $vcs_used = vcs_exists(); 1835c6a99b60SMichael S. Tsirkin return if (!$vcs_used); 1836c6a99b60SMichael S. Tsirkin 1837c6a99b60SMichael S. Tsirkin my $cmd = $VCS_cmds{"find_signers_cmd"}; 1838c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1839c6a99b60SMichael S. Tsirkin 1840c6a99b60SMichael S. Tsirkin ($commits, @signers) = vcs_find_signers($cmd); 1841c6a99b60SMichael S. Tsirkin 1842c6a99b60SMichael S. Tsirkin foreach my $signer (@signers) { 1843c6a99b60SMichael S. Tsirkin $signer = deduplicate_email($signer); 1844c6a99b60SMichael S. Tsirkin } 1845c6a99b60SMichael S. Tsirkin 1846c6a99b60SMichael S. Tsirkin vcs_assign("commit_signer", $commits, @signers); 1847c6a99b60SMichael S. Tsirkin} 1848c6a99b60SMichael S. Tsirkin 1849c6a99b60SMichael S. Tsirkinsub vcs_file_blame { 1850c6a99b60SMichael S. Tsirkin my ($file) = @_; 1851c6a99b60SMichael S. Tsirkin 1852c6a99b60SMichael S. Tsirkin my @signers = (); 1853c6a99b60SMichael S. Tsirkin my @all_commits = (); 1854c6a99b60SMichael S. Tsirkin my @commits = (); 1855c6a99b60SMichael S. Tsirkin my $total_commits; 1856c6a99b60SMichael S. Tsirkin my $total_lines; 1857c6a99b60SMichael S. Tsirkin 1858c6a99b60SMichael S. Tsirkin $vcs_used = vcs_exists(); 1859c6a99b60SMichael S. Tsirkin return if (!$vcs_used); 1860c6a99b60SMichael S. Tsirkin 1861c6a99b60SMichael S. Tsirkin @all_commits = vcs_blame($file); 1862c6a99b60SMichael S. Tsirkin @commits = uniq(@all_commits); 1863c6a99b60SMichael S. Tsirkin $total_commits = @commits; 1864c6a99b60SMichael S. Tsirkin $total_lines = @all_commits; 1865c6a99b60SMichael S. Tsirkin 1866c6a99b60SMichael S. Tsirkin if ($email_git_blame_signatures) { 1867c6a99b60SMichael S. Tsirkin if (vcs_is_hg()) { 1868c6a99b60SMichael S. Tsirkin my $commit_count; 1869c6a99b60SMichael S. Tsirkin my @commit_signers = (); 1870c6a99b60SMichael S. Tsirkin my $commit = join(" -r ", @commits); 1871c6a99b60SMichael S. Tsirkin my $cmd; 1872c6a99b60SMichael S. Tsirkin 1873c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1874c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1875c6a99b60SMichael S. Tsirkin 1876c6a99b60SMichael S. Tsirkin ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1877c6a99b60SMichael S. Tsirkin 1878c6a99b60SMichael S. Tsirkin push(@signers, @commit_signers); 1879c6a99b60SMichael S. Tsirkin } else { 1880c6a99b60SMichael S. Tsirkin foreach my $commit (@commits) { 1881c6a99b60SMichael S. Tsirkin my $commit_count; 1882c6a99b60SMichael S. Tsirkin my @commit_signers = (); 1883c6a99b60SMichael S. Tsirkin my $cmd; 1884c6a99b60SMichael S. Tsirkin 1885c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1886c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1887c6a99b60SMichael S. Tsirkin 1888c6a99b60SMichael S. Tsirkin ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1889c6a99b60SMichael S. Tsirkin 1890c6a99b60SMichael S. Tsirkin push(@signers, @commit_signers); 1891c6a99b60SMichael S. Tsirkin } 1892c6a99b60SMichael S. Tsirkin } 1893c6a99b60SMichael S. Tsirkin } 1894c6a99b60SMichael S. Tsirkin 1895c6a99b60SMichael S. Tsirkin if ($from_filename) { 1896c6a99b60SMichael S. Tsirkin if ($output_rolestats) { 1897c6a99b60SMichael S. Tsirkin my @blame_signers; 1898c6a99b60SMichael S. Tsirkin if (vcs_is_hg()) {{ # Double brace for last exit 1899c6a99b60SMichael S. Tsirkin my $commit_count; 1900c6a99b60SMichael S. Tsirkin my @commit_signers = (); 1901c6a99b60SMichael S. Tsirkin @commits = uniq(@commits); 1902c6a99b60SMichael S. Tsirkin @commits = sort(@commits); 1903c6a99b60SMichael S. Tsirkin my $commit = join(" -r ", @commits); 1904c6a99b60SMichael S. Tsirkin my $cmd; 1905c6a99b60SMichael S. Tsirkin 1906c6a99b60SMichael S. Tsirkin $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1907c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #substitute variables in $cmd 1908c6a99b60SMichael S. Tsirkin 1909c6a99b60SMichael S. Tsirkin my @lines = (); 1910c6a99b60SMichael S. Tsirkin 1911c6a99b60SMichael S. Tsirkin @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 1912c6a99b60SMichael S. Tsirkin 1913c6a99b60SMichael S. Tsirkin last if !@lines; 1914c6a99b60SMichael S. Tsirkin 1915c6a99b60SMichael S. Tsirkin my @authors = (); 1916c6a99b60SMichael S. Tsirkin foreach my $line (@lines) { 1917c6a99b60SMichael S. Tsirkin if ($line =~ m/$VCS_cmds{"author_pattern"}/) { 1918c6a99b60SMichael S. Tsirkin my $author = $1; 1919c6a99b60SMichael S. Tsirkin $author = deduplicate_email($author); 1920c6a99b60SMichael S. Tsirkin push(@authors, $author); 1921c6a99b60SMichael S. Tsirkin } 1922c6a99b60SMichael S. Tsirkin } 1923c6a99b60SMichael S. Tsirkin 1924c6a99b60SMichael S. Tsirkin save_commits_by_author(@lines) if ($interactive); 1925c6a99b60SMichael S. Tsirkin save_commits_by_signer(@lines) if ($interactive); 1926c6a99b60SMichael S. Tsirkin 1927c6a99b60SMichael S. Tsirkin push(@signers, @authors); 1928c6a99b60SMichael S. Tsirkin }} 1929c6a99b60SMichael S. Tsirkin else { 1930c6a99b60SMichael S. Tsirkin foreach my $commit (@commits) { 1931c6a99b60SMichael S. Tsirkin my $i; 1932c6a99b60SMichael S. Tsirkin my $cmd = $VCS_cmds{"find_commit_author_cmd"}; 1933c6a99b60SMichael S. Tsirkin $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1934c6a99b60SMichael S. Tsirkin my @author = vcs_find_author($cmd); 1935c6a99b60SMichael S. Tsirkin next if !@author; 1936c6a99b60SMichael S. Tsirkin 1937c6a99b60SMichael S. Tsirkin my $formatted_author = deduplicate_email($author[0]); 1938c6a99b60SMichael S. Tsirkin 1939c6a99b60SMichael S. Tsirkin my $count = grep(/$commit/, @all_commits); 1940c6a99b60SMichael S. Tsirkin for ($i = 0; $i < $count ; $i++) { 1941c6a99b60SMichael S. Tsirkin push(@blame_signers, $formatted_author); 1942c6a99b60SMichael S. Tsirkin } 1943c6a99b60SMichael S. Tsirkin } 1944c6a99b60SMichael S. Tsirkin } 1945c6a99b60SMichael S. Tsirkin if (@blame_signers) { 1946c6a99b60SMichael S. Tsirkin vcs_assign("authored lines", $total_lines, @blame_signers); 1947c6a99b60SMichael S. Tsirkin } 1948c6a99b60SMichael S. Tsirkin } 1949c6a99b60SMichael S. Tsirkin foreach my $signer (@signers) { 1950c6a99b60SMichael S. Tsirkin $signer = deduplicate_email($signer); 1951c6a99b60SMichael S. Tsirkin } 1952c6a99b60SMichael S. Tsirkin vcs_assign("commits", $total_commits, @signers); 1953c6a99b60SMichael S. Tsirkin } else { 1954c6a99b60SMichael S. Tsirkin foreach my $signer (@signers) { 1955c6a99b60SMichael S. Tsirkin $signer = deduplicate_email($signer); 1956c6a99b60SMichael S. Tsirkin } 1957c6a99b60SMichael S. Tsirkin vcs_assign("modified commits", $total_commits, @signers); 1958c6a99b60SMichael S. Tsirkin } 1959c6a99b60SMichael S. Tsirkin} 1960c6a99b60SMichael S. Tsirkin 1961c6a99b60SMichael S. Tsirkinsub uniq { 1962c6a99b60SMichael S. Tsirkin my (@parms) = @_; 1963c6a99b60SMichael S. Tsirkin 1964c6a99b60SMichael S. Tsirkin my %saw; 1965c6a99b60SMichael S. Tsirkin @parms = grep(!$saw{$_}++, @parms); 1966c6a99b60SMichael S. Tsirkin return @parms; 1967c6a99b60SMichael S. Tsirkin} 1968c6a99b60SMichael S. Tsirkin 1969c6a99b60SMichael S. Tsirkinsub sort_and_uniq { 1970c6a99b60SMichael S. Tsirkin my (@parms) = @_; 1971c6a99b60SMichael S. Tsirkin 1972c6a99b60SMichael S. Tsirkin my %saw; 1973c6a99b60SMichael S. Tsirkin @parms = sort @parms; 1974c6a99b60SMichael S. Tsirkin @parms = grep(!$saw{$_}++, @parms); 1975c6a99b60SMichael S. Tsirkin return @parms; 1976c6a99b60SMichael S. Tsirkin} 1977c6a99b60SMichael S. Tsirkin 1978c6a99b60SMichael S. Tsirkinsub clean_file_emails { 1979c6a99b60SMichael S. Tsirkin my (@file_emails) = @_; 1980c6a99b60SMichael S. Tsirkin my @fmt_emails = (); 1981c6a99b60SMichael S. Tsirkin 1982c6a99b60SMichael S. Tsirkin foreach my $email (@file_emails) { 1983c6a99b60SMichael S. Tsirkin $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 1984c6a99b60SMichael S. Tsirkin my ($name, $address) = parse_email($email); 1985c6a99b60SMichael S. Tsirkin if ($name eq '"[,\.]"') { 1986c6a99b60SMichael S. Tsirkin $name = ""; 1987c6a99b60SMichael S. Tsirkin } 1988c6a99b60SMichael S. Tsirkin 1989c6a99b60SMichael S. Tsirkin my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 1990c6a99b60SMichael S. Tsirkin if (@nw > 2) { 1991c6a99b60SMichael S. Tsirkin my $first = $nw[@nw - 3]; 1992c6a99b60SMichael S. Tsirkin my $middle = $nw[@nw - 2]; 1993c6a99b60SMichael S. Tsirkin my $last = $nw[@nw - 1]; 1994c6a99b60SMichael S. Tsirkin 1995c6a99b60SMichael S. Tsirkin if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 1996c6a99b60SMichael S. Tsirkin (length($first) == 2 && substr($first, -1) eq ".")) || 1997c6a99b60SMichael S. Tsirkin (length($middle) == 1 || 1998c6a99b60SMichael S. Tsirkin (length($middle) == 2 && substr($middle, -1) eq "."))) { 1999c6a99b60SMichael S. Tsirkin $name = "$first $middle $last"; 2000c6a99b60SMichael S. Tsirkin } else { 2001c6a99b60SMichael S. Tsirkin $name = "$middle $last"; 2002c6a99b60SMichael S. Tsirkin } 2003c6a99b60SMichael S. Tsirkin } 2004c6a99b60SMichael S. Tsirkin 2005c6a99b60SMichael S. Tsirkin if (substr($name, -1) =~ /[,\.]/) { 2006c6a99b60SMichael S. Tsirkin $name = substr($name, 0, length($name) - 1); 2007c6a99b60SMichael S. Tsirkin } elsif (substr($name, -2) =~ /[,\.]"/) { 2008c6a99b60SMichael S. Tsirkin $name = substr($name, 0, length($name) - 2) . '"'; 2009c6a99b60SMichael S. Tsirkin } 2010c6a99b60SMichael S. Tsirkin 2011c6a99b60SMichael S. Tsirkin if (substr($name, 0, 1) =~ /[,\.]/) { 2012c6a99b60SMichael S. Tsirkin $name = substr($name, 1, length($name) - 1); 2013c6a99b60SMichael S. Tsirkin } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 2014c6a99b60SMichael S. Tsirkin $name = '"' . substr($name, 2, length($name) - 2); 2015c6a99b60SMichael S. Tsirkin } 2016c6a99b60SMichael S. Tsirkin 2017c6a99b60SMichael S. Tsirkin my $fmt_email = format_email($name, $address, $email_usename); 2018c6a99b60SMichael S. Tsirkin push(@fmt_emails, $fmt_email); 2019c6a99b60SMichael S. Tsirkin } 2020c6a99b60SMichael S. Tsirkin return @fmt_emails; 2021c6a99b60SMichael S. Tsirkin} 2022c6a99b60SMichael S. Tsirkin 2023c6a99b60SMichael S. Tsirkinsub merge_email { 2024c6a99b60SMichael S. Tsirkin my @lines; 2025c6a99b60SMichael S. Tsirkin my %saw; 2026c6a99b60SMichael S. Tsirkin 2027c6a99b60SMichael S. Tsirkin for (@_) { 2028c6a99b60SMichael S. Tsirkin my ($address, $role) = @$_; 2029c6a99b60SMichael S. Tsirkin if (!$saw{$address}) { 2030c6a99b60SMichael S. Tsirkin if ($output_roles) { 2031c6a99b60SMichael S. Tsirkin push(@lines, "$address ($role)"); 2032c6a99b60SMichael S. Tsirkin } else { 2033c6a99b60SMichael S. Tsirkin push(@lines, $address); 2034c6a99b60SMichael S. Tsirkin } 2035c6a99b60SMichael S. Tsirkin $saw{$address} = 1; 2036c6a99b60SMichael S. Tsirkin } 2037c6a99b60SMichael S. Tsirkin } 2038c6a99b60SMichael S. Tsirkin 2039c6a99b60SMichael S. Tsirkin return @lines; 2040c6a99b60SMichael S. Tsirkin} 2041c6a99b60SMichael S. Tsirkin 2042c6a99b60SMichael S. Tsirkinsub output { 2043c6a99b60SMichael S. Tsirkin my (@parms) = @_; 2044c6a99b60SMichael S. Tsirkin 2045c6a99b60SMichael S. Tsirkin if ($output_multiline) { 2046c6a99b60SMichael S. Tsirkin foreach my $line (@parms) { 2047c6a99b60SMichael S. Tsirkin print("${line}\n"); 2048c6a99b60SMichael S. Tsirkin } 2049c6a99b60SMichael S. Tsirkin } else { 2050c6a99b60SMichael S. Tsirkin print(join($output_separator, @parms)); 2051c6a99b60SMichael S. Tsirkin print("\n"); 2052c6a99b60SMichael S. Tsirkin } 2053c6a99b60SMichael S. Tsirkin} 2054c6a99b60SMichael S. Tsirkin 2055c6a99b60SMichael S. Tsirkinmy $rfc822re; 2056c6a99b60SMichael S. Tsirkin 2057c6a99b60SMichael S. Tsirkinsub make_rfc822re { 2058c6a99b60SMichael S. Tsirkin# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 2059c6a99b60SMichael S. Tsirkin# comment. We must allow for rfc822_lwsp (or comments) after each of these. 2060c6a99b60SMichael S. Tsirkin# This regexp will only work on addresses which have had comments stripped 2061c6a99b60SMichael S. Tsirkin# and replaced with rfc822_lwsp. 2062c6a99b60SMichael S. Tsirkin 2063c6a99b60SMichael S. Tsirkin my $specials = '()<>@,;:\\\\".\\[\\]'; 2064c6a99b60SMichael S. Tsirkin my $controls = '\\000-\\037\\177'; 2065c6a99b60SMichael S. Tsirkin 2066c6a99b60SMichael S. Tsirkin my $dtext = "[^\\[\\]\\r\\\\]"; 2067c6a99b60SMichael S. Tsirkin my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 2068c6a99b60SMichael S. Tsirkin 2069c6a99b60SMichael S. Tsirkin my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 2070c6a99b60SMichael S. Tsirkin 2071c6a99b60SMichael S. Tsirkin# Use zero-width assertion to spot the limit of an atom. A simple 2072c6a99b60SMichael S. Tsirkin# $rfc822_lwsp* causes the regexp engine to hang occasionally. 2073c6a99b60SMichael S. Tsirkin my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 2074c6a99b60SMichael S. Tsirkin my $word = "(?:$atom|$quoted_string)"; 2075c6a99b60SMichael S. Tsirkin my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 2076c6a99b60SMichael S. Tsirkin 2077c6a99b60SMichael S. Tsirkin my $sub_domain = "(?:$atom|$domain_literal)"; 2078c6a99b60SMichael S. Tsirkin my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 2079c6a99b60SMichael S. Tsirkin 2080c6a99b60SMichael S. Tsirkin my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 2081c6a99b60SMichael S. Tsirkin 2082c6a99b60SMichael S. Tsirkin my $phrase = "$word*"; 2083c6a99b60SMichael S. Tsirkin my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 2084c6a99b60SMichael S. Tsirkin my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 2085c6a99b60SMichael S. Tsirkin my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 2086c6a99b60SMichael S. Tsirkin 2087c6a99b60SMichael S. Tsirkin my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 2088c6a99b60SMichael S. Tsirkin my $address = "(?:$mailbox|$group)"; 2089c6a99b60SMichael S. Tsirkin 2090c6a99b60SMichael S. Tsirkin return "$rfc822_lwsp*$address"; 2091c6a99b60SMichael S. Tsirkin} 2092c6a99b60SMichael S. Tsirkin 2093c6a99b60SMichael S. Tsirkinsub rfc822_strip_comments { 2094c6a99b60SMichael S. Tsirkin my $s = shift; 2095c6a99b60SMichael S. Tsirkin# Recursively remove comments, and replace with a single space. The simpler 2096c6a99b60SMichael S. Tsirkin# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 2097c6a99b60SMichael S. Tsirkin# chars in atoms, for example. 2098c6a99b60SMichael S. Tsirkin 2099c6a99b60SMichael S. Tsirkin while ($s =~ s/^((?:[^"\\]|\\.)* 2100c6a99b60SMichael S. Tsirkin (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 2101c6a99b60SMichael S. Tsirkin \((?:[^()\\]|\\.)*\)/$1 /osx) {} 2102c6a99b60SMichael S. Tsirkin return $s; 2103c6a99b60SMichael S. Tsirkin} 2104c6a99b60SMichael S. Tsirkin 2105c6a99b60SMichael S. Tsirkin# valid: returns true if the parameter is an RFC822 valid address 2106c6a99b60SMichael S. Tsirkin# 2107c6a99b60SMichael S. Tsirkinsub rfc822_valid { 2108c6a99b60SMichael S. Tsirkin my $s = rfc822_strip_comments(shift); 2109c6a99b60SMichael S. Tsirkin 2110c6a99b60SMichael S. Tsirkin if (!$rfc822re) { 2111c6a99b60SMichael S. Tsirkin $rfc822re = make_rfc822re(); 2112c6a99b60SMichael S. Tsirkin } 2113c6a99b60SMichael S. Tsirkin 2114c6a99b60SMichael S. Tsirkin return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 2115c6a99b60SMichael S. Tsirkin} 2116c6a99b60SMichael S. Tsirkin 2117c6a99b60SMichael S. Tsirkin# validlist: In scalar context, returns true if the parameter is an RFC822 2118c6a99b60SMichael S. Tsirkin# valid list of addresses. 2119c6a99b60SMichael S. Tsirkin# 2120c6a99b60SMichael S. Tsirkin# In list context, returns an empty list on failure (an invalid 2121c6a99b60SMichael S. Tsirkin# address was found); otherwise a list whose first element is the 2122c6a99b60SMichael S. Tsirkin# number of addresses found and whose remaining elements are the 2123c6a99b60SMichael S. Tsirkin# addresses. This is needed to disambiguate failure (invalid) 2124c6a99b60SMichael S. Tsirkin# from success with no addresses found, because an empty string is 2125c6a99b60SMichael S. Tsirkin# a valid list. 2126c6a99b60SMichael S. Tsirkin 2127c6a99b60SMichael S. Tsirkinsub rfc822_validlist { 2128c6a99b60SMichael S. Tsirkin my $s = rfc822_strip_comments(shift); 2129c6a99b60SMichael S. Tsirkin 2130c6a99b60SMichael S. Tsirkin if (!$rfc822re) { 2131c6a99b60SMichael S. Tsirkin $rfc822re = make_rfc822re(); 2132c6a99b60SMichael S. Tsirkin } 2133c6a99b60SMichael S. Tsirkin # * null list items are valid according to the RFC 2134c6a99b60SMichael S. Tsirkin # * the '1' business is to aid in distinguishing failure from no results 2135c6a99b60SMichael S. Tsirkin 2136c6a99b60SMichael S. Tsirkin my @r; 2137c6a99b60SMichael S. Tsirkin if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 2138c6a99b60SMichael S. Tsirkin $s =~ m/^$rfc822_char*$/) { 2139c6a99b60SMichael S. Tsirkin while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 2140c6a99b60SMichael S. Tsirkin push(@r, $1); 2141c6a99b60SMichael S. Tsirkin } 2142c6a99b60SMichael S. Tsirkin return wantarray ? (scalar(@r), @r) : 1; 2143c6a99b60SMichael S. Tsirkin } 2144c6a99b60SMichael S. Tsirkin return wantarray ? () : 0; 2145c6a99b60SMichael S. Tsirkin} 2146