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
  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__;
  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                         with a file     checks if it has a maintainer
  76                         with a dir      checks all files have a maintainer
  77                         otherwise       checks for multiple maintainers
  78 --opened        list all modules of files opened by perforce
  79 Matching is case-ignoring regexp, author matching is both by
  80 the short id and by the full name and email.  A "module" may
  81 not be just a module, it may be a file or files or a subdirectory.
  82 The options may be abbreviated to their unique prefixes
  83 __EOF__
  84     exit(0);
  85 }
  86
  87 my $Maintainer;
  88 my $Module;
  89 my $Files;
  90 my $Check;
  91 my $Opened;
  92
  93 sub process_options {
  94     usage()
  95         unless
  96             GetOptions(
  97                        'maintainer=s'   => \$Maintainer,
  98                        'module=s'       => \$Module,
  99                        'files'          => \$Files,
 100                        'check'          => \$Check,
 101                        'opened'         => \$Opened,
 102                       );
 103
 104     my @Files;
 105
 106     if ($Opened) {
 107         my @raw = `p4 opened`;
 108         die if $?;
 109         @Files =  map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw;
 110     } else {
 111         @Files = @ARGV;
 112     }
 113
 114     usage() if @Files && ($Maintainer || $Module || $Files);
 115
 116     for my $mean ($Maintainer, $Module) {
 117         warn "$0: Did you mean '$0 $mean'?\n"
 118             if $mean && -e $mean && $mean ne '.' && !$Files;
 119     }
 120
 121     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 122         if defined $Maintainer && exists $Modules{$Maintainer};
 123
 124     warn "$0: Did you mean '$0 -ma $Module'?\n"
 125         if defined $Module     && exists $Maintainers{$Module};
 126
 127     return ($Maintainer, $Module, $Files, @Files);
 128 }
 129
 130 sub show_results {
 131     my ($Maintainer, $Module, $Files, @Files) = @_;
 132
 133     if ($Maintainer) {
 134         for my $m (sort keys %Maintainers) {
 135             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 136                 my @modules = get_maintainer_modules($m);
 137                 if ($Module) {
 138                     @modules = grep { /$Module/io } @modules;
 139                 }
 140                 if ($Files) {
 141                     my @files;
 142                     for my $module (@modules) {
 143                         push @files, get_module_files($module);
 144                     }
 145                     printf "%-15s @files\n", $m;
 146                 } else {
 147                     if ($Module) {
 148                         printf "%-15s @modules\n", $m;
 149                     } else {
 150                         printf "%-15s $Maintainers{$m}\n", $m;
 151                     }
 152                 }
 153             }
 154         }
 155     } elsif ($Module) {
 156         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 157             if ($m =~ /$Module/io) {
 158                 if ($Files) {
 159                     my @files = get_module_files($m);
 160                     printf "%-15s @files\n", $m;
 161                 } else {
 162                     printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
 163                 }
 164             }
 165         }
 166     } elsif ($Check) {
 167         if( @Files ) {
 168             missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
 169         }
 170         else {
 171             duplicated_maintainers();
 172         }
 173     } elsif (@Files) {
 174         my %ModuleByFile;
 175
 176         for (@Files) { s:^\./:: }
 177
 178         @ModuleByFile{@Files} = ();
 179
 180         # First try fast match.
 181
 182         my %ModuleByPat;
 183         for my $module (keys %Modules) {
 184             for my $pat (get_module_pat($module)) {
 185                 $ModuleByPat{$pat} = $module;
 186             }
 187         }
 188         # Expand any globs.
 189         my %ExpModuleByPat;
 190         for my $pat (keys %ModuleByPat) {
 191             if (-e $pat) {
 192                 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 193             } else {
 194                 for my $exp (glob($pat)) {
 195                     $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 196                 }
 197             }
 198         }
 199         %ModuleByPat = %ExpModuleByPat;
 200         for my $file (@Files) {
 201             $ModuleByFile{$file} = $ModuleByPat{$file}
 202                 if exists $ModuleByPat{$file};
 203         }
 204
 205         # If still unresolved files...
 206         if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 207
 208             # Cannot match what isn't there.
 209             @ToDo = grep { -e $_ } @ToDo;
 210
 211             if (@ToDo) {
 212                 # Try prefix matching.
 213
 214                 # Remove trailing slashes.
 215                 for (@ToDo) { s|/$|| }
 216
 217                 my %ToDo;
 218                 @ToDo{@ToDo} = ();
 219
 220                 for my $pat (keys %ModuleByPat) {
 221                     last unless keys %ToDo;
 222                     if (-d $pat) {
 223                         my @Done;
 224                         for my $file (keys %ToDo) {
 225                             if ($file =~ m|^$pat|i) {
 226                                 $ModuleByFile{$file} = $ModuleByPat{$pat};
 227                                 push @Done, $file;
 228                             }
 229                         }
 230                         delete @ToDo{@Done};
 231                     }
 232                 }
 233             }
 234         }
 235
 236         for my $file (@Files) {
 237             if (defined $ModuleByFile{$file}) {
 238                 my $module     = $ModuleByFile{$file};
 239                 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 240                 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 241             } else {
 242                 printf "%-15s ?\n", $file;
 243             }
 244         }
 245     }
 246     else {
 247         usage();
 248     }
 249 }
 250
 251 sub warn_maintainer(_);
 252 my %files;
 253
 254 sub maintainers_files {
 255     %files = ();
 256     for my $k (keys %Modules) {
 257         for my $f (get_module_files($k)) {
 258             ++$files{$f};
 259         }
 260     }
 261 }
 262
 263 sub duplicated_maintainers {
 264     maintainers_files();
 265     for my $f (keys %files) {
 266         if ($files{$f} > 1) {
 267             warn "File $f appears $files{$f} times in Maintainers.pl\n";
 268         }
 269     }
 270 }
 271
 272 sub missing_maintainers {
 273     my($check, @path) = @_;
 274     maintainers_files();
 275     my @dir;
 276     for (@path) { if( -d ) { push @dir, $_ } else { warn_maintainer() } }
 277     find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
 278         if @dir;
 279 }
 280
 281 sub warn_maintainer(_) {
 282     my $name = shift;
 283     warn "File $name has no maintainer\n" if not $files{$name};
 284 }
 285
 286 1;
 287