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