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