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 # exand dir/ or foo* into a full list of files
  59 #
  60 sub expand_glob {
  61     sort { lc $a cmp lc $b }
  62         map {
  63             -f $_ ? # File as-is.
  64                 $_ :
  65                 -d _ ? # Recurse into directories.
  66                 do {
  67                     my @files;
  68                     find(
  69                          sub {
  70                              push @files, $File::Find::name
  71                                  if -f $_ && exists $MANIFEST{$File::Find::name};
  72                          }, $_);
  73                     @files;
  74                 }
  75             # The rest are globbable patterns; expand the glob, then
  76             # recurively perform directory expansion on any results
  77             : expand_glob(grep -e $_,glob($_))
  78             } @_;
  79 }
  80
  81 sub get_module_files {
  82     my $m = shift;
  83     my %exclude;
  84     my @files;
  85     for (get_module_pat($m)) {
  86         if (s/^!//) {
  87             $exclude{$_}=1 for expand_glob($_);
  88         }
  89         else {
  90             push @files, expand_glob($_);
  91         }
  92     }
  93     return grep !$exclude{$_}, @files;
  94 }
  95
  96
  97 sub get_maintainer_modules {
  98     my $m = shift;
  99     sort { lc $a cmp lc $b }
 100     grep { $Modules{$_}{MAINTAINER} eq $m }
 101     keys %Modules;
 102 }
 103
 104 sub usage {
 105     warn <<__EOF__;
 106 $0: Usage:
 107     --maintainer M | --module M [--files]
 108                 List modules or maintainers matching the pattern M.
 109                 With --files, list all the files associated with them
 110 or
 111     --check | --checkmani [commit | file ... | dir ... ]
 112                 Check consistency of Maintainers.pl
 113                         with a file     checks if it has a maintainer
 114                         with a dir      checks all files have a maintainer
 115                         with a commit   checks files modified by that commit
 116                         no arg          checks for multiple maintainers
 117                --checkmani is like --check, but only reports on unclaimed
 118                files if they are in MANIFEST
 119 or
 120     --opened  | file ....
 121                 List the module ownership of modified or the listed files
 122
 123 Matching is case-ignoring regexp, author matching is both by
 124 the short id and by the full name and email.  A "module" may
 125 not be just a module, it may be a file or files or a subdirectory.
 126 The options may be abbreviated to their unique prefixes
 127 __EOF__
 128     exit(0);
 129 }
 130
 131 my $Maintainer;
 132 my $Module;
 133 my $Files;
 134 my $Check;
 135 my $Checkmani;
 136 my $Opened;
 137
 138 sub process_options {
 139     usage()
 140         unless
 141             GetOptions(
 142                        'maintainer=s'   => \$Maintainer,
 143                        'module=s'       => \$Module,
 144                        'files'          => \$Files,
 145                        'check'          => \$Check,
 146                        'checkmani'      => \$Checkmani,
 147                        'opened'         => \$Opened,
 148                       );
 149
 150     my @Files;
 151
 152     if ($Opened) {
 153         usage if @ARGV;
 154         chomp (@Files = `git ls-files -m --full-name`);
 155         die if $?;
 156     } elsif (@ARGV == 1 &&
 157              $ARGV[0] =~ /^(?:HEAD|[0-9a-f]{4,40})(?:~\d+)?\^*$/) {
 158         my $command = "git diff --name-only $ARGV[0]^ $ARGV[0]";
 159         chomp (@Files = `$command`);
 160         die "'$command' failed: $?" if $?;
 161     } else {
 162         @Files = @ARGV;
 163     }
 164
 165     usage() if @Files && ($Maintainer || $Module || $Files);
 166
 167     for my $mean ($Maintainer, $Module) {
 168         warn "$0: Did you mean '$0 $mean'?\n"
 169             if $mean && -e $mean && $mean ne '.' && !$Files;
 170     }
 171
 172     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 173         if defined $Maintainer && exists $Modules{$Maintainer};
 174
 175     warn "$0: Did you mean '$0 -ma $Module'?\n"
 176         if defined $Module     && exists $Maintainers{$Module};
 177
 178     return ($Maintainer, $Module, $Files, @Files);
 179 }
 180
 181 sub files_to_modules {
 182     my @Files = @_;
 183     my %ModuleByFile;
 184
 185     for (@Files) { s:^\./:: }
 186
 187     @ModuleByFile{@Files} = ();
 188
 189     # First try fast match.
 190
 191     my %ModuleByPat;
 192     for my $module (keys %Modules) {
 193         for my $pat (get_module_pat($module)) {
 194             $ModuleByPat{$pat} = $module;
 195         }
 196     }
 197     # Expand any globs.
 198     my %ExpModuleByPat;
 199     for my $pat (keys %ModuleByPat) {
 200         if (-e $pat) {
 201             $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 202         } else {
 203             for my $exp (glob($pat)) {
 204                 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 205             }
 206         }
 207     }
 208     %ModuleByPat = %ExpModuleByPat;
 209     for my $file (@Files) {
 210         $ModuleByFile{$file} = $ModuleByPat{$file}
 211             if exists $ModuleByPat{$file};
 212     }
 213
 214     # If still unresolved files...
 215     if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 216
 217         # Cannot match what isn't there.
 218         @ToDo = grep { -e $_ } @ToDo;
 219
 220         if (@ToDo) {
 221             # Try prefix matching.
 222
 223             # Remove trailing slashes.
 224             for (@ToDo) { s|/$|| }
 225
 226             my %ToDo;
 227             @ToDo{@ToDo} = ();
 228
 229             for my $pat (keys %ModuleByPat) {
 230                 last unless keys %ToDo;
 231                 if (-d $pat) {
 232                     my @Done;
 233                     for my $file (keys %ToDo) {
 234                         if ($file =~ m|^$pat|i) {
 235                             $ModuleByFile{$file} = $ModuleByPat{$pat};
 236                             push @Done, $file;
 237                         }
 238                     }
 239                     delete @ToDo{@Done};
 240                 }
 241             }
 242         }
 243     }
 244     \%ModuleByFile;
 245 }
 246 sub show_results {
 247     my ($Maintainer, $Module, $Files, @Files) = @_;
 248
 249     if ($Maintainer) {
 250         for my $m (sort keys %Maintainers) {
 251             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 252                 my @modules = get_maintainer_modules($m);
 253                 if ($Module) {
 254                     @modules = grep { /$Module/io } @modules;
 255                 }
 256                 if ($Files) {
 257                     my @files;
 258                     for my $module (@modules) {
 259                         push @files, get_module_files($module);
 260                     }
 261                     printf "%-15s @files\n", $m;
 262                 } else {
 263                     if ($Module) {
 264                         printf "%-15s @modules\n", $m;
 265                     } else {
 266                         printf "%-15s $Maintainers{$m}\n", $m;
 267                     }
 268                 }
 269             }
 270         }
 271     } elsif ($Module) {
 272         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 273             if ($m =~ /$Module/io) {
 274                 if ($Files) {
 275                     my @files = get_module_files($m);
 276                     printf "%-15s @files\n", $m;
 277                 } else {
 278                     printf "%-15s %-12s %s\n", $m, $Modules{$m}{MAINTAINER}, $Modules{$m}{UPSTREAM}||'unknown';
 279                 }
 280             }
 281         }
 282     } elsif ($Check or $Checkmani) {
 283         if( @Files ) {
 284             missing_maintainers(
 285                 $Checkmani
 286                     ? sub { -f $_ and exists $MANIFEST{$File::Find::name} }
 287                     : sub { /\.(?:[chty]|p[lm]|xs)\z/msx },
 288                 @Files
 289             );
 290         }
 291         else {
 292             duplicated_maintainers();
 293         }
 294     } elsif (@Files) {
 295         my $ModuleByFile = files_to_modules(@Files);
 296         for my $file (@Files) {
 297             if (defined $ModuleByFile->{$file}) {
 298                 my $module     = $ModuleByFile->{$file};
 299                 my $maintainer = $Modules{$ModuleByFile->{$file}}{MAINTAINER};
 300                 my $upstream   = $Modules{$module}{UPSTREAM}||'unknown';
 301                 printf "%-15s [%-7s] $module $maintainer $Maintainers{$maintainer}\n", $file, $upstream;
 302             } else {
 303                 printf "%-15s ?\n", $file;
 304             }
 305         }
 306     }
 307     elsif ($Opened) {
 308         print STDERR "(No files are modified)\n";
 309     }
 310     else {
 311         usage();
 312     }
 313 }
 314
 315 my %files;
 316
 317 sub maintainers_files {
 318     %files = ();
 319     for my $k (keys %Modules) {
 320         for my $f (get_module_files($k)) {
 321             ++$files{$f};
 322         }
 323     }
 324 }
 325
 326 sub duplicated_maintainers {
 327     maintainers_files();
 328     for my $f (keys %files) {
 329         if ($files{$f} > 1) {
 330             warn "File $f appears $files{$f} times in Maintainers.pl\n";
 331         }
 332     }
 333 }
 334
 335 sub warn_maintainer {
 336     my $name = shift;
 337     warn "File $name has no maintainer\n" if not $files{$name};
 338 }
 339
 340 sub missing_maintainers {
 341     my($check, @path) = @_;
 342     maintainers_files();
 343     my @dir;
 344     for my $d (@path) {
 345         if( -d $d ) { push @dir, $d } else { warn_maintainer($d) }
 346     }
 347     find sub { warn_maintainer($File::Find::name) if $check->() }, @dir
 348         if @dir;
 349 }
 350
 351 1;
 352