This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in the code for --opened - it was not working on blead.
[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) {
33768f13 110 @Files = `p4 opened`;
d933dc9e 111 die if $?;
33768f13
NC
112 foreach (@Files) {
113 s!#.*!!s;
114 s!^//depot/(?:perl|.*?/perl)/!!;
115 }
d933dc9e
NC
116 } else {
117 @Files = @ARGV;
118 }
0cf51544
JH
119
120 usage() if @Files && ($Maintainer || $Module || $Files);
121
122 for my $mean ($Maintainer, $Module) {
123 warn "$0: Did you mean '$0 $mean'?\n"
124 if $mean && -e $mean && $mean ne '.' && !$Files;
125 }
126
127 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
128 if defined $Maintainer && exists $Modules{$Maintainer};
129
130 warn "$0: Did you mean '$0 -ma $Module'?\n"
131 if defined $Module && exists $Maintainers{$Module};
132
133 return ($Maintainer, $Module, $Files, @Files);
134}
135
136sub show_results {
137 my ($Maintainer, $Module, $Files, @Files) = @_;
138
139 if ($Maintainer) {
140 for my $m (sort keys %Maintainers) {
141 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
142 my @modules = get_maintainer_modules($m);
143 if ($Module) {
144 @modules = grep { /$Module/io } @modules;
145 }
146 if ($Files) {
147 my @files;
148 for my $module (@modules) {
149 push @files, get_module_files($module);
150 }
151 printf "%-15s @files\n", $m;
152 } else {
153 if ($Module) {
154 printf "%-15s @modules\n", $m;
155 } else {
156 printf "%-15s $Maintainers{$m}\n", $m;
157 }
158 }
159 }
160 }
161 } elsif ($Module) {
162 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
163 if ($m =~ /$Module/io) {
164 if ($Files) {
165 my @files = get_module_files($m);
166 printf "%-15s @files\n", $m;
167 } else {
168 printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
169 }
170 }
171 }
3428fdd5
RB
172 } elsif ($Check) {
173 if( @Files ) {
174 missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
175 }
176 else {
177 duplicated_maintainers();
178 }
0cf51544
JH
179 } elsif (@Files) {
180 my %ModuleByFile;
181
182 for (@Files) { s:^\./:: }
183
184 @ModuleByFile{@Files} = ();
185
186 # First try fast match.
187
188 my %ModuleByPat;
189 for my $module (keys %Modules) {
190 for my $pat (get_module_pat($module)) {
191 $ModuleByPat{$pat} = $module;
192 }
193 }
194 # Expand any globs.
195 my %ExpModuleByPat;
196 for my $pat (keys %ModuleByPat) {
197 if (-e $pat) {
198 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
199 } else {
200 for my $exp (glob($pat)) {
201 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
202 }
203 }
204 }
205 %ModuleByPat = %ExpModuleByPat;
206 for my $file (@Files) {
207 $ModuleByFile{$file} = $ModuleByPat{$file}
208 if exists $ModuleByPat{$file};
209 }
210
211 # If still unresolved files...
212 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
213
214 # Cannot match what isn't there.
215 @ToDo = grep { -e $_ } @ToDo;
216
217 if (@ToDo) {
218 # Try prefix matching.
219
220 # Remove trailing slashes.
221 for (@ToDo) { s|/$|| }
222
223 my %ToDo;
224 @ToDo{@ToDo} = ();
225
226 for my $pat (keys %ModuleByPat) {
227 last unless keys %ToDo;
228 if (-d $pat) {
229 my @Done;
230 for my $file (keys %ToDo) {
231 if ($file =~ m|^$pat|i) {
232 $ModuleByFile{$file} = $ModuleByPat{$pat};
233 push @Done, $file;
234 }
235 }
236 delete @ToDo{@Done};
237 }
238 }
239 }
240 }
241
242 for my $file (@Files) {
243 if (defined $ModuleByFile{$file}) {
244 my $module = $ModuleByFile{$file};
245 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
246 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
247 } else {
248 printf "%-15s ?\n", $file;
249 }
250 }
251 }
252 else {
253 usage();
254 }
255}
256
3428fdd5
RB
257my %files;
258
259sub maintainers_files {
260 %files = ();
678b26d7
RGS
261 for my $k (keys %Modules) {
262 for my $f (get_module_files($k)) {
263 ++$files{$f};
264 }
265 }
3428fdd5
RB
266}
267
268sub duplicated_maintainers {
269 maintainers_files();
678b26d7
RGS
270 for my $f (keys %files) {
271 if ($files{$f} > 1) {
272 warn "File $f appears $files{$f} times in Maintainers.pl\n";
273 }
274 }
275}
276
357244ac
NC
277sub warn_maintainer {
278 my $name = shift;
279 warn "File $name has no maintainer\n" if not $files{$name};
280}
281
3428fdd5
RB
282sub missing_maintainers {
283 my($check, @path) = @_;
284 maintainers_files();
285 my @dir;
357244ac
NC
286 for my $d (@path) {
287 if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
288 }
3428fdd5
RB
289 find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
290 if @dir;
291}
292
0cf51544
JH
2931;
294