Maintainers.pm revision 1.1.1.5
1# 2# Maintainers.pm - show information about maintainers 3# 4 5package Maintainers; 6 7use strict; 8use warnings; 9 10use lib "Porting"; 11# Please don't use post 5.008 features as this module is used by 12# Porting/makemeta, and that in turn has to be run by the perl just built. 13use 5.008; 14 15require "Maintainers.pl"; 16use vars qw(%Modules %Maintainers); 17 18use vars qw(@ISA @EXPORT_OK $VERSION); 19@ISA = qw(Exporter); 20@EXPORT_OK = qw(%Modules %Maintainers 21 get_module_files get_module_pat 22 show_results process_options files_to_modules 23 finish_tap_output 24 reload_manifest); 25$VERSION = 0.04; 26 27require Exporter; 28 29use File::Find; 30use Getopt::Long; 31 32my %MANIFEST; 33 34# (re)read the MANIFEST file, blowing away any previous effort 35 36sub reload_manifest { 37 %MANIFEST = (); 38 39 my $manifest_path = 'MANIFEST'; 40 if (! -e $manifest_path) { 41 $manifest_path = "../MANIFEST"; 42 } 43 44 if (open(my $manfh, $manifest_path )) { 45 while (<$manfh>) { 46 if (/^(\S+)/) { 47 $MANIFEST{$1}++; 48 } 49 else { 50 warn "MANIFEST:$.: malformed line: $_\n"; 51 } 52 } 53 close $manfh; 54 } else { 55 die "$0: Failed to open MANIFEST for reading: $!\n"; 56 } 57} 58 59reload_manifest; 60 61 62sub get_module_pat { 63 my $m = shift; 64 split ' ', $Modules{$m}{FILES}; 65} 66 67# exand dir/ or foo* into a full list of files 68# 69sub expand_glob { 70 sort { lc $a cmp lc $b } 71 map { 72 -f $_ && $_ !~ /[*?]/ ? # File as-is. 73 $_ : 74 -d _ && $_ !~ /[*?]/ ? # Recurse into directories. 75 do { 76 my @files; 77 find( 78 sub { 79 push @files, $File::Find::name 80 if -f $_ && exists $MANIFEST{$File::Find::name}; 81 }, $_); 82 @files; 83 } 84 # The rest are globbable patterns; expand the glob, then 85 # recurively perform directory expansion on any results 86 : expand_glob(grep -e $_,glob($_)) 87 } @_; 88} 89 90sub get_module_files { 91 my $m = shift; 92 my %exclude; 93 my @files; 94 for (get_module_pat($m)) { 95 if (s/^!//) { 96 $exclude{$_}=1 for expand_glob($_); 97 } 98 else { 99 push @files, expand_glob($_); 100 } 101 } 102 return grep !$exclude{$_}, @files; 103} 104 105 106sub get_maintainer_modules { 107 my $m = shift; 108 sort { lc $a cmp lc $b } 109 grep { $Modules{$_}{MAINTAINER} eq $m } 110 keys %Modules; 111} 112 113sub usage { 114 warn <<__EOF__; 115$0: Usage: 116 --maintainer M | --module M [--files] 117 List modules or maintainers matching the pattern M. 118 With --files, list all the files associated with them 119or 120 --check | --checkmani [commit | file ... | dir ... ] 121 Check consistency of Maintainers.pl 122 with a file checks if it has a maintainer 123 with a dir checks all files have a maintainer 124 with a commit checks files modified by that commit 125 no arg checks for multiple maintainers 126 --checkmani is like --check, but only reports on unclaimed 127 files if they are in MANIFEST 128or 129 --opened | file .... 130 List the module ownership of modified or the listed files 131 132 --tap-output 133 Show results as valid TAP output. Currently only compatible 134 with --check, --checkmani 135 136Matching is case-ignoring regexp, author matching is both by 137the short id and by the full name and email. A "module" may 138not be just a module, it may be a file or files or a subdirectory. 139The options may be abbreviated to their unique prefixes 140__EOF__ 141 exit(0); 142} 143 144my $Maintainer; 145my $Module; 146my $Files; 147my $Check; 148my $Checkmani; 149my $Opened; 150my $TestCounter = 0; 151my $TapOutput; 152 153sub process_options { 154 usage() 155 unless 156 GetOptions( 157 'maintainer=s' => \$Maintainer, 158 'module=s' => \$Module, 159 'files' => \$Files, 160 'check' => \$Check, 161 'checkmani' => \$Checkmani, 162 'opened' => \$Opened, 163 'tap-output' => \$TapOutput, 164 ); 165 166 my @Files; 167 168 if ($Opened) { 169 usage if @ARGV; 170 chomp (@Files = `git ls-files -m --full-name`); 171 die if $?; 172 } elsif (@ARGV == 1 && 173 $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) { 174 my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]"; 175 chomp (@Files = `$command`); 176 die "'$command' failed: $?" if $?; 177 } else { 178 @Files = @ARGV; 179 } 180 181 usage() if @Files && ($Maintainer || $Module || $Files); 182 183 for my $mean ($Maintainer, $Module) { 184 warn "$0: Did you mean '$0 $mean'?\n" 185 if $mean && -e $mean && $mean ne '.' && !$Files; 186 } 187 188 warn "$0: Did you mean '$0 -mo $Maintainer'?\n" 189 if defined $Maintainer && exists $Modules{$Maintainer}; 190 191 warn "$0: Did you mean '$0 -ma $Module'?\n" 192 if defined $Module && exists $Maintainers{$Module}; 193 194 return ($Maintainer, $Module, $Files, @Files); 195} 196 197sub files_to_modules { 198 my @Files = @_; 199 my %ModuleByFile; 200 201 for (@Files) { s:^\./:: } 202 203 @ModuleByFile{@Files} = (); 204 205 # First try fast match. 206 207 my %ModuleByPat; 208 for my $module (keys %Modules) { 209 for my $pat (get_module_pat($module)) { 210 $ModuleByPat{$pat} = $module; 211 } 212 } 213 # Expand any globs. 214 my %ExpModuleByPat; 215 for my $pat (keys %ModuleByPat) { 216 if (-e $pat) { 217 $ExpModuleByPat{$pat} = $ModuleByPat{$pat}; 218 } else { 219 for my $exp (glob($pat)) { 220 $ExpModuleByPat{$exp} = $ModuleByPat{$pat}; 221 } 222 } 223 } 224 %ModuleByPat = %ExpModuleByPat; 225 for my $file (@Files) { 226 $ModuleByFile{$file} = $ModuleByPat{$file} 227 if exists $ModuleByPat{$file}; 228 } 229 230 # If still unresolved files... 231 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) { 232 233 # Cannot match what isn't there. 234 @ToDo = grep { -e $_ } @ToDo; 235 236 if (@ToDo) { 237 # Try prefix matching. 238 239 # Need to try longst prefixes first, else lib/CPAN may match 240 # lib/CPANPLUS/... and similar 241 242 my @OrderedModuleByPat 243 = sort {length $b <=> length $a} keys %ModuleByPat; 244 245 # Remove trailing slashes. 246 for (@ToDo) { s|/$|| } 247 248 my %ToDo; 249 @ToDo{@ToDo} = (); 250 251 for my $pat (@OrderedModuleByPat) { 252 last unless keys %ToDo; 253 if (-d $pat) { 254 my @Done; 255 for my $file (keys %ToDo) { 256 if ($file =~ m|^$pat|i) { 257 $ModuleByFile{$file} = $ModuleByPat{$pat}; 258 push @Done, $file; 259 } 260 } 261 delete @ToDo{@Done}; 262 } 263 } 264 } 265 } 266 \%ModuleByFile; 267} 268sub show_results { 269 my ($Maintainer, $Module, $Files, @Files) = @_; 270 271 if ($Maintainer) { 272 for my $m (sort keys %Maintainers) { 273 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) { 274 my @modules = get_maintainer_modules($m); 275 if ($Module) { 276 @modules = grep { /$Module/io } @modules; 277 } 278 if ($Files) { 279 my @files; 280 for my $module (@modules) { 281 push @files, get_module_files($module); 282 } 283 printf "%-15s @files\n", $m; 284 } else { 285 if ($Module) { 286 printf "%-15s @modules\n", $m; 287 } else { 288 printf "%-15s $Maintainers{$m}\n", $m; 289 } 290 } 291 } 292 } 293 } elsif ($Module) { 294 for my $m (sort { lc $a cmp lc $b } keys %Modules) { 295 if ($m =~ /$Module/io) { 296 if ($Files) { 297 my @files = get_module_files($m); 298 printf "%-15s @files\n", $m; 299 } else { 300 printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown'; 301 } 302 } 303 } 304 } elsif ($Check or $Checkmani) { 305 if( @Files ) { 306 missing_maintainers( 307 $Checkmani 308 ? sub { -f $_ and exists $MANIFEST{$File::Find::name} } 309 : sub { /\.(?:[chty]|p[lm]|xs)\z/msx }, 310 @Files 311 ); 312 } else { 313 duplicated_maintainers(); 314 } 315 } elsif (@Files) { 316 my $ModuleByFile = files_to_modules(@Files); 317 for my $file (@Files) { 318 if (defined $ModuleByFile->{$file}) { 319 my $module = $ModuleByFile->{$file}; 320 my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER}; 321 my $upstream = $Modules{$module}{UPSTREAM}||'unknown'; 322 printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream; 323 } else { 324 printf "%-15s ?\n", $file; 325 } 326 } 327 } 328 elsif ($Opened) { 329 print STDERR "(No files are modified)\n"; 330 } 331 else { 332 usage(); 333 } 334} 335 336my %files; 337 338sub maintainers_files { 339 %files = (); 340 for my $k (keys %Modules) { 341 for my $f (get_module_files($k)) { 342 ++$files{$f}; 343 } 344 } 345} 346 347sub duplicated_maintainers { 348 maintainers_files(); 349 for my $f (keys %files) { 350 if ($TapOutput) { 351 if ($files{$f} > 1) { 352 print "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; 353 } else { 354 print "ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; 355 } 356 } else { 357 if ($files{$f} > 1) { 358 warn "File $f appears $files{$f} times in Maintainers.pl\n"; 359 } 360 } 361 } 362} 363 364sub warn_maintainer { 365 my $name = shift; 366 if ($TapOutput) { 367 if ($files{$name}) { 368 print "ok ".++$TestCounter." - $name has a maintainer\n"; 369 } else { 370 print "not ok ".++$TestCounter." - $name has NO maintainer\n"; 371 372 } 373 374 } else { 375 warn "File $name has no maintainer\n" if not $files{$name}; 376 } 377} 378 379sub missing_maintainers { 380 my($check, @path) = @_; 381 maintainers_files(); 382 my @dir; 383 for my $d (@path) { 384 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) } 385 } 386 find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir; 387} 388 389sub finish_tap_output { 390 print "1..".$TestCounter."\n"; 391} 392 3931; 394 395