Maintainers.pm revision 1.1.1.3
1# 2# Maintainers.pm - show information about maintainers 3# 4 5package Maintainers; 6 7use strict; 8 9use lib "Porting"; 10use 5.010; 11 12require "Maintainers.pl"; 13use vars qw(%Modules %Maintainers); 14 15use 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); 20require Exporter; 21 22use File::Find; 23use Getopt::Long; 24 25my %MANIFEST; 26if (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 37sub get_module_pat { 38 my $m = shift; 39 split ' ', $Modules{$m}{FILES}; 40} 41 42sub 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 62sub 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 69sub 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 80Matching is case-ignoring regexp, author matching is both by 81the short id and by the full name and email. A "module" may 82not be just a module, it may be a file or files or a subdirectory. 83The options may be abbreviated to their unique prefixes 84__EOF__ 85 exit(0); 86} 87 88my $Maintainer; 89my $Module; 90my $Files; 91my $Check; 92my $Opened; 93 94sub 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 131sub 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 252sub warn_maintainer(_); 253my %files; 254 255sub 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 264sub 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 273sub 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 282sub warn_maintainer(_) { 283 my $name = shift; 284 warn "File $name has no maintainer\n" if not $files{$name}; 285} 286 2871; 288 289