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]|file ...]
  71 --maintainer M  list all maintainers matching M
  72 --module M      list all modules matching M
  73 --files         list all files
  74 Matching is case-ignoring regexp, author matching is both by
  75 the short id and by the full name and email.  A "module" may
  76 not be just a module, it may be a file or files or a subdirectory.
  77 The options may be abbreviated to their unique prefixes
  78 __EOF__
  79     exit(0);
  80 }
  81
  82 my $Maintainer;
  83 my $Module;
  84 my $Files;
  85
  86 sub process_options {
  87     usage()
  88         unless
  89             GetOptions(
  90                        'maintainer=s'   => \$Maintainer,
  91                        'module=s'       => \$Module,
  92                        'files'          => \$Files,
  93                       );
  94
  95     my @Files = @ARGV;
  96
  97     usage() if @Files && ($Maintainer || $Module || $Files);
  98
  99     for my $mean ($Maintainer, $Module) {
 100         warn "$0: Did you mean '$0 $mean'?\n"
 101             if $mean && -e $mean && $mean ne '.' && !$Files;
 102     }
 103
 104     warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
 105         if defined $Maintainer && exists $Modules{$Maintainer};
 106
 107     warn "$0: Did you mean '$0 -ma $Module'?\n"
 108         if defined $Module     && exists $Maintainers{$Module};
 109
 110     return ($Maintainer, $Module, $Files, @Files);
 111 }
 112
 113 sub show_results {
 114     my ($Maintainer, $Module, $Files, @Files) = @_;
 115
 116     if ($Maintainer) {
 117         for my $m (sort keys %Maintainers) {
 118             if ($m =~ /$Maintainer/io || $Maintainers{$m} =~ /$Maintainer/io) {
 119                 my @modules = get_maintainer_modules($m);
 120                 if ($Module) {
 121                     @modules = grep { /$Module/io } @modules;
 122                 }
 123                 if ($Files) {
 124                     my @files;
 125                     for my $module (@modules) {
 126                         push @files, get_module_files($module);
 127                     }
 128                     printf "%-15s @files\n", $m;
 129                 } else {
 130                     if ($Module) {
 131                         printf "%-15s @modules\n", $m;
 132                     } else {
 133                         printf "%-15s $Maintainers{$m}\n", $m;
 134                     }
 135                 }
 136             }
 137         }
 138     } elsif ($Module) {
 139         for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 140             if ($m =~ /$Module/io) {
 141                 if ($Files) {
 142                     my @files = get_module_files($m);
 143                     printf "%-15s @files\n", $m;
 144                 } else {
 145                     printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
 146                 }
 147             }
 148         }
 149     } elsif (@Files) {
 150         my %ModuleByFile;
 151
 152         for (@Files) { s:^\./:: }
 153
 154         @ModuleByFile{@Files} = ();
 155
 156         # First try fast match.
 157
 158         my %ModuleByPat;
 159         for my $module (keys %Modules) {
 160             for my $pat (get_module_pat($module)) {
 161                 $ModuleByPat{$pat} = $module;
 162             }
 163         }
 164         # Expand any globs.
 165         my %ExpModuleByPat;
 166         for my $pat (keys %ModuleByPat) {
 167             if (-e $pat) {
 168                 $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 169             } else {
 170                 for my $exp (glob($pat)) {
 171                     $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 172                 }
 173             }
 174         }
 175         %ModuleByPat = %ExpModuleByPat;
 176         for my $file (@Files) {
 177             $ModuleByFile{$file} = $ModuleByPat{$file}
 178                 if exists $ModuleByPat{$file};
 179         }
 180
 181         # If still unresolved files...
 182         if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 183
 184             # Cannot match what isn't there.
 185             @ToDo = grep { -e $_ } @ToDo;
 186
 187             if (@ToDo) {
 188                 # Try prefix matching.
 189
 190                 # Remove trailing slashes.
 191                 for (@ToDo) { s|/$|| }
 192
 193                 my %ToDo;
 194                 @ToDo{@ToDo} = ();
 195
 196                 for my $pat (keys %ModuleByPat) {
 197                     last unless keys %ToDo;
 198                     if (-d $pat) {
 199                         my @Done;
 200                         for my $file (keys %ToDo) {
 201                             if ($file =~ m|^$pat|i) {
 202                                 $ModuleByFile{$file} = $ModuleByPat{$pat};
 203                                 push @Done, $file;
 204                             }
 205                         }
 206                         delete @ToDo{@Done};
 207                     }
 208                 }
 209             }
 210         }
 211
 212         for my $file (@Files) {
 213             if (defined $ModuleByFile{$file}) {
 214                 my $module     = $ModuleByFile{$file};
 215                 my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 216                 printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 217             } else {
 218                 printf "%-15s ?\n", $file;
 219             }
 220         }
 221     }
 222     else {
 223         usage();
 224     }
 225 }
 226
 227 1;
 228