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