Maintainers.pm revision 1.1.1.2
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__; 70$0: Usage: $0 [[--maintainer M --module M --files --check]|file ...] 71--maintainer M list all maintainers matching M 72--module M list all modules matching M 73--files list all files 74--check check consistency of Maintainers.pl 75--opened list all modules of files opened by perforce 76Matching is case-ignoring regexp, author matching is both by 77the short id and by the full name and email. A "module" may 78not be just a module, it may be a file or files or a subdirectory. 79The options may be abbreviated to their unique prefixes 80__EOF__ 81 exit(0); 82} 83 84my $Maintainer; 85my $Module; 86my $Files; 87my $Check; 88my $Opened; 89 90sub process_options { 91 usage() 92 unless 93 GetOptions( 94 'maintainer=s' => \$Maintainer, 95 'module=s' => \$Module, 96 'files' => \$Files, 97 'check' => \$Check, 98 'opened' => \$Opened, 99 ); 100 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 } 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 127sub 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 } 236 elsif ($Check) { 237 duplicated_maintainers(); 238 } 239 else { 240 usage(); 241 } 242} 243 244sub 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 2581; 259 260