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