2 # Maintainers.pm - show information about maintainers
12 require "Maintainers.pl";
13 use vars qw(%Modules %Maintainers);
15 use vars qw(@ISA @EXPORT_OK);
17 @EXPORT_OK = qw(%Modules %Maintainers
18 get_module_files get_module_pat
19 show_results process_options);
26 if (open(MANIFEST, "MANIFEST")) {
28 if (/^(\S+)\t+(.+)$/) {
34 die "$0: Failed to open MANIFEST for reading: $!\n";
39 split ' ', $Modules{$m}{FILES};
42 sub get_module_files {
44 sort { lc $a cmp lc $b }
46 -f $_ ? # Files as-is.
48 -d _ ? # Recurse into directories.
53 push @files, $File::Find::name
54 if -f $_ && exists $MANIFEST{$File::Find::name};
58 : glob($_) # The rest are globbable patterns.
62 sub get_maintainer_modules {
64 sort { lc $a cmp lc $b }
65 grep { $Modules{$_}{MAINTAINER} eq $m }
71 $0: Usage: $0 [[--maintainer M --module M --files]|[--check] file ...]
72 --maintainer M list all maintainers matching M
73 --module M list all modules matching M
74 --files list all files
75 --check check consistency of Maintainers.pl
76 with a file checks if it has a maintainer
77 with a dir checks all files have a maintainer
78 otherwise checks for multiple maintainers
79 --opened list all modules of files opened by perforce
80 Matching is case-ignoring regexp, author matching is both by
81 the short id and by the full name and email. A "module" may
82 not be just a module, it may be a file or files or a subdirectory.
83 The options may be abbreviated to their unique prefixes
98 'maintainer=s' => \$Maintainer,
99 'module=s' => \$Module,
102 'opened' => \$Opened,
108 my @raw = `p4 opened`;
110 @Files = map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw;
115 usage() if @Files && ($Maintainer || $Module || $Files);
117 for my $mean ($Maintainer, $Module) {
118 warn "$0: Did you mean '$0 $mean'?\n"
119 if $mean && -e $mean && $mean ne '.' && !$Files;
122 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
123 if defined $Maintainer && exists $Modules{$Maintainer};
125 warn "$0: Did you mean '$0 -ma $Module'?\n"
126 if defined $Module && exists $Maintainers{$Module};
128 return ($Maintainer, $Module, $Files, @Files);
132 my ($Maintainer, $Module, $Files, @Files) = @_;
135 for my $m (sort keys %Maintainers) {
136 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
137 my @modules = get_maintainer_modules($m);
139 @modules = grep { /$Module/io } @modules;
143 for my $module (@modules) {
144 push @files, get_module_files($module);
146 printf "%-15s @files\n", $m;
149 printf "%-15s @modules\n", $m;
151 printf "%-15s $Maintainers{$m}\n", $m;
157 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
158 if ($m =~ /$Module/io) {
160 my @files = get_module_files($m);
161 printf "%-15s @files\n", $m;
163 printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
169 missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
172 duplicated_maintainers();
177 for (@Files) { s:^\./:: }
179 @ModuleByFile{@Files} = ();
181 # First try fast match.
184 for my $module (keys %Modules) {
185 for my $pat (get_module_pat($module)) {
186 $ModuleByPat{$pat} = $module;
191 for my $pat (keys %ModuleByPat) {
193 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
195 for my $exp (glob($pat)) {
196 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
200 %ModuleByPat = %ExpModuleByPat;
201 for my $file (@Files) {
202 $ModuleByFile{$file} = $ModuleByPat{$file}
203 if exists $ModuleByPat{$file};
206 # If still unresolved files...
207 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
209 # Cannot match what isn't there.
210 @ToDo = grep { -e $_ } @ToDo;
213 # Try prefix matching.
215 # Remove trailing slashes.
216 for (@ToDo) { s|/$|| }
221 for my $pat (keys %ModuleByPat) {
222 last unless keys %ToDo;
225 for my $file (keys %ToDo) {
226 if ($file =~ m|^$pat|i) {
227 $ModuleByFile{$file} = $ModuleByPat{$pat};
237 for my $file (@Files) {
238 if (defined $ModuleByFile{$file}) {
239 my $module = $ModuleByFile{$file};
240 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
241 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
243 printf "%-15s ?\n", $file;
252 sub warn_maintainer(_);
255 sub maintainers_files {
257 for my $k (keys %Modules) {
258 for my $f (get_module_files($k)) {
264 sub duplicated_maintainers {
266 for my $f (keys %files) {
267 if ($files{$f} > 1) {
268 warn "File $f appears $files{$f} times in Maintainers.pl\n";
273 sub missing_maintainers {
274 my($check, @path) = @_;
277 for (@path) { if( -d ) { push @dir, $_ } else { warn_maintainer() } }
278 find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
282 sub warn_maintainer(_) {
284 warn "File $name has no maintainer\n" if not $files{$name};