2 # Maintainers.pm - show information about maintainers
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.
14 require "Maintainers.pl";
15 use vars qw(%Modules %Maintainers);
17 use vars qw(@ISA @EXPORT_OK $VERSION);
19 @EXPORT_OK = qw(%Modules %Maintainers
20 get_module_files get_module_pat
21 show_results process_options files_to_modules
31 # (re)read the MANIFEST file, blowing away any previous effort
35 if (open(MANIFEST, "MANIFEST")) {
41 warn "MANIFEST:$.: malformed line: $_\n";
46 die "$0: Failed to open MANIFEST for reading: $!\n";
55 split ' ', $Modules{$m}{FILES};
58 # exand dir/ or foo* into a full list of files
61 sort { lc $a cmp lc $b }
65 -d _ ? # Recurse into directories.
70 push @files, $File::Find::name
71 if -f $_ && exists $MANIFEST{$File::Find::name};
75 # The rest are globbable patterns; expand the glob, then
76 # recurively perform directory expansion on any results
77 : expand_glob(grep -e $_,glob($_))
81 sub get_module_files {
85 for (get_module_pat($m)) {
87 $exclude{$_}=1 for expand_glob($_);
90 push @files, expand_glob($_);
93 return grep !$exclude{$_}, @files;
97 sub get_maintainer_modules {
99 sort { lc $a cmp lc $b }
100 grep { $Modules{$_}{MAINTAINER} eq $m }
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
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
121 List the module ownership of modified or the listed files
123 Matching is case-ignoring regexp, author matching is both by
124 the short id and by the full name and email. A "module" may
125 not be just a module, it may be a file or files or a subdirectory.
126 The options may be abbreviated to their unique prefixes
138 sub process_options {
142 'maintainer=s' => \$Maintainer,
143 'module=s' => \$Module,
146 'checkmani' => \$Checkmani,
147 'opened' => \$Opened,
154 chomp (@Files = `git ls-files -m --full-name`);
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 $?;
165 usage() if @Files && ($Maintainer || $Module || $Files);
167 for my $mean ($Maintainer, $Module) {
168 warn "$0: Did you mean '$0 $mean'?\n"
169 if $mean && -e $mean && $mean ne '.' && !$Files;
172 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
173 if defined $Maintainer && exists $Modules{$Maintainer};
175 warn "$0: Did you mean '$0 -ma $Module'?\n"
176 if defined $Module && exists $Maintainers{$Module};
178 return ($Maintainer, $Module, $Files, @Files);
181 sub files_to_modules {
185 for (@Files) { s:^\./:: }
187 @ModuleByFile{@Files} = ();
189 # First try fast match.
192 for my $module (keys %Modules) {
193 for my $pat (get_module_pat($module)) {
194 $ModuleByPat{$pat} = $module;
199 for my $pat (keys %ModuleByPat) {
201 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
203 for my $exp (glob($pat)) {
204 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
208 %ModuleByPat = %ExpModuleByPat;
209 for my $file (@Files) {
210 $ModuleByFile{$file} = $ModuleByPat{$file}
211 if exists $ModuleByPat{$file};
214 # If still unresolved files...
215 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
217 # Cannot match what isn't there.
218 @ToDo = grep { -e $_ } @ToDo;
221 # Try prefix matching.
223 # Remove trailing slashes.
224 for (@ToDo) { s|/$|| }
229 for my $pat (keys %ModuleByPat) {
230 last unless keys %ToDo;
233 for my $file (keys %ToDo) {
234 if ($file =~ m|^$pat|i) {
235 $ModuleByFile{$file} = $ModuleByPat{$pat};
247 my ($Maintainer, $Module, $Files, @Files) = @_;
250 for my $m (sort keys %Maintainers) {
251 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
252 my @modules = get_maintainer_modules($m);
254 @modules = grep { /$Module/io } @modules;
258 for my $module (@modules) {
259 push @files, get_module_files($module);
261 printf "%-15s @files\n", $m;
264 printf "%-15s @modules\n", $m;
266 printf "%-15s $Maintainers{$m}\n", $m;
272 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
273 if ($m =~ /$Module/io) {
275 my @files = get_module_files($m);
276 printf "%-15s @files\n", $m;
278 printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
282 } elsif ($Check or $Checkmani) {
286 ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
287 : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
292 duplicated_maintainers();
295 my $ModuleByFile = files_to_modules(@Files);
296 for my $file (@Files) {
297 if (defined $ModuleByFile->{$file}) {
298 my $module = $ModuleByFile->{$file};
299 my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER};
300 my $upstream = $Modules{$module}{UPSTREAM}||'unknown';
301 printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
303 printf "%-15s ?\n", $file;
308 print STDERR "(No files are modified)\n";
317 sub maintainers_files {
319 for my $k (keys %Modules) {
320 for my $f (get_module_files($k)) {
326 sub duplicated_maintainers {
328 for my $f (keys %files) {
329 if ($files{$f} > 1) {
330 warn "File $f appears $files{$f} times in Maintainers.pl\n";
335 sub warn_maintainer {
337 warn "File $name has no maintainer\n" if not $files{$name};
340 sub missing_maintainers {
341 my($check, @path) = @_;
345 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
347 find sub { warn_maintainer($File::Find::name) if $check->() }, @dir