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