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);
29 if (open(MANIFEST, "MANIFEST")) {
31 if (/^(\S+)\t+(.+)$/) {
37 die "$0: Failed to open MANIFEST for reading: $!\n";
42 split ' ', $Modules{$m}{FILES};
45 sub get_module_files {
47 sort { lc $a cmp lc $b }
49 -f $_ ? # Files as-is.
51 -d _ ? # Recurse into directories.
56 push @files, $File::Find::name
57 if -f $_ && exists $MANIFEST{$File::Find::name};
61 : glob($_) # The rest are globbable patterns.
65 sub get_maintainer_modules {
67 sort { lc $a cmp lc $b }
68 grep { $Modules{$_}{MAINTAINER} eq $m }
74 $0: Usage: $0 [[--maintainer M --module M --files]|[--check] file ...]
75 --maintainer M list all maintainers matching M
76 --module M list all modules matching M
77 --files list all files
78 --check check consistency of Maintainers.pl
79 with a file checks if it has a maintainer
80 with a dir checks all files have a maintainer
81 otherwise checks for multiple maintainers
82 --opened list all modules of modified files
83 Matching is case-ignoring regexp, author matching is both by
84 the short id and by the full name and email. A "module" may
85 not be just a module, it may be a file or files or a subdirectory.
86 The options may be abbreviated to their unique prefixes
101 'maintainer=s' => \$Maintainer,
102 'module=s' => \$Module,
105 'opened' => \$Opened,
111 chomp (@Files = `git ls-files -m --full-name`);
117 usage() if @Files && ($Maintainer || $Module || $Files);
119 for my $mean ($Maintainer, $Module) {
120 warn "$0: Did you mean '$0 $mean'?\n"
121 if $mean && -e $mean && $mean ne '.' && !$Files;
124 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
125 if defined $Maintainer && exists $Modules{$Maintainer};
127 warn "$0: Did you mean '$0 -ma $Module'?\n"
128 if defined $Module && exists $Maintainers{$Module};
130 return ($Maintainer, $Module, $Files, @Files);
134 my ($Maintainer, $Module, $Files, @Files) = @_;
137 for my $m (sort keys %Maintainers) {
138 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
139 my @modules = get_maintainer_modules($m);
141 @modules = grep { /$Module/io } @modules;
145 for my $module (@modules) {
146 push @files, get_module_files($module);
148 printf "%-15s @files\n", $m;
151 printf "%-15s @modules\n", $m;
153 printf "%-15s $Maintainers{$m}\n", $m;
159 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
160 if ($m =~ /$Module/io) {
162 my @files = get_module_files($m);
163 printf "%-15s @files\n", $m;
165 printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
171 missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
174 duplicated_maintainers();
179 for (@Files) { s:^\./:: }
181 @ModuleByFile{@Files} = ();
183 # First try fast match.
186 for my $module (keys %Modules) {
187 for my $pat (get_module_pat($module)) {
188 $ModuleByPat{$pat} = $module;
193 for my $pat (keys %ModuleByPat) {
195 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
197 for my $exp (glob($pat)) {
198 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
202 %ModuleByPat = %ExpModuleByPat;
203 for my $file (@Files) {
204 $ModuleByFile{$file} = $ModuleByPat{$file}
205 if exists $ModuleByPat{$file};
208 # If still unresolved files...
209 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
211 # Cannot match what isn't there.
212 @ToDo = grep { -e $_ } @ToDo;
215 # Try prefix matching.
217 # Remove trailing slashes.
218 for (@ToDo) { s|/$|| }
223 for my $pat (keys %ModuleByPat) {
224 last unless keys %ToDo;
227 for my $file (keys %ToDo) {
228 if ($file =~ m|^$pat|i) {
229 $ModuleByFile{$file} = $ModuleByPat{$pat};
239 for my $file (@Files) {
240 if (defined $ModuleByFile{$file}) {
241 my $module = $ModuleByFile{$file};
242 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
243 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
245 printf "%-15s ?\n", $file;
250 print "(No files are modified)\n";
259 sub maintainers_files {
261 for my $k (keys %Modules) {
262 for my $f (get_module_files($k)) {
268 sub duplicated_maintainers {
270 for my $f (keys %files) {
271 if ($files{$f} > 1) {
272 warn "File $f appears $files{$f} times in Maintainers.pl\n";
277 sub warn_maintainer {
279 warn "File $name has no maintainer\n" if not $files{$name};
282 sub missing_maintainers {
283 my($check, @path) = @_;
287 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
289 find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir