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