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 }
74 -d _ ? # Recurse into directories.
79 push @files, $File::Find::name
80 if -f $_ && exists $MANIFEST{$File::Find::name};
84 # The rest are globbable patterns; expand the glob, then
85 # recurively perform directory expansion on any results
86 : expand_glob(grep -e $_,glob($_))
90 sub get_module_files {
94 for (get_module_pat($m)) {
96 $exclude{$_}=1 for expand_glob($_);
99 push @files, expand_glob($_);
102 return grep !$exclude{$_}, @files;
106 sub get_maintainer_modules {
108 sort { lc $a cmp lc $b }
109 grep { $Modules{$_}{MAINTAINER} eq $m }
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
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
130 List the module ownership of modified or the listed files
133 Show results as valid TAP output. Currently only compatible
134 with --check, --checkmani
136 Matching is case-ignoring regexp, author matching is both by
137 the short id and by the full name and email. A "module" may
138 not be just a module, it may be a file or files or a subdirectory.
139 The options may be abbreviated to their unique prefixes
153 sub process_options {
157 'maintainer=s' => \$Maintainer,
158 'module=s' => \$Module,
161 'checkmani' => \$Checkmani,
162 'opened' => \$Opened,
163 'tap-output' => \$TapOutput,
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();
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;
324 printf "%-15s ?\n", $file;
329 print STDERR "(No files are modified)\n";
338 sub maintainers_files {
340 for my $k (keys %Modules) {
341 for my $f (get_module_files($k)) {
347 sub duplicated_maintainers {
349 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";
357 if ($files{$f} > 1) {
358 warn "File $f appears $files{$f} times in Maintainers.pl\n";
364 sub warn_maintainer {
368 print "ok ".++$TestCounter." - $name has a maintainer\n";
370 print "not ok ".++$TestCounter." - $name has NO maintainer\n";
375 warn "File $name has no maintainer\n" if not $files{$name};
379 sub missing_maintainers {
380 my($check, @path) = @_;
384 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
386 find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir;
389 sub finish_tap_output {
390 print "1..".$TestCounter."\n";