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 # Please don't use post 5.008 features as this module is used by
  11 # Porting/makemeta, and that in turn has to be run by the perl just built.
  12 use 5.008;
  13
  14 require "Maintainers.pl";
  15 use vars qw(%Modules %Maintainers);
  16
  17 use vars qw(@ISA @EXPORT_OK $VERSION);
  18 @ISA = qw(Exporter);
  19 @EXPORT_OK = qw(%Modules %Maintainers
  20                 get_module_files get_module_pat
  21                 show_results process_options files_to_modules);
  22 $VERSION = 0.02;
  23 require Exporter;
  24
  25 use File::Find;
  26 use Getopt::Long;
  27
  28 my %MANIFEST;
  29 if (open(MANIFEST, "MANIFEST")) {
  30     while (<MANIFEST>) {
  31         if (/^(\S+)\t+(.+)$/) {
  32             $MANIFEST{$1}++;
  33         }
  34     }
  35     close MANIFEST;
  36 } else {
  37     die "$0: Failed to open MANIFEST for reading: $!\n";
  38 }
  39
  40 sub get_module_pat {
  41     my $m = shift;
  42     split ' ', $Modules{$m}{FILES};
  43 }
  44
  45 sub get_module_files {
  46     my $m = shift;
  47     sort { lc $a cmp lc $b }
  48     map {
  49         -f $_ ? # Files as-is.
  50             $_ :
  51             -d _ ? # Recurse into directories.
  52             do {
  53                 my @files;
  54                 find(
  55                      sub {
  56                          push @files, $File::Find::name
  57                              if -f $_ && exists $MANIFEST{$File::Find::name};
  58                      }, $_);
  59                 @files;
  60             }
  61         : glob($_) # The rest are globbable patterns.
  62         } get_module_pat($m);
  63 }
  64
  65 sub get_maintainer_modules {
  66     my $m = shift;
  67     sort { lc $a cmp lc $b }
  68     grep { $Modules{$_}{MAINTAINER} eq $m }
  69     keys %Modules;
  70 }
  71
  72 sub usage {
  73     print <<__EOF__;
  74 $0: Usage: $0 [[--maintainer M --module M --files]|[--check] [commit] | [file ...]
  75 --maintainer M  list all maintainers matching M
  76 --module M      list all modules matching M
  77 --files         list all files
  78 --check         check consistency of Maintainers.pl
  79                         with a file     checks if it has a maintainer
  80                         with a dir      checks all files have a maintainer
  81                         otherwise       checks for multiple maintainers
  82 --opened        list all modules of modified files
  83 Matching is case-ignoring regexp, author matching is both by
  84 the short id and by the full name and email.  A "module" may
  85 not be just a module, it may be a file or files or a subdirectory.
  86 The options may be abbreviated to their unique prefixes
  87 __EOF__
  88     exit(0);
  89 }
  90
  91 my $Maintainer;
  92 my $Module;
  93 my $Files;
  94 my $Check;
  95 my $Opened;
  96
  97 sub process_options {
  98     usage()
  99         unless
 100             GetOptions(
 101                        'maintainer=s'   => \$Maintainer,
 102                        'module=s'       => \$Module,
 103                        'files'          => \$Files,
 104                        'check'          => \$Check,
 105                        'opened'         => \$Opened,
 106                       );
 107
 108     my @Files;
 109
 110     if ($Opened) {
 111         chomp (@Files = `git ls-files -m --full-name`);
 112         die if $?;
 113     } elsif (@ARGV == 1 &&
 114              $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) {
 115         my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]";
 116         chomp (@Files = `$command`);
 117         die "'$command' failed: $?" if $?;
 118     } else {
 119         @Files = @ARGV;
 120     }
 121
 122     usage() if @Files && ($Maintainer || $Module || $Files);
 123
 124     for my $mean ($Maintainer, $Module) {
 125         warn "$0: Did you mean '$0 $mean'?\n"
 126             if $mean && -e $mean && $mean ne '.' && !$Files;
 127     }
 128
 129     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 130         if defined $Maintainer && exists $Modules{$Maintainer};
 131
 132     warn "$0: Did you mean '$0 -ma $Module'?\n"
 133         if defined $Module     && exists $Maintainers{$Module};
 134
 135     return ($Maintainer, $Module, $Files, @Files);
 136 }
 137
 138 sub files_to_modules {
 139     my @Files = @_;
 140     my %ModuleByFile;
 141
 142     for (@Files) { s:^\./:: }
 143
 144     @ModuleByFile{@Files} = ();
 145
 146     # First try fast match.
 147
 148     my %ModuleByPat;
 149     for my $module (keys %Modules) {
 150         for my $pat (get_module_pat($module)) {
 151             $ModuleByPat{$pat} = $module;
 152         }
 153     }
 154     # Expand any globs.
 155     my %ExpModuleByPat;
 156     for my $pat (keys %ModuleByPat) {
 157         if (-e $pat) {
 158             $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 159         } else {
 160             for my $exp (glob($pat)) {
 161                 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 162             }
 163         }
 164     }
 165     %ModuleByPat = %ExpModuleByPat;
 166     for my $file (@Files) {
 167         $ModuleByFile{$file} = $ModuleByPat{$file}
 168             if exists $ModuleByPat{$file};
 169     }
 170
 171     # If still unresolved files...
 172     if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 173
 174         # Cannot match what isn't there.
 175         @ToDo = grep { -e $_ } @ToDo;
 176
 177         if (@ToDo) {
 178             # Try prefix matching.
 179
 180             # Remove trailing slashes.
 181             for (@ToDo) { s|/$|| }
 182
 183             my %ToDo;
 184             @ToDo{@ToDo} = ();
 185
 186             for my $pat (keys %ModuleByPat) {
 187                 last unless keys %ToDo;
 188                 if (-d $pat) {
 189                     my @Done;
 190                     for my $file (keys %ToDo) {
 191                         if ($file =~ m|^$pat|i) {
 192                             $ModuleByFile{$file} = $ModuleByPat{$pat};
 193                             push @Done, $file;
 194                         }
 195                     }
 196                     delete @ToDo{@Done};
 197                 }
 198             }
 199         }
 200     }
 201     \%ModuleByFile;
 202 }
 203 sub show_results {
 204     my ($Maintainer, $Module, $Files, @Files) = @_;
 205
 206     if ($Maintainer) {
 207         for my $m (sort keys %Maintainers) {
 208             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 209                 my @modules = get_maintainer_modules($m);
 210                 if ($Module) {
 211                     @modules = grep { /$Module/io } @modules;
 212                 }
 213                 if ($Files) {
 214                     my @files;
 215                     for my $module (@modules) {
 216                         push @files, get_module_files($module);
 217                     }
 218                     printf "%-15s @files\n", $m;
 219                 } else {
 220                     if ($Module) {
 221                         printf "%-15s @modules\n", $m;
 222                     } else {
 223                         printf "%-15s $Maintainers{$m}\n", $m;
 224                     }
 225                 }
 226             }
 227         }
 228     } elsif ($Module) {
 229         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 230             if ($m =~ /$Module/io) {
 231                 if ($Files) {
 232                     my @files = get_module_files($m);
 233                     printf "%-15s @files\n", $m;
 234                 } else {
 235                     printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
 236                 }
 237             }
 238         }
 239     } elsif ($Check) {
 240         if( @Files ) {
 241             missing_maintainers( qr{\.(?:[chty]|p[lm]|xs)\z}msx, @Files)
 242         }
 243         else {
 244             duplicated_maintainers();
 245         }
 246     } elsif (@Files) {
 247         my $ModuleByFile = files_to_modules(@Files);
 248         for my $file (@Files) {
 249             if (defined $ModuleByFile->{$file}) {
 250                 my $module     = $ModuleByFile->{$file};
 251                 my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER};
 252                 my $upstream   = $Modules{$module}{UPSTREAM}||'unknown';
 253                 printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
 254             } else {
 255                 printf "%-15s ?\n", $file;
 256             }
 257         }
 258     }
 259     elsif ($Opened) {
 260         print STDERR "(No files are modified)\n";
 261     }
 262     else {
 263         usage();
 264     }
 265 }
 266
 267 my %files;
 268
 269 sub maintainers_files {
 270     %files = ();
 271     for my $k (keys %Modules) {
 272         for my $f (get_module_files($k)) {
 273             ++$files{$f};
 274         }
 275     }
 276 }
 277
 278 sub duplicated_maintainers {
 279     maintainers_files();
 280     for my $f (keys %files) {
 281         if ($files{$f} > 1) {
 282             warn "File $f appears $files{$f} times in Maintainers.pl\n";
 283         }
 284     }
 285 }
 286
 287 sub warn_maintainer {
 288     my $name = shift;
 289     warn "File $name has no maintainer\n" if not $files{$name};
 290 }
 291
 292 sub missing_maintainers {
 293     my($check, @path) = @_;
 294     maintainers_files();
 295     my @dir;
 296     for my $d (@path) {
 297         if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
 298     }
 299     find sub { warn_maintainer($File::Find::name) if /$check/; }, @dir
 300         if @dir;
 301 }
 302
 303 1;
 304