This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove the _ prototype, as Maintainers is used by makemeta, and in turn
[perl5.git] / Porting / Maintainers.pm
CommitLineData
0cf51544
JH
1#
2# Maintainers.pm - show information about maintainers
3#
4
5package Maintainers;
6
7use strict;
8
9use lib "Porting";
357244ac
NC
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.
12use 5.008;
0cf51544
JH
13
14require "Maintainers.pl";
15use vars qw(%Modules %Maintainers);
16
17use vars qw(@ISA @EXPORT_OK);
18@ISA = qw(Exporter);
19@EXPORT_OK = qw(%Modules %Maintainers
20 get_module_files get_module_pat
21 show_results process_options);
22require Exporter;
23
24use File::Find;
25use Getopt::Long;
26
27my %MANIFEST;
28if (open(MANIFEST, "MANIFEST")) {
29 while (<MANIFEST>) {
30 if (/^(\S+)\t+(.+)$/) {
31 $MANIFEST{$1}++;
32 }
33 }
34 close MANIFEST;
35} else {
36 die "$0: Failed to open MANIFEST for reading: $!\n";
37}
38
39sub get_module_pat {
40 my $m = shift;
41 split ' ', $Modules{$m}{FILES};
42}
43
44sub get_module_files {
45 my $m = shift;
46 sort { lc $a cmp lc $b }
47 map {
48 -f $_ ? # Files as-is.
49 $_ :
50 -d _ ? # Recurse into directories.
51 do {
52 my @files;
53 find(
54 sub {
55 push @files, $File::Find::name
56 if -f $_ && exists $MANIFEST{$File::Find::name};
57 }, $_);
58 @files;
59 }
60 : glob($_) # The rest are globbable patterns.
61 } get_module_pat($m);
62}
63
64sub get_maintainer_modules {
65 my $m = shift;
66 sort { lc $a cmp lc $b }
67 grep { $Modules{$_}{MAINTAINER} eq $m }
68 keys %Modules;
69}
70
71sub usage {
72 print <<__EOF__;
3428fdd5 73$0: Usage: $0 [[--maintainer M --module M --files]|[--check] file ...]
0cf51544
JH
74--maintainer M list all maintainers matching M
75--module M list all modules matching M
76--files list all files
678b26d7 77--check check consistency of Maintainers.pl
3428fdd5
RB
78 with a file checks if it has a maintainer
79 with a dir checks all files have a maintainer
80 otherwise checks for multiple maintainers
d933dc9e 81--opened list all modules of files opened by perforce
0cf51544
JH
82Matching is case-ignoring regexp, author matching is both by
83the short id and by the full name and email. A "module" may
84not be just a module, it may be a file or files or a subdirectory.
85The options may be abbreviated to their unique prefixes
86__EOF__
87 exit(0);
88}
89
90my $Maintainer;
91my $Module;
92my $Files;
678b26d7 93my $Check;
d933dc9e 94my $Opened;
0cf51544
JH
95
96sub process_options {
97 usage()
98 unless
99 GetOptions(
100 'maintainer=s' => \$Maintainer,
101 'module=s' => \$Module,
102 'files' => \$Files,
678b26d7 103 'check' => \$Check,
d933dc9e 104 'opened' => \$Opened,
0cf51544
JH
105 );
106
d933dc9e
NC
107 my @Files;
108
109 if ($Opened) {
110 my @raw = `p4 opened`;
111 die if $?;
112 @Files = map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw;
113 } else {
114 @Files = @ARGV;
115 }
0cf51544
JH
116
117 usage() if @Files && ($Maintainer || $Module || $Files);
118
119 for my $mean ($Maintainer, $Module) {
120 warn "$0: Did you mean '$0 $mean'?\n"
121 if $mean && -e $mean && $mean ne '.' && !$Files;
122 }
123
124 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
125 if defined $Maintainer && exists $Modules{$Maintainer};
126
127 warn "$0: Did you mean '$0 -ma $Module'?\n"
128 if defined $Module && exists $Maintainers{$Module};
129
130 return ($Maintainer, $Module, $Files, @Files);
131}
132
133sub show_results {
134 my ($Maintainer, $Module, $Files, @Files) = @_;
135
136 if ($Maintainer) {
137 for my $m (sort keys %Maintainers) {
138 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
139 my @modules = get_maintainer_modules($m);
140 if ($Module) {
141 @modules = grep { /$Module/io } @modules;
142 }
143 if ($Files) {
144 my @files;
145 for my $module (@modules) {
146 push @files, get_module_files($module);
147 }
148 printf "%-15s @files\n", $m;
149 } else {
150 if ($Module) {
151 printf "%-15s @modules\n", $m;
152 } else {
153 printf "%-15s $Maintainers{$m}\n", $m;
154 }
155 }
156 }
157 }
158 } elsif ($Module) {
159 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
160 if ($m =~ /$Module/io) {
161 if ($Files) {
162 my @files = get_module_files($m);
163 printf "%-15s @files\n", $m;
164 } else {
165 printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
166 }
167 }
168 }
3428fdd5
RB
169 } elsif ($Check) {
170 if( @Files ) {
171 missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
172 }
173 else {
174 duplicated_maintainers();
175 }
0cf51544
JH
176 } elsif (@Files) {
177 my %ModuleByFile;
178
179 for (@Files) { s:^\./:: }
180
181 @ModuleByFile{@Files} = ();
182
183 # First try fast match.
184
185 my %ModuleByPat;
186 for my $module (keys %Modules) {
187 for my $pat (get_module_pat($module)) {
188 $ModuleByPat{$pat} = $module;
189 }
190 }
191 # Expand any globs.
192 my %ExpModuleByPat;
193 for my $pat (keys %ModuleByPat) {
194 if (-e $pat) {
195 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
196 } else {
197 for my $exp (glob($pat)) {
198 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
199 }
200 }
201 }
202 %ModuleByPat = %ExpModuleByPat;
203 for my $file (@Files) {
204 $ModuleByFile{$file} = $ModuleByPat{$file}
205 if exists $ModuleByPat{$file};
206 }
207
208 # If still unresolved files...
209 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
210
211 # Cannot match what isn't there.
212 @ToDo = grep { -e $_ } @ToDo;
213
214 if (@ToDo) {
215 # Try prefix matching.
216
217 # Remove trailing slashes.
218 for (@ToDo) { s|/$|| }
219
220 my %ToDo;
221 @ToDo{@ToDo} = ();
222
223 for my $pat (keys %ModuleByPat) {
224 last unless keys %ToDo;
225 if (-d $pat) {
226 my @Done;
227 for my $file (keys %ToDo) {
228 if ($file =~ m|^$pat|i) {
229 $ModuleByFile{$file} = $ModuleByPat{$pat};
230 push @Done, $file;
231 }
232 }
233 delete @ToDo{@Done};
234 }
235 }
236 }
237 }
238
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;
244 } else {
245 printf "%-15s ?\n", $file;
246 }
247 }
248 }
249 else {
250 usage();
251 }
252}
253
3428fdd5
RB
254my %files;
255
256sub maintainers_files {
257 %files = ();
678b26d7
RGS
258 for my $k (keys %Modules) {
259 for my $f (get_module_files($k)) {
260 ++$files{$f};
261 }
262 }
3428fdd5
RB
263}
264
265sub duplicated_maintainers {
266 maintainers_files();
678b26d7
RGS
267 for my $f (keys %files) {
268 if ($files{$f} > 1) {
269 warn "File $f appears $files{$f} times in Maintainers.pl\n";
270 }
271 }
272}
273
357244ac
NC
274sub warn_maintainer {
275 my $name = shift;
276 warn "File $name has no maintainer\n" if not $files{$name};
277}
278
3428fdd5
RB
279sub missing_maintainers {
280 my($check, @path) = @_;
281 maintainers_files();
282 my @dir;
357244ac
NC
283 for my $d (@path) {
284 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
285 }
3428fdd5
RB
286 find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
287 if @dir;
288}
289
0cf51544
JH
2901;
291