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