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