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