2 # Maintainers.pm - show information about maintainers
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.
15 require "Maintainers.pl";
16 use vars qw(%Modules %Maintainers);
18 use vars qw(@ISA @EXPORT_OK $VERSION);
20 @EXPORT_OK = qw(%Modules %Maintainers
21 get_module_files get_module_pat
22 show_results process_options files_to_modules
34 # (re)read the MANIFEST file, blowing away any previous effort
39 my $manifest_path = 'MANIFEST';
40 if (! -e $manifest_path) {
41 $manifest_path = "../MANIFEST";
44 if (open(my $manfh, $manifest_path )) {
50 warn "MANIFEST:$.: malformed line: $_\n";
55 die "$0: Failed to open MANIFEST for reading: $!\n";
64 split ' ', $Modules{$m}{FILES};
67 # exand dir/ or foo* into a full list of files
70 sort { lc $a cmp lc $b }
72 -f $_ && $_ !~ /[*?]/ ? # File as-is.
74 -d _ && $_ !~ /[*?]/ ? # Recurse into directories.
79 push @files, $File::Find::name
80 if -f $_ && exists $MANIFEST{$File::Find::name};
84 # Not a glob, but doesn't exist
86 # The rest are globbable patterns; expand the glob, then
87 # recursively perform directory expansion on any results
88 : expand_glob(glob($_))
95 my $excluded = $Modules{$m}{EXCLUDED};
97 unless $excluded and @$excluded;
99 my ($pat) = map { qr/$_/ } join '|' => map {
100 ref $_ ? $_ : qr/\b\Q$_\E$/
103 return grep { $_ !~ $pat } @files;
106 sub get_module_files {
108 return filter_excluded $m => map { expand_glob($_) } get_module_pat($m);
112 sub get_maintainer_modules {
114 sort { lc $a cmp lc $b }
115 grep { $Modules{$_}{MAINTAINER} eq $m }
122 --maintainer M | --module M [--files]
123 List modules or maintainers matching the pattern M.
124 With --files, list all the files associated with them
126 --check | --checkmani [commit | file ... | dir ... ]
127 Check consistency of Maintainers.pl
128 with a file checks if it has a maintainer
129 with a dir checks all files have a maintainer
130 with a commit checks files modified by that commit
131 no arg checks for multiple maintainers
132 --checkmani is like --check, but only reports on unclaimed
133 files if they are in MANIFEST
136 List the module ownership of modified or the listed files
138 Matching is case-ignoring regexp, author matching is both by
139 the short id and by the full name and email. A "module" may
140 not be just a module, it may be a file or files or a subdirectory.
141 The options may be abbreviated to their unique prefixes
154 sub process_options {
158 'maintainer=s' => \$Maintainer,
159 'module=s' => \$Module,
162 'checkmani' => \$Checkmani,
163 'opened' => \$Opened,
170 chomp (@Files = `git ls-files -m --full-name`);
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 $?;
181 usage() if @Files && ($Maintainer || $Module || $Files);
183 for my $mean ($Maintainer, $Module) {
184 warn "$0: Did you mean '$0 $mean'?\n"
185 if $mean && -e $mean && $mean ne '.' && !$Files;
188 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
189 if defined $Maintainer && exists $Modules{$Maintainer};
191 warn "$0: Did you mean '$0 -ma $Module'?\n"
192 if defined $Module && exists $Maintainers{$Module};
194 return ($Maintainer, $Module, $Files, @Files);
197 sub files_to_modules {
201 for (@Files) { s:^\./:: }
203 @ModuleByFile{@Files} = ();
205 # First try fast match.
208 for my $module (keys %Modules) {
209 for my $pat (get_module_pat($module)) {
210 $ModuleByPat{$pat} = $module;
215 for my $pat (keys %ModuleByPat) {
217 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
219 for my $exp (glob($pat)) {
220 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
224 %ModuleByPat = %ExpModuleByPat;
225 for my $file (@Files) {
226 $ModuleByFile{$file} = $ModuleByPat{$file}
227 if exists $ModuleByPat{$file};
230 # If still unresolved files...
231 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
233 # Cannot match what isn't there.
234 @ToDo = grep { -e $_ } @ToDo;
237 # Try prefix matching.
239 # Need to try longst prefixes first, else lib/CPAN may match
240 # lib/CPANPLUS/... and similar
242 my @OrderedModuleByPat
243 = sort {length $b <=> length $a} keys %ModuleByPat;
245 # Remove trailing slashes.
246 for (@ToDo) { s|/$|| }
251 for my $pat (@OrderedModuleByPat) {
252 last unless keys %ToDo;
255 for my $file (keys %ToDo) {
256 if ($file =~ m|^$pat|i) {
257 $ModuleByFile{$file} = $ModuleByPat{$pat};
269 my ($Maintainer, $Module, $Files, @Files) = @_;
272 for my $m (sort keys %Maintainers) {
273 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
274 my @modules = get_maintainer_modules($m);
276 @modules = grep { /$Module/io } @modules;
280 for my $module (@modules) {
281 push @files, get_module_files($module);
283 printf "%-15s @files\n", $m;
286 printf "%-15s @modules\n", $m;
288 printf "%-15s $Maintainers{$m}\n", $m;
294 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
295 if ($m =~ /$Module/io) {
297 my @files = get_module_files($m);
298 printf "%-15s @files\n", $m;
300 printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
304 } elsif ($Check or $Checkmani) {
308 ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
309 : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
313 duplicated_maintainers();
314 superfluous_maintainers();
317 my $ModuleByFile = files_to_modules(@Files);
318 for my $file (@Files) {
319 if (defined $ModuleByFile->{$file}) {
320 my $module = $ModuleByFile->{$file};
321 my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER};
322 my $upstream = $Modules{$module}{UPSTREAM}||'unknown';
323 printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
325 printf "%-15s ?\n", $file;
330 print STDERR "(No files are modified)\n";
339 sub maintainers_files {
341 for my $k (keys %Modules) {
342 for my $f (get_module_files($k)) {
348 sub duplicated_maintainers {
350 for my $f (keys %files) {
351 if ($files{$f} > 1) {
352 print "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n";
354 print "ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n";
359 sub warn_maintainer {
362 print "ok ".++$TestCounter." - $name has a maintainer\n";
364 print "not ok ".++$TestCounter." - $name has NO maintainer\n";
368 sub missing_maintainers {
369 my($check, @path) = @_;
373 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
375 find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
378 sub superfluous_maintainers {
380 for my $f (keys %files) {
382 print "ok ".++$TestCounter." - Maintained file $f appears in MANIFEST\n";
384 print "not ok ".++$TestCounter." - File $f has has a maintainer but is not in MANIFEST\n";
389 sub finish_tap_output {
390 print "1..".$TestCounter."\n";