Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 1 | #!/usr/bin/perl -w |
| 2 | # (c) 2007, Joe Perches <joe@perches.com> |
| 3 | # created from checkpatch.pl |
| 4 | # |
| 5 | # Print selected MAINTAINERS information for |
| 6 | # the files modified in a patch or for a file |
| 7 | # |
| 8 | # usage: perl scripts/get_maintainers.pl [OPTIONS] <patch> |
| 9 | # perl scripts/get_maintainers.pl [OPTIONS] -f <file> |
| 10 | # |
| 11 | # Licensed under the terms of the GNU GPL License version 2 |
| 12 | |
| 13 | use strict; |
| 14 | |
| 15 | my $P = $0; |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 16 | my $V = '0.20'; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 17 | |
| 18 | use Getopt::Long qw(:config no_auto_abbrev); |
| 19 | |
| 20 | my $lk_path = "./"; |
| 21 | my $email = 1; |
| 22 | my $email_usename = 1; |
| 23 | my $email_maintainer = 1; |
| 24 | my $email_list = 1; |
| 25 | my $email_subscriber_list = 0; |
| 26 | my $email_git = 1; |
| 27 | my $email_git_penguin_chiefs = 0; |
| 28 | my $email_git_min_signatures = 1; |
| 29 | my $email_git_max_maintainers = 5; |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 30 | my $email_git_min_percent = 5; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 31 | my $email_git_since = "1-year-ago"; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 32 | my $email_git_blame = 0; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 33 | my $output_multiline = 1; |
| 34 | my $output_separator = ", "; |
| 35 | my $scm = 0; |
| 36 | my $web = 0; |
| 37 | my $subsystem = 0; |
| 38 | my $status = 0; |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 39 | my $from_filename = 0; |
Joe Perches | 3fb5565 | 2009-09-21 17:04:17 -0700 | [diff] [blame] | 40 | my $pattern_depth = 0; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 41 | my $version = 0; |
| 42 | my $help = 0; |
| 43 | |
| 44 | my $exit = 0; |
| 45 | |
| 46 | my @penguin_chief = (); |
| 47 | push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org"); |
| 48 | #Andrew wants in on most everything - 2009/01/14 |
| 49 | #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org"); |
| 50 | |
| 51 | my @penguin_chief_names = (); |
| 52 | foreach my $chief (@penguin_chief) { |
| 53 | if ($chief =~ m/^(.*):(.*)/) { |
| 54 | my $chief_name = $1; |
| 55 | my $chief_addr = $2; |
| 56 | push(@penguin_chief_names, $chief_name); |
| 57 | } |
| 58 | } |
| 59 | my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)"; |
| 60 | |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 61 | # rfc822 email address - preloaded methods go here. |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 62 | my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; |
Joe Perches | df4cc03 | 2009-06-16 15:34:04 -0700 | [diff] [blame] | 63 | my $rfc822_char = '[\\000-\\377]'; |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 64 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 65 | if (!GetOptions( |
| 66 | 'email!' => \$email, |
| 67 | 'git!' => \$email_git, |
| 68 | 'git-chief-penguins!' => \$email_git_penguin_chiefs, |
| 69 | 'git-min-signatures=i' => \$email_git_min_signatures, |
| 70 | 'git-max-maintainers=i' => \$email_git_max_maintainers, |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 71 | 'git-min-percent=i' => \$email_git_min_percent, |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 72 | 'git-since=s' => \$email_git_since, |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 73 | 'git-blame!' => \$email_git_blame, |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 74 | 'm!' => \$email_maintainer, |
| 75 | 'n!' => \$email_usename, |
| 76 | 'l!' => \$email_list, |
| 77 | 's!' => \$email_subscriber_list, |
| 78 | 'multiline!' => \$output_multiline, |
| 79 | 'separator=s' => \$output_separator, |
| 80 | 'subsystem!' => \$subsystem, |
| 81 | 'status!' => \$status, |
| 82 | 'scm!' => \$scm, |
| 83 | 'web!' => \$web, |
Joe Perches | 3fb5565 | 2009-09-21 17:04:17 -0700 | [diff] [blame] | 84 | 'pattern-depth=i' => \$pattern_depth, |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 85 | 'f|file' => \$from_filename, |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 86 | 'v|version' => \$version, |
| 87 | 'h|help' => \$help, |
| 88 | )) { |
| 89 | usage(); |
| 90 | die "$P: invalid argument\n"; |
| 91 | } |
| 92 | |
| 93 | if ($help != 0) { |
| 94 | usage(); |
| 95 | exit 0; |
| 96 | } |
| 97 | |
| 98 | if ($version != 0) { |
| 99 | print("${P} ${V}\n"); |
| 100 | exit 0; |
| 101 | } |
| 102 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 103 | if ($#ARGV < 0) { |
| 104 | usage(); |
| 105 | die "$P: argument missing: patchfile or -f file please\n"; |
| 106 | } |
| 107 | |
| 108 | my $selections = $email + $scm + $status + $subsystem + $web; |
| 109 | if ($selections == 0) { |
| 110 | usage(); |
| 111 | die "$P: Missing required option: email, scm, status, subsystem or web\n"; |
| 112 | } |
| 113 | |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 114 | if ($email && |
| 115 | ($email_maintainer + $email_list + $email_subscriber_list + |
| 116 | $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 117 | usage(); |
| 118 | die "$P: Please select at least 1 email option\n"; |
| 119 | } |
| 120 | |
| 121 | if (!top_of_kernel_tree($lk_path)) { |
| 122 | die "$P: The current directory does not appear to be " |
| 123 | . "a linux kernel source tree.\n"; |
| 124 | } |
| 125 | |
| 126 | ## Read MAINTAINERS for type/value pairs |
| 127 | |
| 128 | my @typevalue = (); |
| 129 | open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n"; |
| 130 | while (<MAINT>) { |
| 131 | my $line = $_; |
| 132 | |
| 133 | if ($line =~ m/^(\C):\s*(.*)/) { |
| 134 | my $type = $1; |
| 135 | my $value = $2; |
| 136 | |
| 137 | ##Filename pattern matching |
| 138 | if ($type eq "F" || $type eq "X") { |
| 139 | $value =~ s@\.@\\\.@g; ##Convert . to \. |
| 140 | $value =~ s/\*/\.\*/g; ##Convert * to .* |
| 141 | $value =~ s/\?/\./g; ##Convert ? to . |
Joe Perches | 870020f | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 142 | ##if pattern is a directory and it lacks a trailing slash, add one |
| 143 | if ((-d $value)) { |
| 144 | $value =~ s@([^/])$@$1/@; |
| 145 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 146 | } |
| 147 | push(@typevalue, "$type:$value"); |
| 148 | } elsif (!/^(\s)*$/) { |
| 149 | $line =~ s/\n$//g; |
| 150 | push(@typevalue, $line); |
| 151 | } |
| 152 | } |
| 153 | close(MAINT); |
| 154 | |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 155 | my %mailmap; |
| 156 | |
| 157 | open(MAILMAP, "<${lk_path}.mailmap") || warn "$P: Can't open .mailmap\n"; |
| 158 | while (<MAILMAP>) { |
| 159 | my $line = $_; |
| 160 | |
| 161 | next if ($line =~ m/^\s*#/); |
| 162 | next if ($line =~ m/^\s*$/); |
| 163 | |
| 164 | my ($name, $address) = parse_email($line); |
| 165 | $line = format_email($name, $address); |
| 166 | |
| 167 | next if ($line =~ m/^\s*$/); |
| 168 | |
| 169 | if (exists($mailmap{$name})) { |
| 170 | my $obj = $mailmap{$name}; |
| 171 | push(@$obj, $address); |
| 172 | } else { |
| 173 | my @arr = ($address); |
| 174 | $mailmap{$name} = \@arr; |
| 175 | } |
| 176 | } |
| 177 | close(MAILMAP); |
| 178 | |
| 179 | foreach my $name (sort {$mailmap{$a} <=> $mailmap{$b}} keys %mailmap) { |
| 180 | my $obj = $mailmap{$name}; |
| 181 | foreach my $address (@$obj) { |
| 182 | } |
| 183 | } |
| 184 | |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 185 | ## use the filenames on the command line or find the filenames in the patchfiles |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 186 | |
| 187 | my @files = (); |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 188 | my @range = (); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 189 | |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 190 | foreach my $file (@ARGV) { |
Joe Perches | 870020f | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 191 | ##if $file is a directory and it lacks a trailing slash, add one |
| 192 | if ((-d $file)) { |
| 193 | $file =~ s@([^/])$@$1/@; |
| 194 | } elsif (!(-f $file)) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 195 | die "$P: file '${file}' not found\n"; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 196 | } |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 197 | if ($from_filename) { |
| 198 | push(@files, $file); |
| 199 | } else { |
| 200 | my $file_cnt = @files; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 201 | my $lastfile; |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 202 | open(PATCH, "<$file") or die "$P: Can't open ${file}\n"; |
| 203 | while (<PATCH>) { |
| 204 | if (m/^\+\+\+\s+(\S+)/) { |
| 205 | my $filename = $1; |
| 206 | $filename =~ s@^[^/]*/@@; |
| 207 | $filename =~ s@\n@@; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 208 | $lastfile = $filename; |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 209 | push(@files, $filename); |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 210 | } elsif (m/^\@\@ -(\d+),(\d+)/) { |
| 211 | if ($email_git_blame) { |
| 212 | push(@range, "$lastfile:$1:$2"); |
| 213 | } |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 214 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 215 | } |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 216 | close(PATCH); |
| 217 | if ($file_cnt == @files) { |
Joe Perches | 7f29fd27 | 2009-06-16 15:34:04 -0700 | [diff] [blame] | 218 | warn "$P: file '${file}' doesn't appear to be a patch. " |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 219 | . "Add -f to options?\n"; |
| 220 | } |
| 221 | @files = sort_and_uniq(@files); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 222 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 223 | } |
| 224 | |
| 225 | my @email_to = (); |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 226 | my @list_to = (); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 227 | my @scm = (); |
| 228 | my @web = (); |
| 229 | my @subsystem = (); |
| 230 | my @status = (); |
| 231 | |
| 232 | # Find responsible parties |
| 233 | |
| 234 | foreach my $file (@files) { |
| 235 | |
| 236 | #Do not match excluded file patterns |
| 237 | |
| 238 | my $exclude = 0; |
| 239 | foreach my $line (@typevalue) { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 240 | if ($line =~ m/^(\C):\s*(.*)/) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 241 | my $type = $1; |
| 242 | my $value = $2; |
| 243 | if ($type eq 'X') { |
| 244 | if (file_match_pattern($file, $value)) { |
| 245 | $exclude = 1; |
Joe Perches | 1d606b4 | 2009-09-21 17:04:14 -0700 | [diff] [blame] | 246 | last; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 247 | } |
| 248 | } |
| 249 | } |
| 250 | } |
| 251 | |
| 252 | if (!$exclude) { |
| 253 | my $tvi = 0; |
Joe Perches | 1d606b4 | 2009-09-21 17:04:14 -0700 | [diff] [blame] | 254 | my %hash; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 255 | foreach my $line (@typevalue) { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 256 | if ($line =~ m/^(\C):\s*(.*)/) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 257 | my $type = $1; |
| 258 | my $value = $2; |
| 259 | if ($type eq 'F') { |
| 260 | if (file_match_pattern($file, $value)) { |
Joe Perches | 3fb5565 | 2009-09-21 17:04:17 -0700 | [diff] [blame] | 261 | my $value_pd = ($value =~ tr@/@@); |
| 262 | my $file_pd = ($file =~ tr@/@@); |
| 263 | $value_pd++ if (substr($value,-1,1) ne "/"); |
| 264 | if ($pattern_depth == 0 || |
| 265 | (($file_pd - $value_pd) < $pattern_depth)) { |
| 266 | $hash{$tvi} = $value_pd; |
| 267 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 268 | } |
| 269 | } |
| 270 | } |
| 271 | $tvi++; |
| 272 | } |
Joe Perches | 1d606b4 | 2009-09-21 17:04:14 -0700 | [diff] [blame] | 273 | foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { |
| 274 | add_categories($line); |
| 275 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 276 | } |
| 277 | |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 278 | if ($email && $email_git) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 279 | recent_git_signoffs($file); |
| 280 | } |
| 281 | |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 282 | if ($email && $email_git_blame) { |
| 283 | git_assign_blame($file); |
| 284 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 285 | } |
| 286 | |
Joe Perches | f5f5078 | 2009-06-16 15:34:00 -0700 | [diff] [blame] | 287 | if ($email) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 288 | foreach my $chief (@penguin_chief) { |
| 289 | if ($chief =~ m/^(.*):(.*)/) { |
Joe Perches | f5f5078 | 2009-06-16 15:34:00 -0700 | [diff] [blame] | 290 | my $email_address; |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 291 | |
| 292 | $email_address = format_email($1, $2); |
Joe Perches | f5f5078 | 2009-06-16 15:34:00 -0700 | [diff] [blame] | 293 | if ($email_git_penguin_chiefs) { |
| 294 | push(@email_to, $email_address); |
| 295 | } else { |
| 296 | @email_to = grep(!/${email_address}/, @email_to); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 297 | } |
| 298 | } |
| 299 | } |
| 300 | } |
| 301 | |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 302 | if ($email || $email_list) { |
| 303 | my @to = (); |
| 304 | if ($email) { |
| 305 | @to = (@to, @email_to); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 306 | } |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 307 | if ($email_list) { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 308 | @to = (@to, @list_to); |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 309 | } |
| 310 | output(uniq(@to)); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 311 | } |
| 312 | |
| 313 | if ($scm) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 314 | @scm = sort_and_uniq(@scm); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 315 | output(@scm); |
| 316 | } |
| 317 | |
| 318 | if ($status) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 319 | @status = sort_and_uniq(@status); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 320 | output(@status); |
| 321 | } |
| 322 | |
| 323 | if ($subsystem) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 324 | @subsystem = sort_and_uniq(@subsystem); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 325 | output(@subsystem); |
| 326 | } |
| 327 | |
| 328 | if ($web) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 329 | @web = sort_and_uniq(@web); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 330 | output(@web); |
| 331 | } |
| 332 | |
| 333 | exit($exit); |
| 334 | |
| 335 | sub file_match_pattern { |
| 336 | my ($file, $pattern) = @_; |
| 337 | if (substr($pattern, -1) eq "/") { |
| 338 | if ($file =~ m@^$pattern@) { |
| 339 | return 1; |
| 340 | } |
| 341 | } else { |
| 342 | if ($file =~ m@^$pattern@) { |
| 343 | my $s1 = ($file =~ tr@/@@); |
| 344 | my $s2 = ($pattern =~ tr@/@@); |
| 345 | if ($s1 == $s2) { |
| 346 | return 1; |
| 347 | } |
| 348 | } |
| 349 | } |
| 350 | return 0; |
| 351 | } |
| 352 | |
| 353 | sub usage { |
| 354 | print <<EOT; |
| 355 | usage: $P [options] patchfile |
Joe Perches | 870020f | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 356 | $P [options] -f file|directory |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 357 | version: $V |
| 358 | |
| 359 | MAINTAINER field selection options: |
| 360 | --email => print email address(es) if any |
| 361 | --git => include recent git \*-by: signers |
| 362 | --git-chief-penguins => include ${penguin_chiefs} |
| 363 | --git-min-signatures => number of signatures required (default: 1) |
| 364 | --git-max-maintainers => maximum maintainers to add (default: 5) |
Joe Perches | 3d202ae | 2009-07-29 15:04:29 -0700 | [diff] [blame] | 365 | --git-min-percent => minimum percentage of commits required (default: 5) |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 366 | --git-since => git history to use (default: 1-year-ago) |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 367 | --git-blame => use git blame to find modified commits for patch or file |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 368 | --m => include maintainer(s) if any |
| 369 | --n => include name 'Full Name <addr\@domain.tld>' |
| 370 | --l => include list(s) if any |
| 371 | --s => include subscriber only list(s) if any |
| 372 | --scm => print SCM tree(s) if any |
| 373 | --status => print status if any |
| 374 | --subsystem => print subsystem name if any |
| 375 | --web => print website(s) if any |
| 376 | |
| 377 | Output type options: |
| 378 | --separator [, ] => separator for multiple entries on 1 line |
| 379 | --multiline => print 1 entry per line |
| 380 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 381 | Other options: |
Joe Perches | 3fb5565 | 2009-09-21 17:04:17 -0700 | [diff] [blame] | 382 | --pattern-depth => Number of pattern directory traversals (default: 0 (all)) |
Joe Perches | f5f5078 | 2009-06-16 15:34:00 -0700 | [diff] [blame] | 383 | --version => show version |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 384 | --help => show this help information |
| 385 | |
Joe Perches | 3fb5565 | 2009-09-21 17:04:17 -0700 | [diff] [blame] | 386 | Default options: |
| 387 | [--email --git --m --n --l --multiline --pattern-depth=0] |
| 388 | |
Joe Perches | 870020f | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 389 | Notes: |
| 390 | Using "-f directory" may give unexpected results: |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 391 | Used with "--git", git signators for _all_ files in and below |
| 392 | directory are examined as git recurses directories. |
| 393 | Any specified X: (exclude) pattern matches are _not_ ignored. |
| 394 | Used with "--nogit", directory is used as a pattern match, |
| 395 | no individual file within the directory or subdirectory |
| 396 | is matched. |
| 397 | Used with "--git-blame", does not iterate all files in directory |
| 398 | Using "--git-blame" is slow and may add old committers and authors |
| 399 | that are no longer active maintainers to the output. |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 400 | EOT |
| 401 | } |
| 402 | |
| 403 | sub top_of_kernel_tree { |
| 404 | my ($lk_path) = @_; |
| 405 | |
| 406 | if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { |
| 407 | $lk_path .= "/"; |
| 408 | } |
| 409 | if ( (-f "${lk_path}COPYING") |
| 410 | && (-f "${lk_path}CREDITS") |
| 411 | && (-f "${lk_path}Kbuild") |
| 412 | && (-f "${lk_path}MAINTAINERS") |
| 413 | && (-f "${lk_path}Makefile") |
| 414 | && (-f "${lk_path}README") |
| 415 | && (-d "${lk_path}Documentation") |
| 416 | && (-d "${lk_path}arch") |
| 417 | && (-d "${lk_path}include") |
| 418 | && (-d "${lk_path}drivers") |
| 419 | && (-d "${lk_path}fs") |
| 420 | && (-d "${lk_path}init") |
| 421 | && (-d "${lk_path}ipc") |
| 422 | && (-d "${lk_path}kernel") |
| 423 | && (-d "${lk_path}lib") |
| 424 | && (-d "${lk_path}scripts")) { |
| 425 | return 1; |
| 426 | } |
| 427 | return 0; |
| 428 | } |
| 429 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 430 | sub parse_email { |
| 431 | my ($formatted_email) = @_; |
| 432 | |
| 433 | my $name = ""; |
| 434 | my $address = ""; |
| 435 | |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 436 | if ($formatted_email =~ /^([^<]+)<(.*\@.*)>.*$/) { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 437 | $name = $1; |
| 438 | $address = $2; |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 439 | } elsif ($formatted_email =~ /^\s*<(.*\@.*)>.*$/) { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 440 | $address = $1; |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 441 | } elsif ($formatted_email =~ /^\s*(.*\@.*)$/) { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 442 | $address = $1; |
| 443 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 444 | |
| 445 | $name =~ s/^\s+|\s+$//g; |
Joe Perches | d789504 | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 446 | $name =~ s/^\"|\"$//g; |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 447 | $address =~ s/^\s+|\s+$//g; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 448 | |
| 449 | if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars |
| 450 | $name =~ s/(?<!\\)"/\\"/g; ##escape quotes |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 451 | $name = "\"$name\""; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 452 | } |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 453 | |
| 454 | return ($name, $address); |
| 455 | } |
| 456 | |
| 457 | sub format_email { |
| 458 | my ($name, $address) = @_; |
| 459 | |
| 460 | my $formatted_email; |
| 461 | |
| 462 | $name =~ s/^\s+|\s+$//g; |
| 463 | $name =~ s/^\"|\"$//g; |
| 464 | $address =~ s/^\s+|\s+$//g; |
| 465 | |
| 466 | if ($name =~ /[^a-z0-9 \.\-]/i) { ##has "must quote" chars |
| 467 | $name =~ s/(?<!\\)"/\\"/g; ##escape quotes |
| 468 | $name = "\"$name\""; |
| 469 | } |
| 470 | |
| 471 | if ($email_usename) { |
| 472 | if ("$name" eq "") { |
| 473 | $formatted_email = "$address"; |
| 474 | } else { |
| 475 | $formatted_email = "$name <${address}>"; |
| 476 | } |
| 477 | } else { |
| 478 | $formatted_email = $address; |
| 479 | } |
| 480 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 481 | return $formatted_email; |
| 482 | } |
| 483 | |
| 484 | sub add_categories { |
| 485 | my ($index) = @_; |
| 486 | |
| 487 | $index = $index - 1; |
| 488 | while ($index >= 0) { |
| 489 | my $tv = $typevalue[$index]; |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 490 | if ($tv =~ m/^(\C):\s*(.*)/) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 491 | my $ptype = $1; |
| 492 | my $pvalue = $2; |
| 493 | if ($ptype eq "L") { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 494 | my $list_address = $pvalue; |
| 495 | my $list_additional = ""; |
| 496 | if ($list_address =~ m/([^\s]+)\s+(.*)$/) { |
| 497 | $list_address = $1; |
| 498 | $list_additional = $2; |
| 499 | } |
Joe Perches | bdf7c68 | 2009-06-16 15:33:59 -0700 | [diff] [blame] | 500 | if ($list_additional =~ m/subscribers-only/) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 501 | if ($email_subscriber_list) { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 502 | push(@list_to, $list_address); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 503 | } |
| 504 | } else { |
| 505 | if ($email_list) { |
Joe Perches | 290603c | 2009-06-16 15:33:58 -0700 | [diff] [blame] | 506 | push(@list_to, $list_address); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 507 | } |
| 508 | } |
| 509 | } elsif ($ptype eq "M") { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 510 | my ($name, $address) = parse_email($pvalue); |
| 511 | if ($name eq "") { |
| 512 | if ($index >= 0) { |
| 513 | my $tv = $typevalue[$index - 1]; |
| 514 | if ($tv =~ m/^(\C):\s*(.*)/) { |
| 515 | if ($1 eq "P") { |
| 516 | $name = $2; |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 517 | } |
| 518 | } |
| 519 | } |
| 520 | } |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 521 | if ($email_maintainer) { |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 522 | push_email_addresses($pvalue); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 523 | } |
| 524 | } elsif ($ptype eq "T") { |
| 525 | push(@scm, $pvalue); |
| 526 | } elsif ($ptype eq "W") { |
| 527 | push(@web, $pvalue); |
| 528 | } elsif ($ptype eq "S") { |
| 529 | push(@status, $pvalue); |
| 530 | } |
| 531 | |
| 532 | $index--; |
| 533 | } else { |
| 534 | push(@subsystem,$tv); |
| 535 | $index = -1; |
| 536 | } |
| 537 | } |
| 538 | } |
| 539 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 540 | sub email_address_inuse { |
| 541 | my ($test_address) = @_; |
| 542 | |
| 543 | foreach my $line (@email_to) { |
| 544 | my ($name, $address) = parse_email($line); |
| 545 | |
| 546 | return 1 if ($address eq $test_address); |
| 547 | } |
| 548 | return 0; |
| 549 | } |
| 550 | |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 551 | sub push_email_address { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 552 | my ($line) = @_; |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 553 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 554 | my ($name, $address) = parse_email($line); |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 555 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 556 | if (!email_address_inuse($address)) { |
| 557 | push(@email_to, format_email($name, $address)); |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 558 | } |
| 559 | } |
| 560 | |
| 561 | sub push_email_addresses { |
| 562 | my ($address) = @_; |
| 563 | |
| 564 | my @address_list = (); |
| 565 | |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 566 | if (rfc822_valid($address)) { |
| 567 | push_email_address($address); |
| 568 | } elsif (@address_list = rfc822_validlist($address)) { |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 569 | my $array_count = shift(@address_list); |
| 570 | while (my $entry = shift(@address_list)) { |
| 571 | push_email_address($entry); |
| 572 | } |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 573 | } else { |
| 574 | warn("Invalid MAINTAINERS address: '" . $address . "'\n"); |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 575 | } |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 576 | } |
| 577 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 578 | sub which { |
| 579 | my ($bin) = @_; |
| 580 | |
Joe Perches | f5f5078 | 2009-06-16 15:34:00 -0700 | [diff] [blame] | 581 | foreach my $path (split(/:/, $ENV{PATH})) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 582 | if (-e "$path/$bin") { |
| 583 | return "$path/$bin"; |
| 584 | } |
| 585 | } |
| 586 | |
| 587 | return ""; |
| 588 | } |
| 589 | |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 590 | sub mailmap { |
| 591 | my @lines = @_; |
| 592 | my %hash; |
| 593 | |
| 594 | foreach my $line (@lines) { |
| 595 | my ($name, $address) = parse_email($line); |
| 596 | if (!exists($hash{$name})) { |
| 597 | $hash{$name} = $address; |
| 598 | } |
| 599 | if (exists($mailmap{$name})) { |
| 600 | my $obj = $mailmap{$name}; |
| 601 | foreach my $map_address (@$obj) { |
| 602 | if (($map_address eq $address) && |
| 603 | ($map_address ne $hash{$name})) { |
| 604 | $line = format_email($name, $hash{$name}); |
| 605 | } |
| 606 | } |
| 607 | } |
| 608 | } |
| 609 | |
| 610 | return @lines; |
| 611 | } |
| 612 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 613 | sub recent_git_signoffs { |
| 614 | my ($file) = @_; |
| 615 | |
| 616 | my $sign_offs = ""; |
| 617 | my $cmd = ""; |
| 618 | my $output = ""; |
| 619 | my $count = 0; |
| 620 | my @lines = (); |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 621 | my %hash; |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 622 | my $total_sign_offs; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 623 | |
| 624 | if (which("git") eq "") { |
Joe Perches | de2fc49 | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 625 | warn("$P: git not found. Add --nogit to options?\n"); |
| 626 | return; |
| 627 | } |
| 628 | if (!(-d ".git")) { |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 629 | warn("$P: .git directory not found. Use a git repository for better results.\n"); |
| 630 | warn("$P: perhaps 'git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git'\n"); |
Joe Perches | de2fc49 | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 631 | return; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 632 | } |
| 633 | |
| 634 | $cmd = "git log --since=${email_git_since} -- ${file}"; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 635 | |
| 636 | $output = `${cmd}`; |
| 637 | $output =~ s/^\s*//gm; |
| 638 | |
| 639 | @lines = split("\n", $output); |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 640 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 641 | @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines); |
| 642 | if (!$email_git_penguin_chiefs) { |
| 643 | @lines = grep(!/${penguin_chiefs}/i, @lines); |
| 644 | } |
| 645 | # cut -f2- -d":" |
| 646 | s/.*:\s*(.+)\s*/$1/ for (@lines); |
| 647 | |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 648 | $total_sign_offs = @lines; |
| 649 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 650 | @lines = mailmap(@lines); |
| 651 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 652 | @lines = sort(@lines); |
| 653 | # uniq -c |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 654 | foreach my $line (@lines) { |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 655 | $hash{$line}++; |
| 656 | } |
| 657 | # sort -rn |
| 658 | @lines = (); |
| 659 | foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { |
| 660 | push(@lines,"$hash{$line} $line"); |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 661 | } |
| 662 | |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 663 | foreach my $line (@lines) { |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 664 | if ($line =~ m/([0-9]+)\s+(.*)/) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 665 | my $sign_offs = $1; |
Joe Perches | 4a7fdb5 | 2009-04-10 12:28:57 -0700 | [diff] [blame] | 666 | $line = $2; |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 667 | $count++; |
| 668 | if ($sign_offs < $email_git_min_signatures || |
Joe Perches | afa81ee | 2009-07-29 15:04:28 -0700 | [diff] [blame] | 669 | $count > $email_git_max_maintainers || |
| 670 | $sign_offs * 100 / $total_sign_offs < $email_git_min_percent) { |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 671 | last; |
| 672 | } |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 673 | push_email_address($line); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 674 | } |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 675 | } |
| 676 | } |
| 677 | |
| 678 | sub save_commits { |
| 679 | my ($cmd, @commits) = @_; |
| 680 | my $output; |
| 681 | my @lines = (); |
| 682 | |
| 683 | $output = `${cmd}`; |
| 684 | |
| 685 | @lines = split("\n", $output); |
| 686 | foreach my $line (@lines) { |
| 687 | if ($line =~ m/^(\w+) /) { |
| 688 | push (@commits, $1); |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 689 | } |
| 690 | } |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 691 | return @commits; |
| 692 | } |
| 693 | |
| 694 | sub git_assign_blame { |
| 695 | my ($file) = @_; |
| 696 | |
| 697 | my @lines = (); |
| 698 | my @commits = (); |
| 699 | my $cmd; |
| 700 | my $output; |
| 701 | my %hash; |
| 702 | my $total_sign_offs; |
| 703 | my $count; |
| 704 | |
| 705 | if (@range) { |
| 706 | foreach my $file_range_diff (@range) { |
| 707 | next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); |
| 708 | my $diff_file = $1; |
| 709 | my $diff_start = $2; |
| 710 | my $diff_length = $3; |
| 711 | next if (!("$file" eq "$diff_file")); |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 712 | $cmd = "git blame -l -L $diff_start,+$diff_length $file"; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 713 | @commits = save_commits($cmd, @commits); |
| 714 | } |
| 715 | } else { |
| 716 | if (-f $file) { |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 717 | $cmd = "git blame -l $file"; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 718 | @commits = save_commits($cmd, @commits); |
| 719 | } |
| 720 | } |
| 721 | |
| 722 | $total_sign_offs = 0; |
| 723 | @commits = uniq(@commits); |
| 724 | foreach my $commit (@commits) { |
| 725 | $cmd = "git log -1 ${commit}"; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 726 | |
| 727 | $output = `${cmd}`; |
| 728 | $output =~ s/^\s*//gm; |
| 729 | @lines = split("\n", $output); |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 730 | |
| 731 | @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines); |
| 732 | if (!$email_git_penguin_chiefs) { |
| 733 | @lines = grep(!/${penguin_chiefs}/i, @lines); |
| 734 | } |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 735 | |
Joe Perches | 0e70e83 | 2009-09-21 17:04:20 -0700 | [diff] [blame] | 736 | # cut -f2- -d":" |
| 737 | s/.*:\s*(.+)\s*/$1/ for (@lines); |
| 738 | |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 739 | $total_sign_offs += @lines; |
Joe Perches | 8cbb3a7 | 2009-09-21 17:04:21 -0700 | [diff] [blame^] | 740 | |
| 741 | @lines = mailmap(@lines); |
| 742 | |
| 743 | $hash{$_}++ for @lines; |
Joe Perches | f549266 | 2009-09-21 17:04:13 -0700 | [diff] [blame] | 744 | } |
| 745 | |
| 746 | $count = 0; |
| 747 | foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { |
| 748 | my $sign_offs = $hash{$line}; |
| 749 | $count++; |
| 750 | last if ($sign_offs < $email_git_min_signatures || |
| 751 | $count > $email_git_max_maintainers || |
| 752 | $sign_offs * 100 / $total_sign_offs < $email_git_min_percent); |
| 753 | push_email_address($line); |
| 754 | } |
Joe Perches | cb7301c | 2009-04-07 20:40:12 -0700 | [diff] [blame] | 755 | } |
| 756 | |
| 757 | sub uniq { |
| 758 | my @parms = @_; |
| 759 | |
| 760 | my %saw; |
| 761 | @parms = grep(!$saw{$_}++, @parms); |
| 762 | return @parms; |
| 763 | } |
| 764 | |
| 765 | sub sort_and_uniq { |
| 766 | my @parms = @_; |
| 767 | |
| 768 | my %saw; |
| 769 | @parms = sort @parms; |
| 770 | @parms = grep(!$saw{$_}++, @parms); |
| 771 | return @parms; |
| 772 | } |
| 773 | |
| 774 | sub output { |
| 775 | my @parms = @_; |
| 776 | |
| 777 | if ($output_multiline) { |
| 778 | foreach my $line (@parms) { |
| 779 | print("${line}\n"); |
| 780 | } |
| 781 | } else { |
| 782 | print(join($output_separator, @parms)); |
| 783 | print("\n"); |
| 784 | } |
| 785 | } |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 786 | |
| 787 | my $rfc822re; |
| 788 | |
| 789 | sub make_rfc822re { |
| 790 | # Basic lexical tokens are specials, domain_literal, quoted_string, atom, and |
| 791 | # comment. We must allow for rfc822_lwsp (or comments) after each of these. |
| 792 | # This regexp will only work on addresses which have had comments stripped |
| 793 | # and replaced with rfc822_lwsp. |
| 794 | |
| 795 | my $specials = '()<>@,;:\\\\".\\[\\]'; |
| 796 | my $controls = '\\000-\\037\\177'; |
| 797 | |
| 798 | my $dtext = "[^\\[\\]\\r\\\\]"; |
| 799 | my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; |
| 800 | |
| 801 | my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; |
| 802 | |
| 803 | # Use zero-width assertion to spot the limit of an atom. A simple |
| 804 | # $rfc822_lwsp* causes the regexp engine to hang occasionally. |
| 805 | my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; |
| 806 | my $word = "(?:$atom|$quoted_string)"; |
| 807 | my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; |
| 808 | |
| 809 | my $sub_domain = "(?:$atom|$domain_literal)"; |
| 810 | my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; |
| 811 | |
| 812 | my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; |
| 813 | |
| 814 | my $phrase = "$word*"; |
| 815 | my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; |
| 816 | my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; |
| 817 | my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; |
| 818 | |
| 819 | my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; |
| 820 | my $address = "(?:$mailbox|$group)"; |
| 821 | |
| 822 | return "$rfc822_lwsp*$address"; |
| 823 | } |
| 824 | |
| 825 | sub rfc822_strip_comments { |
| 826 | my $s = shift; |
| 827 | # Recursively remove comments, and replace with a single space. The simpler |
| 828 | # regexps in the Email Addressing FAQ are imperfect - they will miss escaped |
| 829 | # chars in atoms, for example. |
| 830 | |
| 831 | while ($s =~ s/^((?:[^"\\]|\\.)* |
| 832 | (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) |
| 833 | \((?:[^()\\]|\\.)*\)/$1 /osx) {} |
| 834 | return $s; |
| 835 | } |
| 836 | |
| 837 | # valid: returns true if the parameter is an RFC822 valid address |
| 838 | # |
| 839 | sub rfc822_valid ($) { |
| 840 | my $s = rfc822_strip_comments(shift); |
| 841 | |
| 842 | if (!$rfc822re) { |
| 843 | $rfc822re = make_rfc822re(); |
| 844 | } |
| 845 | |
| 846 | return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; |
| 847 | } |
| 848 | |
| 849 | # validlist: In scalar context, returns true if the parameter is an RFC822 |
| 850 | # valid list of addresses. |
| 851 | # |
| 852 | # In list context, returns an empty list on failure (an invalid |
| 853 | # address was found); otherwise a list whose first element is the |
| 854 | # number of addresses found and whose remaining elements are the |
| 855 | # addresses. This is needed to disambiguate failure (invalid) |
| 856 | # from success with no addresses found, because an empty string is |
| 857 | # a valid list. |
| 858 | |
| 859 | sub rfc822_validlist ($) { |
| 860 | my $s = rfc822_strip_comments(shift); |
| 861 | |
| 862 | if (!$rfc822re) { |
| 863 | $rfc822re = make_rfc822re(); |
| 864 | } |
| 865 | # * null list items are valid according to the RFC |
| 866 | # * the '1' business is to aid in distinguishing failure from no results |
| 867 | |
| 868 | my @r; |
| 869 | if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && |
| 870 | $s =~ m/^$rfc822_char*$/) { |
Joe Perches | 5f2441e | 2009-06-16 15:34:02 -0700 | [diff] [blame] | 871 | while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { |
Joe Perches | 1b5e1cf | 2009-06-16 15:34:01 -0700 | [diff] [blame] | 872 | push @r, $1; |
| 873 | } |
| 874 | return wantarray ? (scalar(@r), @r) : 1; |
| 875 | } |
| 876 | else { |
| 877 | return wantarray ? () : 0; |
| 878 | } |
| 879 | } |