Newer
Older
#!/usr/bin/perl -w
# (c) 2007, Joe Perches <joe@perches.com>
# created from checkpatch.pl
#
# Print selected MAINTAINERS information for
# the files modified in a patch or for a file
#
# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
# perl scripts/get_maintainer.pl [OPTIONS] -f <file>
#
# Licensed under the terms of the GNU GPL License version 2
use strict;
my $P = $0;
Joe Perches
committed
my $V = '0.26-beta5';
use Getopt::Long qw(:config no_auto_abbrev);
my $lk_path = "./";
my $email = 1;
my $email_usename = 1;
my $email_maintainer = 1;
my $email_list = 1;
my $email_subscriber_list = 0;
my $email_git_penguin_chiefs = 0;
my $email_git = 0;
my $email_git_all_signature_types = 0;
my $email_git_blame = 0;
my $email_git_blame_signatures = 1;
my $email_git_fallback = 1;
my $email_git_min_signatures = 1;
my $email_git_max_maintainers = 5;
my $email_git_min_percent = 5;
my $email_hg_since = "-365";
my $email_remove_duplicates = 1;
Joe Perches
committed
my $email_use_mailmap = 1;
my $output_multiline = 1;
my $output_separator = ", ";
my $output_roles = 0;
my $output_rolestats = 0;
my $scm = 0;
my $web = 0;
my $subsystem = 0;
my $status = 0;
my $keywords = 1;
my $sections = 0;
my $file_emails = 0;
my $from_filename = 0;
my %commit_author_hash;
my %commit_signer_hash;
push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
#Andrew wants in on most everything - 2009/01/14
#push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
my @penguin_chief_names = ();
foreach my $chief (@penguin_chief) {
if ($chief =~ m/^(.*):(.*)/) {
my $chief_name = $1;
my $chief_addr = $2;
push(@penguin_chief_names, $chief_name);
}
}
my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
# Signature types of people who are either
# a) responsible for the code in question, or
# b) familiar enough with it to give relevant feedback
my @signature_tags = ();
push(@signature_tags, "Signed-off-by:");
push(@signature_tags, "Reviewed-by:");
push(@signature_tags, "Acked-by:");
# rfc822 email address - preloaded methods go here.
Joe Perches
committed
my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
my $rfc822_char = '[\\000-\\377]';
Joe Perches
committed
# VCS command support: class-like functions and strings
my %VCS_cmds;
my %VCS_cmds_git = (
"execute_cmd" => \&git_execute_cmd,
"available" => '(which("git") ne "") && (-d ".git")',
"find_signers_cmd" =>
"git log --no-color --since=\$email_git_since " .
'--format="GitCommit: %H%n' .
'GitAuthor: %an <%ae>%n' .
'GitDate: %aD%n' .
'GitSubject: %s%n' .
'%b%n"' .
" -- \$file",
"find_commit_signers_cmd" =>
"git log --no-color " .
'--format="GitCommit: %H%n' .
'GitAuthor: %an <%ae>%n' .
'GitDate: %aD%n' .
'GitSubject: %s%n' .
'%b%n"' .
" -1 \$commit",
"find_commit_author_cmd" =>
"git log --no-color " .
'--format="GitCommit: %H%n' .
'GitAuthor: %an <%ae>%n' .
'GitDate: %aD%n' .
'GitSubject: %s%n"' .
" -1 \$commit",
"blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
"blame_file_cmd" => "git blame -l \$file",
"commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
"blame_commit_pattern" => "^([0-9a-f]+) ",
"author_pattern" => "^GitAuthor: (.*)",
"subject_pattern" => "^GitSubject: (.*)",
);
my %VCS_cmds_hg = (
"execute_cmd" => \&hg_execute_cmd,
"available" => '(which("hg") ne "") && (-d ".hg")',
"find_signers_cmd" =>
"hg log --date=\$email_hg_since " .
"--template='HgCommit: {node}\\n" .
"HgAuthor: {author}\\n" .
"HgSubject: {desc}\\n'" .
" -- \$file",
"find_commit_signers_cmd" =>
"hg log " .
"--template='HgSubject: {desc}\\n'" .
" -r \$commit",
"find_commit_author_cmd" =>
"hg log " .
"--template='HgCommit: {node}\\n" .
"HgAuthor: {author}\\n" .
"HgSubject: {desc|firstline}\\n'" .
" -r \$commit",
"blame_range_cmd" => "", # not supported
"blame_file_cmd" => "hg blame -n \$file",
"commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
"blame_commit_pattern" => "^([ 0-9a-f]+):",
"author_pattern" => "^HgAuthor: (.*)",
"subject_pattern" => "^HgSubject: (.*)",
Joe Perches
committed
my $conf = which_conf(".get_maintainer.conf");
if (-f $conf) {
my @conf_args;
Joe Perches
committed
open(my $conffile, '<', "$conf")
or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
while (<$conffile>) {
my $line = $_;
$line =~ s/\s*\n?$//g;
$line =~ s/^\s*//g;
$line =~ s/\s+/ /g;
next if ($line =~ m/^\s*#/);
next if ($line =~ m/^\s*$/);
my @words = split(" ", $line);
foreach my $word (@words) {
last if ($word =~ m/^#/);
push (@conf_args, $word);
}
}
close($conffile);
unshift(@ARGV, @conf_args) if @conf_args;
}
if (!GetOptions(
'email!' => \$email,
'git!' => \$email_git,
'git-all-signature-types!' => \$email_git_all_signature_types,
'git-blame!' => \$email_git_blame,
'git-blame-signatures!' => \$email_git_blame_signatures,
'git-fallback!' => \$email_git_fallback,
'git-chief-penguins!' => \$email_git_penguin_chiefs,
'git-min-signatures=i' => \$email_git_min_signatures,
'git-max-maintainers=i' => \$email_git_max_maintainers,
'git-min-percent=i' => \$email_git_min_percent,
'hg-since=s' => \$email_hg_since,
'i|interactive!' => \$interactive,
'remove-duplicates!' => \$email_remove_duplicates,
Joe Perches
committed
'mailmap!' => \$email_use_mailmap,
'm!' => \$email_maintainer,
'n!' => \$email_usename,
'l!' => \$email_list,
's!' => \$email_subscriber_list,
'multiline!' => \$output_multiline,
'roles!' => \$output_roles,
'rolestats!' => \$output_rolestats,
'separator=s' => \$output_separator,
'subsystem!' => \$subsystem,
'status!' => \$status,
'scm!' => \$scm,
'web!' => \$web,
'pattern-depth=i' => \$pattern_depth,
'k|keywords!' => \$keywords,
'sections!' => \$sections,
'fe|file-emails!' => \$file_emails,
'f|file' => \$from_filename,
'h|help|usage' => \$help,
die "$P: invalid argument - use --help if necessary\n";
}
if ($help != 0) {
usage();
exit 0;
}
if ($version != 0) {
print("${P} ${V}\n");
exit 0;
}
if (-t STDIN && !@ARGV) {
# We're talking to a terminal, but have no command line arguments.
die "$P: missing patchfile or -f file - use --help if necessary\n";
$output_multiline = 0 if ($output_separator ne ", ");
$output_rolestats = 1 if ($interactive);
$output_roles = 1 if ($output_rolestats);
if ($sections) {
$email = 0;
$email_list = 0;
$scm = 0;
$status = 0;
$subsystem = 0;
$web = 0;
$keywords = 0;
$interactive = 0;
} else {
my $selections = $email + $scm + $status + $subsystem + $web;
if ($selections == 0) {
die "$P: Missing required option: email, scm, status, subsystem or web\n";
}
if ($email &&
($email_maintainer + $email_list + $email_subscriber_list +
$email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
die "$P: Please select at least 1 email option\n";
}
if (!top_of_kernel_tree($lk_path)) {
die "$P: The current directory does not appear to be "
. "a linux kernel source tree.\n";
}
## Read MAINTAINERS for type/value pairs
my @typevalue = ();
my %keyword_hash;
open (my $maint, '<', "${lk_path}MAINTAINERS")
or die "$P: Can't open MAINTAINERS: $!\n";
while (<$maint>) {
my $line = $_;
if ($line =~ m/^(\C):\s*(.*)/) {
my $type = $1;
my $value = $2;
##Filename pattern matching
if ($type eq "F" || $type eq "X") {
$value =~ s@\.@\\\.@g; ##Convert . to \.
$value =~ s/\*/\.\*/g; ##Convert * to .*
$value =~ s/\?/\./g; ##Convert ? to .
##if pattern is a directory and it lacks a trailing slash, add one
if ((-d $value)) {
$value =~ s@([^/])$@$1/@;
}
} elsif ($type eq "K") {
$keyword_hash{@typevalue} = $value;
}
push(@typevalue, "$type:$value");
} elsif (!/^(\s)*$/) {
$line =~ s/\n$//g;
push(@typevalue, $line);
}
}
#
# Read mail address map
#
Joe Perches
committed
my $mailmap;
read_mailmap();
sub read_mailmap {
Joe Perches
committed
$mailmap = {
names => {},
addresses => {}
Joe Perches
committed
return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
open(my $mailmap_file, '<', "${lk_path}.mailmap")
or warn "$P: Can't open .mailmap: $!\n";
while (<$mailmap_file>) {
s/#.*$//; #strip comments
s/^\s+|\s+$//g; #trim
next if (/^\s*$/); #skip empty lines
#entries have one of the following formats:
# name1 <mail1>
# <mail1> <mail2>
# name1 <mail1> <mail2>
# name1 <mail1> name2 <mail2>
# (see man git-shortlog)
if (/^(.+)<(.+)>$/) {
my $real_name = $1;
my $address = $2;
$real_name =~ s/\s+$//;
Joe Perches
committed
($real_name, $address) = parse_email("$real_name <$address>");
$mailmap->{names}->{$address} = $real_name;
} elsif (/^<([^\s]+)>\s*<([^\s]+)>$/) {
my $real_address = $1;
my $wrong_address = $2;
$mailmap->{addresses}->{$wrong_address} = $real_address;
} elsif (/^(.+)<([^\s]+)>\s*<([^\s]+)>$/) {
Joe Perches
committed
my $real_name = $1;
my $real_address = $2;
my $wrong_address = $3;
$real_name =~ s/\s+$//;
Joe Perches
committed
($real_name, $real_address) =
parse_email("$real_name <$real_address>");
$mailmap->{names}->{$wrong_address} = $real_name;
$mailmap->{addresses}->{$wrong_address} = $real_address;
} elsif (/^(.+)<([^\s]+)>\s*([^\s].*)<([^\s]+)>$/) {
my $real_name = $1;
my $real_address = $2;
my $wrong_name = $3;
my $wrong_address = $4;
$real_name =~ s/\s+$//;
Joe Perches
committed
($real_name, $real_address) =
parse_email("$real_name <$real_address>");
$wrong_name =~ s/\s+$//;
Joe Perches
committed
($wrong_name, $wrong_address) =
parse_email("$wrong_name <$wrong_address>");
Joe Perches
committed
my $wrong_email = format_email($wrong_name, $wrong_address, 1);
$mailmap->{names}->{$wrong_email} = $real_name;
$mailmap->{addresses}->{$wrong_email} = $real_address;
}
## use the filenames on the command line or find the filenames in the patchfiles
my @keyword_tvi = ();
my @file_emails = ();
if (!@ARGV) {
push(@ARGV, "&STDIN");
}
foreach my $file (@ARGV) {
if ($file ne "&STDIN") {
##if $file is a directory and it lacks a trailing slash, add one
if ((-d $file)) {
$file =~ s@([^/])$@$1/@;
} elsif (!(-f $file)) {
die "$P: file '${file}' not found\n";
}
if ($from_filename) {
push(@files, $file);
if ($file ne "MAINTAINERS" && -f $file && ($keywords || $file_emails)) {
open(my $f, '<', $file)
or die "$P: Can't open $file: $!\n";
my $text = do { local($/) ; <$f> };
close($f);
if ($keywords) {
foreach my $line (keys %keyword_hash) {
if ($text =~ m/$keyword_hash{$line}/x) {
push(@keyword_tvi, $line);
}
if ($file_emails) {
my @poss_addr = $text =~ m$[A-Za-zÀ-ÿ\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
push(@file_emails, clean_file_emails(@poss_addr));
}
} else {
my $file_cnt = @files;
or die "$P: Can't open $file: $!\n";
while (<$patch>) {
my $patch_line = $_;
if (m/^\+\+\+\s+(\S+)/) {
my $filename = $1;
$filename =~ s@^[^/]*/@@;
$filename =~ s@\n@@;
push(@files, $filename);
} elsif (m/^\@\@ -(\d+),(\d+)/) {
if ($email_git_blame) {
push(@range, "$lastfile:$1:$2");
}
} elsif ($keywords) {
foreach my $line (keys %keyword_hash) {
if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) {
push(@keyword_tvi, $line);
}
}
if ($file_cnt == @files) {
Joe Perches
committed
warn "$P: file '${file}' doesn't appear to be a patch. "
. "Add -f to options?\n";
}
@files = sort_and_uniq(@files);
@file_emails = uniq(@file_emails);
my %email_hash_name;
my %email_hash_address;
Joe Perches
committed
my @list_to = ();
my @scm = ();
my @web = ();
my @subsystem = ();
my @status = ();
Joe Perches
committed
my %deduplicate_name_hash = ();
my %deduplicate_address_hash = ();
my $signature_pattern;
my @maintainers = get_maintainers();
if (@maintainers) {
@maintainers = merge_email(@maintainers);
output(@maintainers);
}
if ($scm) {
@scm = uniq(@scm);
output(@scm);
}
if ($status) {
@status = uniq(@status);
output(@status);
}
if ($subsystem) {
@subsystem = uniq(@subsystem);
output(@subsystem);
}
if ($web) {
@web = uniq(@web);
output(@web);
}
exit($exit);
sub get_maintainers {
%email_hash_name = ();
%email_hash_address = ();
%commit_author_hash = ();
%commit_signer_hash = ();
@email_to = ();
%hash_list_to = ();
@list_to = ();
@scm = ();
@web = ();
@subsystem = ();
@status = ();
Joe Perches
committed
%deduplicate_name_hash = ();
%deduplicate_address_hash = ();
if ($email_git_all_signature_types) {
$signature_pattern = "(.+?)[Bb][Yy]:";
} else {
$signature_pattern = "\(" . join("|", @signature_tags) . "\)";
}
# Find responsible parties
Joe Perches
committed
my %exact_pattern_match_hash = ();
foreach my $file (@files) {
my %hash;
my $tvi = find_first_section();
while ($tvi < @typevalue) {
my $start = find_starting_index($tvi);
my $end = find_ending_index($tvi);
my $exclude = 0;
my $i;
#Do not match excluded file patterns
for ($i = $start; $i < $end; $i++) {
my $line = $typevalue[$i];
if ($line =~ m/^(\C):\s*(.*)/) {
my $type = $1;
my $value = $2;
if (file_match_pattern($file, $value)) {
$exclude = 1;
last;
}
}
}
}
if (!$exclude) {
for ($i = $start; $i < $end; $i++) {
my $line = $typevalue[$i];
if ($line =~ m/^(\C):\s*(.*)/) {
my $type = $1;
my $value = $2;
if ($type eq 'F') {
if (file_match_pattern($file, $value)) {
my $value_pd = ($value =~ tr@/@@);
my $file_pd = ($file =~ tr@/@@);
$value_pd++ if (substr($value,-1,1) ne "/");
$value_pd = -1 if ($value =~ /^\.\*/);
if ($value_pd >= $file_pd) {
$exact_pattern_match_hash{$file} = 1;
}
if ($pattern_depth == 0 ||
(($file_pd - $value_pd) < $pattern_depth)) {
$hash{$tvi} = $value_pd;
}
}
}
}
}
}
foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
add_categories($line);
if ($sections) {
my $i;
my $start = find_starting_index($line);
my $end = find_ending_index($line);
for ($i = $start; $i < $end; $i++) {
my $line = $typevalue[$i];
if ($line =~ /^[FX]:/) { ##Restore file patterns
$line =~ s/([^\\])\.([^\*])/$1\?$2/g;
$line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ?
$line =~ s/\\\./\./g; ##Convert \. to .
$line =~ s/\.\*/\*/g; ##Convert .* to *
}
$line =~ s/^([A-Z]):/$1:\t/g;
print("$line\n");
}
}
if ($keywords) {
@keyword_tvi = sort_and_uniq(@keyword_tvi);
foreach my $line (@keyword_tvi) {
add_categories($line);
}
Joe Perches
committed
foreach my $email (@email_to, @list_to) {
$email->[0] = deduplicate_email($email->[0]);
}
foreach my $file (@files) {
if ($email &&
($email_git || ($email_git_fallback &&
!$exact_pattern_match_hash{$file}))) {
vcs_file_signoffs($file);
}
if ($email && $email_git_blame) {
vcs_file_blame($file);
}
}
if ($email) {
foreach my $chief (@penguin_chief) {
if ($chief =~ m/^(.*):(.*)/) {
my $email_address;
Joe Perches
committed
$email_address = format_email($1, $2, $email_usename);
if ($email_git_penguin_chiefs) {
push(@email_to, [$email_address, 'chief penguin']);
} else {
@email_to = grep($_->[0] !~ /${email_address}/, @email_to);
}
foreach my $email (@file_emails) {
my ($name, $address) = parse_email($email);
my $tmp_email = format_email($name, $address, $email_usename);
push_email_address($tmp_email, '');
add_role($tmp_email, 'in file');
}
}
Joe Perches
committed
my @to = ();
if ($email || $email_list) {
if ($email) {
@to = (@to, @email_to);
}
if ($email_list) {
@to = (@to, @list_to);
Joe Perches
committed
}
if ($interactive) {
Joe Perches
committed
@to = interactive_get_maintainers(\@to);
}
sub file_match_pattern {
my ($file, $pattern) = @_;
if (substr($pattern, -1) eq "/") {
if ($file =~ m@^$pattern@) {
return 1;
}
} else {
if ($file =~ m@^$pattern@) {
my $s1 = ($file =~ tr@/@@);
my $s2 = ($pattern =~ tr@/@@);
if ($s1 == $s2) {
return 1;
}
}
}
return 0;
}
sub usage {
print <<EOT;
usage: $P [options] patchfile
$P [options] -f file|directory
version: $V
MAINTAINER field selection options:
--email => print email address(es) if any
--git => include recent git \*-by: signers
--git-all-signature-types => include signers regardless of signature type
or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
--git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
--git-chief-penguins => include ${penguin_chiefs}
--git-min-signatures => number of signatures required (default: $email_git_min_signatures)
--git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
--git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
--git-blame => use git blame to find modified commits for patch or file
--git-since => git history to use (default: $email_git_since)
--hg-since => hg history to use (default: $email_hg_since)
--interactive => display a menu (mostly useful if used with the --git option)
--m => include maintainer(s) if any
--n => include name 'Full Name <addr\@domain.tld>'
--l => include list(s) if any
--s => include subscriber only list(s) if any
--remove-duplicates => minimize duplicate email names/addresses
--roles => show roles (status:subsystem, git-signer, list, etc...)
--rolestats => show roles and statistics (commits/total_commits, %)
--file-emails => add email addresses found in -f file (default: 0 (off))
--scm => print SCM tree(s) if any
--status => print status if any
--subsystem => print subsystem name if any
--web => print website(s) if any
Output type options:
--separator [, ] => separator for multiple entries on 1 line
using --separator also sets --nomultiline if --separator is not [, ]
--multiline => print 1 entry per line
Other options:
--pattern-depth => Number of pattern directory traversals (default: 0 (all))
Joe Perches
committed
--keywords => scan patch for keywords (default: $keywords)
--sections => print all of the subsystem sections with pattern matches
--mailmap => use .mailmap file (default: $email_use_mailmap)
Joe Perches
committed
--version => show version
[--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates]
Notes:
Using "-f directory" may give unexpected results:
Used with "--git", git signators for _all_ files in and below
directory are examined as git recurses directories.
Any specified X: (exclude) pattern matches are _not_ ignored.
Used with "--nogit", directory is used as a pattern match,
no individual file within the directory or subdirectory
is matched.
Used with "--git-blame", does not iterate all files in directory
Using "--git-blame" is slow and may add old committers and authors
that are no longer active maintainers to the output.
Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
other automated tools that expect only ["name"] <email address>
may not work because of additional output after <email address>.
Using "--rolestats" and "--git-blame" shows the #/total=% commits,
not the percentage of the entire file authored. # of commits is
not a good measure of amount of code authored. 1 major commit may
contain a thousand lines, 5 trivial commits may modify a single line.
If git is not installed, but mercurial (hg) is installed and an .hg
repository exists, the following options apply to mercurial:
--git,
--git-min-signatures, --git-max-maintainers, --git-min-percent, and
--git-blame
Use --hg-since not --git-since to control date selection
File ".get_maintainer.conf", if it exists in the linux kernel source root
directory, can change whatever get_maintainer defaults are desired.
Entries in this file can be any command line argument.
This file is prepended to any additional command line arguments.
Multiple lines and # comments are allowed.
my ($lk_path) = @_;
if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
$lk_path .= "/";
}
if ( (-f "${lk_path}COPYING")
&& (-f "${lk_path}CREDITS")
&& (-f "${lk_path}Kbuild")
&& (-f "${lk_path}MAINTAINERS")
&& (-f "${lk_path}Makefile")
&& (-f "${lk_path}README")
&& (-d "${lk_path}Documentation")
&& (-d "${lk_path}arch")
&& (-d "${lk_path}include")
&& (-d "${lk_path}drivers")
&& (-d "${lk_path}fs")
&& (-d "${lk_path}init")
&& (-d "${lk_path}ipc")
&& (-d "${lk_path}kernel")
&& (-d "${lk_path}lib")
&& (-d "${lk_path}scripts")) {
return 1;
}
return 0;
Joe Perches
committed
sub parse_email {
my ($formatted_email) = @_;
my $name = "";
my $address = "";
if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
Joe Perches
committed
$name = $1;
$address = $2;
} elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
Joe Perches
committed
$address = $1;
} elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
Joe Perches
committed
$address = $1;
}
$name =~ s/^\"|\"$//g;
Joe Perches
committed
$address =~ s/^\s+|\s+$//g;
if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
Joe Perches
committed
$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
$name = "\"$name\"";
}
return ($name, $address);
}
sub format_email {
my ($name, $address, $usename) = @_;
Joe Perches
committed
my $formatted_email;
$name =~ s/^\s+|\s+$//g;
$name =~ s/^\"|\"$//g;
$address =~ s/^\s+|\s+$//g;
if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
Joe Perches
committed
$name = "\"$name\"";
}
if ($usename) {
Joe Perches
committed
if ("$name" eq "") {
$formatted_email = "$address";
} else {
$formatted_email = "$name <$address>";
Joe Perches
committed
}
Joe Perches
committed
$formatted_email = $address;
Joe Perches
committed
sub find_first_section {
my $index = 0;
while ($index < @typevalue) {
my $tv = $typevalue[$index];
if (($tv =~ m/^(\C):\s*(.*)/)) {
last;
}
$index++;
}
return $index;
}
sub find_starting_index {
my ($index) = @_;
while ($index > 0) {
my $tv = $typevalue[$index];
if (!($tv =~ m/^(\C):\s*(.*)/)) {
last;
}
$index--;
}
return $index;
}
sub find_ending_index {
while ($index < @typevalue) {
if (!($tv =~ m/^(\C):\s*(.*)/)) {
last;
}
$index++;
}
return $index;
}
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
sub get_maintainer_role {
my ($index) = @_;
my $i;
my $start = find_starting_index($index);
my $end = find_ending_index($index);
my $role;
my $subsystem = $typevalue[$start];
if (length($subsystem) > 20) {
$subsystem = substr($subsystem, 0, 17);
$subsystem =~ s/\s*$//;
$subsystem = $subsystem . "...";
}
for ($i = $start + 1; $i < $end; $i++) {
my $tv = $typevalue[$i];
if ($tv =~ m/^(\C):\s*(.*)/) {
my $ptype = $1;
my $pvalue = $2;
if ($ptype eq "S") {
$role = $pvalue;
}
}
}
$role = lc($role);
if ($role eq "supported") {
$role = "supporter";
} elsif ($role eq "maintained") {
$role = "maintainer";
} elsif ($role eq "odd fixes") {
$role = "odd fixer";
} elsif ($role eq "orphan") {
$role = "orphan minder";
} elsif ($role eq "obsolete") {
$role = "obsolete minder";
} elsif ($role eq "buried alive in reporters") {
$role = "chief penguin";
}
return $role . ":" . $subsystem;
}
sub get_list_role {
my ($index) = @_;
my $i;
my $start = find_starting_index($index);
my $end = find_ending_index($index);
my $subsystem = $typevalue[$start];
if (length($subsystem) > 20) {
$subsystem = substr($subsystem, 0, 17);
$subsystem =~ s/\s*$//;
$subsystem = $subsystem . "...";
}
if ($subsystem eq "THE REST") {
$subsystem = "";
}
return $subsystem;
}
sub add_categories {
my ($index) = @_;
my $i;
my $start = find_starting_index($index);
my $end = find_ending_index($index);
push(@subsystem, $typevalue[$start]);
for ($i = $start + 1; $i < $end; $i++) {
my $tv = $typevalue[$i];
Joe Perches
committed
if ($tv =~ m/^(\C):\s*(.*)/) {
my $ptype = $1;
my $pvalue = $2;
if ($ptype eq "L") {
Joe Perches
committed
my $list_address = $pvalue;
my $list_additional = "";
my $list_role = get_list_role($i);
if ($list_role ne "") {
$list_role = ":" . $list_role;
}
Joe Perches
committed
if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
$list_address = $1;
$list_additional = $2;
}
if ($list_additional =~ m/subscribers-only/) {
if (!$hash_list_to{lc($list_address)}) {
$hash_list_to{lc($list_address)} = 1;
push(@list_to, [$list_address,
"subscriber list${list_role}"]);
}
if (!$hash_list_to{lc($list_address)}) {
$hash_list_to{lc($list_address)} = 1;
push(@list_to, [$list_address,
"open list${list_role}"]);
}
Joe Perches
committed
my ($name, $address) = parse_email($pvalue);
if ($name eq "") {
if ($i > 0) {
my $tv = $typevalue[$i - 1];
Joe Perches
committed
if ($tv =~ m/^(\C):\s*(.*)/) {
if ($1 eq "P") {
$name = $2;
$pvalue = format_email($name, $address, $email_usename);