Commit | Line | Data |
0cf51544 |
1 | # |
2 | # Maintainers.pm - show information about maintainers |
3 | # |
4 | |
5 | package Maintainers; |
6 | |
7 | use strict; |
8 | |
9 | use lib "Porting"; |
10 | |
11 | require "Maintainers.pl"; |
12 | use vars qw(%Modules %Maintainers); |
13 | |
14 | use 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); |
19 | require Exporter; |
20 | |
21 | use File::Find; |
22 | use Getopt::Long; |
23 | |
24 | my %MANIFEST; |
25 | if (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 | |
36 | sub get_module_pat { |
37 | my $m = shift; |
38 | split ' ', $Modules{$m}{FILES}; |
39 | } |
40 | |
41 | sub 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 | |
61 | sub 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 | |
68 | sub 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 |
d933dc9e |
75 | --opened list all modules of files opened by perforce |
0cf51544 |
76 | Matching is case-ignoring regexp, author matching is both by |
77 | the short id and by the full name and email. A "module" may |
78 | not be just a module, it may be a file or files or a subdirectory. |
79 | The options may be abbreviated to their unique prefixes |
80 | __EOF__ |
81 | exit(0); |
82 | } |
83 | |
84 | my $Maintainer; |
85 | my $Module; |
86 | my $Files; |
678b26d7 |
87 | my $Check; |
d933dc9e |
88 | my $Opened; |
0cf51544 |
89 | |
90 | sub process_options { |
91 | usage() |
92 | unless |
93 | GetOptions( |
94 | 'maintainer=s' => \$Maintainer, |
95 | 'module=s' => \$Module, |
96 | 'files' => \$Files, |
678b26d7 |
97 | 'check' => \$Check, |
d933dc9e |
98 | 'opened' => \$Opened, |
0cf51544 |
99 | ); |
100 | |
d933dc9e |
101 | my @Files; |
102 | |
103 | if ($Opened) { |
104 | my @raw = `p4 opened`; |
105 | die if $?; |
106 | @Files = map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw; |
107 | } else { |
108 | @Files = @ARGV; |
109 | } |
0cf51544 |
110 | |
111 | usage() if @Files && ($Maintainer || $Module || $Files); |
112 | |
113 | for my $mean ($Maintainer, $Module) { |
114 | warn "$0: Did you mean '$0 $mean'?\n" |
115 | if $mean && -e $mean && $mean ne '.' && !$Files; |
116 | } |
117 | |
118 | warn "$0: Did you mean '$0 -mo $Maintainer'?\n" |
119 | if defined $Maintainer && exists $Modules{$Maintainer}; |
120 | |
121 | warn "$0: Did you mean '$0 -ma $Module'?\n" |
122 | if defined $Module && exists $Maintainers{$Module}; |
123 | |
124 | return ($Maintainer, $Module, $Files, @Files); |
125 | } |
126 | |
127 | sub show_results { |
128 | my ($Maintainer, $Module, $Files, @Files) = @_; |
129 | |
130 | if ($Maintainer) { |
131 | for my $m (sort keys %Maintainers) { |
132 | if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) { |
133 | my @modules = get_maintainer_modules($m); |
134 | if ($Module) { |
135 | @modules = grep { /$Module/io } @modules; |
136 | } |
137 | if ($Files) { |
138 | my @files; |
139 | for my $module (@modules) { |
140 | push @files, get_module_files($module); |
141 | } |
142 | printf "%-15s @files\n", $m; |
143 | } else { |
144 | if ($Module) { |
145 | printf "%-15s @modules\n", $m; |
146 | } else { |
147 | printf "%-15s $Maintainers{$m}\n", $m; |
148 | } |
149 | } |
150 | } |
151 | } |
152 | } elsif ($Module) { |
153 | for my $m (sort { lc $a cmp lc $b } keys %Modules) { |
154 | if ($m =~ /$Module/io) { |
155 | if ($Files) { |
156 | my @files = get_module_files($m); |
157 | printf "%-15s @files\n", $m; |
158 | } else { |
159 | printf "%-15s $Modules{$m}{MAINTAINER}\n", $m; |
160 | } |
161 | } |
162 | } |
163 | } elsif (@Files) { |
164 | my %ModuleByFile; |
165 | |
166 | for (@Files) { s:^\./:: } |
167 | |
168 | @ModuleByFile{@Files} = (); |
169 | |
170 | # First try fast match. |
171 | |
172 | my %ModuleByPat; |
173 | for my $module (keys %Modules) { |
174 | for my $pat (get_module_pat($module)) { |
175 | $ModuleByPat{$pat} = $module; |
176 | } |
177 | } |
178 | # Expand any globs. |
179 | my %ExpModuleByPat; |
180 | for my $pat (keys %ModuleByPat) { |
181 | if (-e $pat) { |
182 | $ExpModuleByPat{$pat} = $ModuleByPat{$pat}; |
183 | } else { |
184 | for my $exp (glob($pat)) { |
185 | $ExpModuleByPat{$exp} = $ModuleByPat{$pat}; |
186 | } |
187 | } |
188 | } |
189 | %ModuleByPat = %ExpModuleByPat; |
190 | for my $file (@Files) { |
191 | $ModuleByFile{$file} = $ModuleByPat{$file} |
192 | if exists $ModuleByPat{$file}; |
193 | } |
194 | |
195 | # If still unresolved files... |
196 | if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) { |
197 | |
198 | # Cannot match what isn't there. |
199 | @ToDo = grep { -e $_ } @ToDo; |
200 | |
201 | if (@ToDo) { |
202 | # Try prefix matching. |
203 | |
204 | # Remove trailing slashes. |
205 | for (@ToDo) { s|/$|| } |
206 | |
207 | my %ToDo; |
208 | @ToDo{@ToDo} = (); |
209 | |
210 | for my $pat (keys %ModuleByPat) { |
211 | last unless keys %ToDo; |
212 | if (-d $pat) { |
213 | my @Done; |
214 | for my $file (keys %ToDo) { |
215 | if ($file =~ m|^$pat|i) { |
216 | $ModuleByFile{$file} = $ModuleByPat{$pat}; |
217 | push @Done, $file; |
218 | } |
219 | } |
220 | delete @ToDo{@Done}; |
221 | } |
222 | } |
223 | } |
224 | } |
225 | |
226 | for my $file (@Files) { |
227 | if (defined $ModuleByFile{$file}) { |
228 | my $module = $ModuleByFile{$file}; |
229 | my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER}; |
230 | printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file; |
231 | } else { |
232 | printf "%-15s ?\n", $file; |
233 | } |
234 | } |
235 | } |
678b26d7 |
236 | elsif ($Check) { |
237 | duplicated_maintainers(); |
238 | } |
0cf51544 |
239 | else { |
240 | usage(); |
241 | } |
242 | } |
243 | |
678b26d7 |
244 | sub duplicated_maintainers { |
245 | my %files; |
246 | for my $k (keys %Modules) { |
247 | for my $f (get_module_files($k)) { |
248 | ++$files{$f}; |
249 | } |
250 | } |
251 | for my $f (keys %files) { |
252 | if ($files{$f} > 1) { |
253 | warn "File $f appears $files{$f} times in Maintainers.pl\n"; |
254 | } |
255 | } |
256 | } |
257 | |
0cf51544 |
258 | 1; |
259 | |