A slightly better layout for the diagram.
[p5sagit/p5-mst-13.2.git] / Porting / Maintainers.pm
CommitLineData
0cf51544 1#
2# Maintainers.pm - show information about maintainers
3#
4
5package Maintainers;
6
7use strict;
8
9use lib "Porting";
10
11require "Maintainers.pl";
12use vars qw(%Modules %Maintainers);
13
14use vars qw(@ISA @EXPORT_OK);
15@ISA = qw(Exporter);
16@EXPORT_OK = qw(%Modules %Maintainers
17 get_module_files get_module_pat
18 show_results process_options);
19require Exporter;
20
21use File::Find;
22use Getopt::Long;
23
24my %MANIFEST;
25if (open(MANIFEST, "MANIFEST")) {
26 while (<MANIFEST>) {
27 if (/^(\S+)\t+(.+)$/) {
28 $MANIFEST{$1}++;
29 }
30 }
31 close MANIFEST;
32} else {
33 die "$0: Failed to open MANIFEST for reading: $!\n";
34}
35
36sub get_module_pat {
37 my $m = shift;
38 split ' ', $Modules{$m}{FILES};
39}
40
41sub get_module_files {
42 my $m = shift;
43 sort { lc $a cmp lc $b }
44 map {
45 -f $_ ? # Files as-is.
46 $_ :
47 -d _ ? # Recurse into directories.
48 do {
49 my @files;
50 find(
51 sub {
52 push @files, $File::Find::name
53 if -f $_ && exists $MANIFEST{$File::Find::name};
54 }, $_);
55 @files;
56 }
57 : glob($_) # The rest are globbable patterns.
58 } get_module_pat($m);
59}
60
61sub get_maintainer_modules {
62 my $m = shift;
63 sort { lc $a cmp lc $b }
64 grep { $Modules{$_}{MAINTAINER} eq $m }
65 keys %Modules;
66}
67
68sub usage {
69 print <<__EOF__;
678b26d7 70$0: Usage: $0 [[--maintainer M --module M --files --check]|file ...]
0cf51544 71--maintainer M list all maintainers matching M
72--module M list all modules matching M
73--files list all files
678b26d7 74--check check consistency of Maintainers.pl
0cf51544 75Matching is case-ignoring regexp, author matching is both by
76the short id and by the full name and email. A "module" may
77not be just a module, it may be a file or files or a subdirectory.
78The options may be abbreviated to their unique prefixes
79__EOF__
80 exit(0);
81}
82
83my $Maintainer;
84my $Module;
85my $Files;
678b26d7 86my $Check;
0cf51544 87
88sub process_options {
89 usage()
90 unless
91 GetOptions(
92 'maintainer=s' => \$Maintainer,
93 'module=s' => \$Module,
94 'files' => \$Files,
678b26d7 95 'check' => \$Check,
0cf51544 96 );
97
98 my @Files = @ARGV;
99
100 usage() if @Files && ($Maintainer || $Module || $Files);
101
102 for my $mean ($Maintainer, $Module) {
103 warn "$0: Did you mean '$0 $mean'?\n"
104 if $mean && -e $mean && $mean ne '.' && !$Files;
105 }
106
107 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
108 if defined $Maintainer && exists $Modules{$Maintainer};
109
110 warn "$0: Did you mean '$0 -ma $Module'?\n"
111 if defined $Module && exists $Maintainers{$Module};
112
113 return ($Maintainer, $Module, $Files, @Files);
114}
115
116sub show_results {
117 my ($Maintainer, $Module, $Files, @Files) = @_;
118
119 if ($Maintainer) {
120 for my $m (sort keys %Maintainers) {
121 if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
122 my @modules = get_maintainer_modules($m);
123 if ($Module) {
124 @modules = grep { /$Module/io } @modules;
125 }
126 if ($Files) {
127 my @files;
128 for my $module (@modules) {
129 push @files, get_module_files($module);
130 }
131 printf "%-15s @files\n", $m;
132 } else {
133 if ($Module) {
134 printf "%-15s @modules\n", $m;
135 } else {
136 printf "%-15s $Maintainers{$m}\n", $m;
137 }
138 }
139 }
140 }
141 } elsif ($Module) {
142 for my $m (sort { lc $a cmp lc $b } keys %Modules) {
143 if ($m =~ /$Module/io) {
144 if ($Files) {
145 my @files = get_module_files($m);
146 printf "%-15s @files\n", $m;
147 } else {
148 printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
149 }
150 }
151 }
152 } elsif (@Files) {
153 my %ModuleByFile;
154
155 for (@Files) { s:^\./:: }
156
157 @ModuleByFile{@Files} = ();
158
159 # First try fast match.
160
161 my %ModuleByPat;
162 for my $module (keys %Modules) {
163 for my $pat (get_module_pat($module)) {
164 $ModuleByPat{$pat} = $module;
165 }
166 }
167 # Expand any globs.
168 my %ExpModuleByPat;
169 for my $pat (keys %ModuleByPat) {
170 if (-e $pat) {
171 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
172 } else {
173 for my $exp (glob($pat)) {
174 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
175 }
176 }
177 }
178 %ModuleByPat = %ExpModuleByPat;
179 for my $file (@Files) {
180 $ModuleByFile{$file} = $ModuleByPat{$file}
181 if exists $ModuleByPat{$file};
182 }
183
184 # If still unresolved files...
185 if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
186
187 # Cannot match what isn't there.
188 @ToDo = grep { -e $_ } @ToDo;
189
190 if (@ToDo) {
191 # Try prefix matching.
192
193 # Remove trailing slashes.
194 for (@ToDo) { s|/$|| }
195
196 my %ToDo;
197 @ToDo{@ToDo} = ();
198
199 for my $pat (keys %ModuleByPat) {
200 last unless keys %ToDo;
201 if (-d $pat) {
202 my @Done;
203 for my $file (keys %ToDo) {
204 if ($file =~ m|^$pat|i) {
205 $ModuleByFile{$file} = $ModuleByPat{$pat};
206 push @Done, $file;
207 }
208 }
209 delete @ToDo{@Done};
210 }
211 }
212 }
213 }
214
215 for my $file (@Files) {
216 if (defined $ModuleByFile{$file}) {
217 my $module = $ModuleByFile{$file};
218 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
219 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
220 } else {
221 printf "%-15s ?\n", $file;
222 }
223 }
224 }
678b26d7 225 elsif ($Check) {
226 duplicated_maintainers();
227 }
0cf51544 228 else {
229 usage();
230 }
231}
232
678b26d7 233sub duplicated_maintainers {
234 my %files;
235 for my $k (keys %Modules) {
236 for my $f (get_module_files($k)) {
237 ++$files{$f};
238 }
239 }
240 for my $f (keys %files) {
241 if ($files{$f} > 1) {
242 warn "File $f appears $files{$f} times in Maintainers.pl\n";
243 }
244 }
245}
246
0cf51544 2471;
248