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