Commit | Line | Data |
0cf51544 |
1 | # |
2 | # Maintainers.pm - show information about maintainers |
3 | # |
4 | |
5 | package Maintainers; |
6 | |
7 | use strict; |
2b4af749 |
8 | use warnings; |
0cf51544 |
9 | |
10 | use lib "Porting"; |
357244ac |
11 | # Please don't use post 5.008 features as this module is used by |
12 | # Porting/makemeta, and that in turn has to be run by the perl just built. |
13 | use 5.008; |
0cf51544 |
14 | |
15 | require "Maintainers.pl"; |
16 | use vars qw(%Modules %Maintainers); |
17 | |
d8528f07 |
18 | use vars qw(@ISA @EXPORT_OK $VERSION); |
0cf51544 |
19 | @ISA = qw(Exporter); |
20 | @EXPORT_OK = qw(%Modules %Maintainers |
21 | get_module_files get_module_pat |
da92fd60 |
22 | show_results process_options files_to_modules |
2b4af749 |
23 | finish_tap_output |
da92fd60 |
24 | reload_manifest); |
2b4af749 |
25 | $VERSION = 0.04; |
26 | |
0cf51544 |
27 | require Exporter; |
28 | |
29 | use File::Find; |
30 | use Getopt::Long; |
31 | |
32 | my %MANIFEST; |
da92fd60 |
33 | |
34 | # (re)read the MANIFEST file, blowing away any previous effort |
35 | |
36 | sub reload_manifest { |
37 | %MANIFEST = (); |
2b4af749 |
38 | |
39 | my $manifest_path = 'MANIFEST'; |
40 | if (! -e $manifest_path) { |
41 | $manifest_path = "../MANIFEST"; |
42 | } |
43 | |
44 | if (open(my $manfh, $manifest_path )) { |
45 | while (<$manfh>) { |
da92fd60 |
46 | if (/^(\S+)/) { |
47 | $MANIFEST{$1}++; |
48 | } |
49 | else { |
50 | warn "MANIFEST:$.: malformed line: $_\n"; |
51 | } |
0cf51544 |
52 | } |
2b4af749 |
53 | close $manfh; |
da92fd60 |
54 | } else { |
2b4af749 |
55 | die "$0: Failed to open MANIFEST for reading: $!\n"; |
0cf51544 |
56 | } |
0cf51544 |
57 | } |
58 | |
da92fd60 |
59 | reload_manifest; |
60 | |
61 | |
0cf51544 |
62 | sub get_module_pat { |
63 | my $m = shift; |
64 | split ' ', $Modules{$m}{FILES}; |
65 | } |
66 | |
adcdf46b |
67 | # exand dir/ or foo* into a full list of files |
68 | # |
69 | sub expand_glob { |
70 | sort { lc $a cmp lc $b } |
71 | map { |
d9ef0156 |
72 | -f $_ && $_ !~ /[*?]/ ? # File as-is. |
adcdf46b |
73 | $_ : |
d9ef0156 |
74 | -d _ && $_ !~ /[*?]/ ? # Recurse into directories. |
adcdf46b |
75 | do { |
76 | my @files; |
77 | find( |
78 | sub { |
79 | push @files, $File::Find::name |
80 | if -f $_ && exists $MANIFEST{$File::Find::name}; |
81 | }, $_); |
82 | @files; |
83 | } |
84 | # The rest are globbable patterns; expand the glob, then |
85 | # recurively perform directory expansion on any results |
86 | : expand_glob(grep -e $_,glob($_)) |
87 | } @_; |
88 | } |
89 | |
0cf51544 |
90 | sub get_module_files { |
91 | my $m = shift; |
adcdf46b |
92 | my %exclude; |
93 | my @files; |
94 | for (get_module_pat($m)) { |
95 | if (s/^!//) { |
96 | $exclude{$_}=1 for expand_glob($_); |
97 | } |
98 | else { |
99 | push @files, expand_glob($_); |
100 | } |
101 | } |
102 | return grep !$exclude{$_}, @files; |
0cf51544 |
103 | } |
104 | |
adcdf46b |
105 | |
0cf51544 |
106 | sub get_maintainer_modules { |
107 | my $m = shift; |
108 | sort { lc $a cmp lc $b } |
109 | grep { $Modules{$_}{MAINTAINER} eq $m } |
110 | keys %Modules; |
111 | } |
112 | |
113 | sub usage { |
b7bed276 |
114 | warn <<__EOF__; |
115 | $0: Usage: |
116 | --maintainer M | --module M [--files] |
117 | List modules or maintainers matching the pattern M. |
118 | With --files, list all the files associated with them |
119 | or |
120 | --check | --checkmani [commit | file ... | dir ... ] |
121 | Check consistency of Maintainers.pl |
3428fdd5 |
122 | with a file checks if it has a maintainer |
123 | with a dir checks all files have a maintainer |
b7bed276 |
124 | with a commit checks files modified by that commit |
125 | no arg checks for multiple maintainers |
126 | --checkmani is like --check, but only reports on unclaimed |
127 | files if they are in MANIFEST |
128 | or |
129 | --opened | file .... |
130 | List the module ownership of modified or the listed files |
131 | |
2b4af749 |
132 | --tap-output |
133 | Show results as valid TAP output. Currently only compatible |
134 | with --check, --checkmani |
135 | |
0cf51544 |
136 | Matching is case-ignoring regexp, author matching is both by |
137 | the short id and by the full name and email. A "module" may |
138 | not be just a module, it may be a file or files or a subdirectory. |
139 | The options may be abbreviated to their unique prefixes |
140 | __EOF__ |
141 | exit(0); |
142 | } |
143 | |
144 | my $Maintainer; |
145 | my $Module; |
146 | my $Files; |
678b26d7 |
147 | my $Check; |
bfca551d |
148 | my $Checkmani; |
d933dc9e |
149 | my $Opened; |
2b4af749 |
150 | my $TestCounter = 0; |
151 | my $TapOutput; |
0cf51544 |
152 | |
153 | sub process_options { |
154 | usage() |
155 | unless |
156 | GetOptions( |
157 | 'maintainer=s' => \$Maintainer, |
158 | 'module=s' => \$Module, |
159 | 'files' => \$Files, |
678b26d7 |
160 | 'check' => \$Check, |
bfca551d |
161 | 'checkmani' => \$Checkmani, |
d933dc9e |
162 | 'opened' => \$Opened, |
2b4af749 |
163 | 'tap-output' => \$TapOutput, |
0cf51544 |
164 | ); |
165 | |
d933dc9e |
166 | my @Files; |
1be1464a |
167 | |
d933dc9e |
168 | if ($Opened) { |
b7bed276 |
169 | usage if @ARGV; |
fdd40f96 |
170 | chomp (@Files = `git ls-files -m --full-name`); |
d933dc9e |
171 | die if $?; |
29638d28 |
172 | } elsif (@ARGV == 1 && |
173 | $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) { |
174 | my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]"; |
175 | chomp (@Files = `$command`); |
176 | die "'$command' failed: $?" if $?; |
d933dc9e |
177 | } else { |
178 | @Files = @ARGV; |
179 | } |
0cf51544 |
180 | |
181 | usage() if @Files && ($Maintainer || $Module || $Files); |
182 | |
183 | for my $mean ($Maintainer, $Module) { |
184 | warn "$0: Did you mean '$0 $mean'?\n" |
185 | if $mean && -e $mean && $mean ne '.' && !$Files; |
186 | } |
187 | |
188 | warn "$0: Did you mean '$0 -mo $Maintainer'?\n" |
189 | if defined $Maintainer && exists $Modules{$Maintainer}; |
190 | |
191 | warn "$0: Did you mean '$0 -ma $Module'?\n" |
192 | if defined $Module && exists $Maintainers{$Module}; |
193 | |
194 | return ($Maintainer, $Module, $Files, @Files); |
195 | } |
196 | |
e1ae7bac |
197 | sub files_to_modules { |
198 | my @Files = @_; |
199 | my %ModuleByFile; |
200 | |
201 | for (@Files) { s:^\./:: } |
202 | |
203 | @ModuleByFile{@Files} = (); |
204 | |
205 | # First try fast match. |
206 | |
207 | my %ModuleByPat; |
208 | for my $module (keys %Modules) { |
209 | for my $pat (get_module_pat($module)) { |
210 | $ModuleByPat{$pat} = $module; |
211 | } |
212 | } |
213 | # Expand any globs. |
214 | my %ExpModuleByPat; |
215 | for my $pat (keys %ModuleByPat) { |
216 | if (-e $pat) { |
217 | $ExpModuleByPat{$pat} = $ModuleByPat{$pat}; |
218 | } else { |
219 | for my $exp (glob($pat)) { |
220 | $ExpModuleByPat{$exp} = $ModuleByPat{$pat}; |
221 | } |
222 | } |
223 | } |
224 | %ModuleByPat = %ExpModuleByPat; |
225 | for my $file (@Files) { |
226 | $ModuleByFile{$file} = $ModuleByPat{$file} |
227 | if exists $ModuleByPat{$file}; |
228 | } |
229 | |
230 | # If still unresolved files... |
231 | if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) { |
232 | |
233 | # Cannot match what isn't there. |
234 | @ToDo = grep { -e $_ } @ToDo; |
235 | |
236 | if (@ToDo) { |
237 | # Try prefix matching. |
238 | |
8cf77941 |
239 | # Need to try longst prefixes first, else lib/CPAN may match |
240 | # lib/CPANPLUS/... and similar |
241 | |
242 | my @OrderedModuleByPat |
243 | = sort {length $b <=> length $a} keys %ModuleByPat; |
244 | |
e1ae7bac |
245 | # Remove trailing slashes. |
246 | for (@ToDo) { s|/$|| } |
247 | |
248 | my %ToDo; |
249 | @ToDo{@ToDo} = (); |
250 | |
8cf77941 |
251 | for my $pat (@OrderedModuleByPat) { |
e1ae7bac |
252 | last unless keys %ToDo; |
253 | if (-d $pat) { |
254 | my @Done; |
255 | for my $file (keys %ToDo) { |
256 | if ($file =~ m|^$pat|i) { |
257 | $ModuleByFile{$file} = $ModuleByPat{$pat}; |
258 | push @Done, $file; |
259 | } |
260 | } |
261 | delete @ToDo{@Done}; |
262 | } |
263 | } |
264 | } |
265 | } |
266 | \%ModuleByFile; |
267 | } |
0cf51544 |
268 | sub show_results { |
269 | my ($Maintainer, $Module, $Files, @Files) = @_; |
270 | |
271 | if ($Maintainer) { |
272 | for my $m (sort keys %Maintainers) { |
273 | if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) { |
274 | my @modules = get_maintainer_modules($m); |
275 | if ($Module) { |
276 | @modules = grep { /$Module/io } @modules; |
277 | } |
278 | if ($Files) { |
279 | my @files; |
280 | for my $module (@modules) { |
281 | push @files, get_module_files($module); |
282 | } |
283 | printf "%-15s @files\n", $m; |
284 | } else { |
285 | if ($Module) { |
286 | printf "%-15s @modules\n", $m; |
287 | } else { |
288 | printf "%-15s $Maintainers{$m}\n", $m; |
289 | } |
290 | } |
291 | } |
292 | } |
293 | } elsif ($Module) { |
294 | for my $m (sort { lc $a cmp lc $b } keys %Modules) { |
295 | if ($m =~ /$Module/io) { |
296 | if ($Files) { |
297 | my @files = get_module_files($m); |
298 | printf "%-15s @files\n", $m; |
299 | } else { |
adc42316 |
300 | printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown'; |
0cf51544 |
301 | } |
302 | } |
303 | } |
bfca551d |
304 | } elsif ($Check or $Checkmani) { |
3428fdd5 |
305 | if( @Files ) { |
2b4af749 |
306 | missing_maintainers( |
307 | $Checkmani |
308 | ? sub { -f $_ and exists $MANIFEST{$File::Find::name} } |
309 | : sub { /\.(?:[chty]|p[lm]|xs)\z/msx }, |
310 | @Files |
311 | ); |
312 | } else { |
313 | duplicated_maintainers(); |
314 | } |
0cf51544 |
315 | } elsif (@Files) { |
e1ae7bac |
316 | my $ModuleByFile = files_to_modules(@Files); |
0cf51544 |
317 | for my $file (@Files) { |
e1ae7bac |
318 | if (defined $ModuleByFile->{$file}) { |
319 | my $module = $ModuleByFile->{$file}; |
320 | my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER}; |
c5654d5b |
321 | my $upstream = $Modules{$module}{UPSTREAM}||'unknown'; |
322 | printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream; |
0cf51544 |
323 | } else { |
324 | printf "%-15s ?\n", $file; |
325 | } |
326 | } |
327 | } |
fdd40f96 |
328 | elsif ($Opened) { |
f340d83a |
329 | print STDERR "(No files are modified)\n"; |
fdd40f96 |
330 | } |
0cf51544 |
331 | else { |
332 | usage(); |
333 | } |
334 | } |
335 | |
3428fdd5 |
336 | my %files; |
337 | |
338 | sub maintainers_files { |
339 | %files = (); |
678b26d7 |
340 | for my $k (keys %Modules) { |
341 | for my $f (get_module_files($k)) { |
342 | ++$files{$f}; |
343 | } |
344 | } |
3428fdd5 |
345 | } |
346 | |
347 | sub duplicated_maintainers { |
348 | maintainers_files(); |
678b26d7 |
349 | for my $f (keys %files) { |
2b4af749 |
350 | if ($TapOutput) { |
351 | if ($files{$f} > 1) { |
352 | print "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; |
353 | } else { |
354 | print "ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; |
355 | } |
356 | } else { |
357 | if ($files{$f} > 1) { |
358 | warn "File $f appears $files{$f} times in Maintainers.pl\n"; |
359 | } |
360 | } |
678b26d7 |
361 | } |
362 | } |
363 | |
357244ac |
364 | sub warn_maintainer { |
365 | my $name = shift; |
2b4af749 |
366 | if ($TapOutput) { |
367 | if ($files{$name}) { |
368 | print "ok ".++$TestCounter." - $name has a maintainer\n"; |
369 | } else { |
370 | print "not ok ".++$TestCounter." - $name has NO maintainer\n"; |
371 | |
372 | } |
373 | |
374 | } else { |
375 | warn "File $name has no maintainer\n" if not $files{$name}; |
376 | } |
357244ac |
377 | } |
378 | |
3428fdd5 |
379 | sub missing_maintainers { |
380 | my($check, @path) = @_; |
381 | maintainers_files(); |
382 | my @dir; |
357244ac |
383 | for my $d (@path) { |
2b4af749 |
384 | if( -d $d ) { push @dir, $d } else { warn_maintainer($d) } |
357244ac |
385 | } |
2b4af749 |
386 | find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir; |
387 | } |
388 | |
389 | sub finish_tap_output { |
390 | print "1..".$TestCounter."\n"; |
3428fdd5 |
391 | } |
392 | |
0cf51544 |
393 | 1; |
394 | |