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
  11 require "Maintainers.pl";
  12 use vars qw(%Modules %Maintainers);
  13
  14 use vars qw(@ISA @EXPORT_OK);
  15 @ISA = qw(Exporter);
  16 @EXPORT_OK = qw(%Modules %Maintainers
  17                 get_module_files get_module_pat
  18                 show_results process_options);
  19 require Exporter;
  20
  21 use File::Find;
  22 use Getopt::Long;
  23
  24 my %MANIFEST;
  25 if (open(MANIFEST, "MANIFEST")) {
  26     while (<MANIFEST>) {
  27         if (/^(\S+)\t+(.+)$/) {
  28             $MANIFEST{$1}++;
  29         }
  30     }
  31     close MANIFEST;
  32 } else {
  33     die "$0: Failed to open MANIFEST for reading: $!\n";
  34 }
  35
  36 sub get_module_pat {
  37     my $m = shift;
  38     split ' ', $Modules{$m}{FILES};
  39 }
  40
  41 sub get_module_files {
  42     my $m = shift;
  43     sort { lc $a cmp lc $b }
  44     map {
  45         -f $_ ? # Files as-is.
  46             $_ :
  47             -d _ ? # Recurse into directories.
  48             do {
  49                 my @files;
  50                 find(
  51                      sub {
  52                          push @files, $File::Find::name
  53                              if -f $_ && exists $MANIFEST{$File::Find::name};
  54                      }, $_);
  55                 @files;
  56             }
  57         : glob($_) # The rest are globbable patterns.
  58         } get_module_pat($m);
  59 }
  60
  61 sub get_maintainer_modules {
  62     my $m = shift;
  63     sort { lc $a cmp lc $b }
  64     grep { $Modules{$_}{MAINTAINER} eq $m }
  65     keys %Modules;
  66 }
  67
  68 sub usage {
  69     print <<__EOF__;
  70 $0: Usage: $0 [[--maintainer M --module M --files --check]|file ...]
  71 --maintainer M  list all maintainers matching M
  72 --module M      list all modules matching M
  73 --files         list all files
  74 --check         check consistency of Maintainers.pl
  75 Matching is case-ignoring regexp, author matching is both by
  76 the short id and by the full name and email.  A "module" may
  77 not be just a module, it may be a file or files or a subdirectory.
  78 The options may be abbreviated to their unique prefixes
  79 __EOF__
  80     exit(0);
  81 }
  82
  83 my $Maintainer;
  84 my $Module;
  85 my $Files;
  86 my $Check;
  87
  88 sub process_options {
  89     usage()
  90         unless
  91             GetOptions(
  92                        'maintainer=s'   => \$Maintainer,
  93                        'module=s'       => \$Module,
  94                        'files'          => \$Files,
  95                        'check'          => \$Check,
  96                       );
  97
  98     my @Files = @ARGV;
  99
 100     usage() if @Files && ($Maintainer || $Module || $Files);
 101
 102     for my $mean ($Maintainer, $Module) {
 103         warn "$0: Did you mean '$0 $mean'?\n"
 104             if $mean && -e $mean && $mean ne '.' && !$Files;
 105     }
 106
 107     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 108         if defined $Maintainer && exists $Modules{$Maintainer};
 109
 110     warn "$0: Did you mean '$0 -ma $Module'?\n"
 111         if defined $Module     && exists $Maintainers{$Module};
 112
 113     return ($Maintainer, $Module, $Files, @Files);
 114 }
 115
 116 sub show_results {
 117     my ($Maintainer, $Module, $Files, @Files) = @_;
 118
 119     if ($Maintainer) {
 120         for my $m (sort keys %Maintainers) {
 121             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 122                 my @modules = get_maintainer_modules($m);
 123                 if ($Module) {
 124                     @modules = grep { /$Module/io } @modules;
 125                 }
 126                 if ($Files) {
 127                     my @files;
 128                     for my $module (@modules) {
 129                         push @files, get_module_files($module);
 130                     }
 131                     printf "%-15s @files\n", $m;
 132                 } else {
 133                     if ($Module) {
 134                         printf "%-15s @modules\n", $m;
 135                     } else {
 136                         printf "%-15s $Maintainers{$m}\n", $m;
 137                     }
 138                 }
 139             }
 140         }
 141     } elsif ($Module) {
 142         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 143             if ($m =~ /$Module/io) {
 144                 if ($Files) {
 145                     my @files = get_module_files($m);
 146                     printf "%-15s @files\n", $m;
 147                 } else {
 148                     printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
 149                 }
 150             }
 151         }
 152     } elsif (@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
 215         for my $file (@Files) {
 216             if (defined $ModuleByFile{$file}) {
 217                 my $module     = $ModuleByFile{$file};
 218                 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 219                 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 220             } else {
 221                 printf "%-15s ?\n", $file;
 222             }
 223         }
 224     }
 225     elsif ($Check) {
 226         duplicated_maintainers();
 227     }
 228     else {
 229         usage();
 230     }
 231 }
 232
 233 sub duplicated_maintainers {
 234     my %files;
 235     for my $k (keys %Modules) {
 236         for my $f (get_module_files($k)) {
 237             ++$files{$f};
 238         }
 239     }
 240     for my $f (keys %files) {
 241         if ($files{$f} > 1) {
 242             warn "File $f appears $files{$f} times in Maintainers.pl\n";
 243         }
 244     }
 245 }
 246
 247 1;
 248