Porting/Modules

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Modules - show information about modules and their maintainers
   5 #
   6
   7 use strict;
   8
   9 use FindBin qw($Bin);
  10 require "$Bin/Modules.pl";
  11 use vars qw(%Modules %Maintainers);
  12
  13 use Getopt::Long;
  14 use File::Find;
  15
  16 sub usage {
  17     print <<__EOF__;
  18 $0: Usage: $0 [[--maintainer M --module M --files]|file ...]
  19 $0 --maintainer M       list all maintainers matching M
  20 $0 --module M           list all modules matching M
  21 $0 --files              list all files of the module
  22 Matching is case-ignoring regexp, author matching is both by
  23 the short id and by the full name and email.
  24 $0 file ...             list the module and maintainer
  25 __EOF__
  26     exit(0);
  27 }
  28
  29 my $Maintainer;
  30 my $Module;
  31 my $Files;
  32
  33 usage()
  34     unless
  35     GetOptions(
  36                'maintainer=s'   => \$Maintainer,
  37                'module=s'       => \$Module,
  38                'files'          => \$Files,
  39                );
  40
  41 my @Files = @ARGV;
  42
  43 usage() if @Files && ($Maintainer || $Module || $Files);
  44
  45 for my $mean ($Maintainer, $Module) {
  46     warn "$0: Did you mean '$0 $mean'?\n"
  47         if $mean && -e $mean && $mean ne '.';
  48 }
  49
  50 warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
  51     if defined $Maintainer && exists $Modules{$Maintainer};
  52
  53 warn "$0: Did you mean '$0 -ma $Module'?\n"
  54     if defined $Module     && exists $Maintainers{$Module};
  55
  56 sub get_module_pat {
  57     my $m = shift;
  58     split ' ', $Modules{$m}{FILES};
  59 }
  60
  61 sub get_module_files {
  62     my $m = shift;
  63     sort { lc $a cmp lc $b }
  64     map {
  65         -f $_ ? # Files as-is.
  66             $_ :
  67             -d _ ? # Recurse into directories.
  68             do {
  69                 my @files;
  70                 find(
  71                      sub {
  72                          push @files, $File::Find::name
  73                              if -f $_;
  74                      }, $_);
  75                 @files;
  76             }
  77         : glob($_) # The rest are globbable patterns.
  78         } get_module_pat($m);
  79 }
  80
  81 sub get_maintainer_modules {
  82     my $m = shift;
  83     sort { lc $a cmp lc $b }
  84     grep { $Modules{$_}{MAINTAINER} eq $m }
  85     keys %Modules;
  86 }
  87
  88 if ($Maintainer) {
  89     for my $m (sort keys %Maintainers) {
  90         if ($m =~ /$Maintainer/io) {
  91             my @modules = get_maintainer_modules($m);
  92             if ($Module) {
  93                 @modules = grep { /$Module/io } @modules;
  94             }
  95             if ($Files) {
  96                 my @files;
  97                 for my $module (@modules) {
  98                     push @files, get_module_files($module);
  99                 }
 100                 printf "%-15s @files\n", $m;
 101             } else {
 102                 if ($Module) {
 103                     printf "%-15s @modules\n", $m;
 104                 } else {
 105                     printf "%-15s $Maintainers{$m}\n", $m;
 106                 }
 107             }
 108         }
 109     }
 110 } elsif ($Module) {
 111     for my $m (sort { lc $a cmp lc $b } keys %Modules) {
 112         if ($m =~ /$Module/io) {
 113             if ($Files) {
 114                 my @files = get_module_files($m);
 115                 printf "%-15s @files\n", $m;
 116             } else {
 117                 printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
 118             }
 119         }
 120     }
 121 } elsif (@Files) {
 122     my %ModuleByFile;
 123
 124     for (@Files) { s:^\./:: }
 125
 126     @ModuleByFile{@Files} = ();
 127
 128     # First try fast match.
 129
 130     my %ModuleByPat;
 131     for my $module (keys %Modules) {
 132         for my $pat (get_module_pat($module)) {
 133             $ModuleByPat{$pat} = $module;
 134         }
 135     }
 136     # Expand any globs.
 137     my %ExpModuleByPat;
 138     for my $pat (keys %ModuleByPat) {
 139         if (-e $pat) {
 140             $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 141         } else {
 142             for my $exp (glob($pat)) {
 143                 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 144             }
 145         }
 146     }
 147     %ModuleByPat = %ExpModuleByPat;
 148     for my $file (@Files) {
 149         $ModuleByFile{$file} = $ModuleByPat{$file}
 150             if exists $ModuleByPat{$file};
 151     }
 152
 153     # If still unresolved files..
 154     if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 155
 156         # Cannot match what isn't there.
 157         @ToDo = grep { -e $_ } @ToDo;
 158
 159         if (@ToDo) {
 160             # Try prefix matching.
 161
 162             # Remove trailing slashes.
 163             for (@ToDo) { s|/$|| }
 164
 165             my %ToDo;
 166             @ToDo{@ToDo} = ();
 167
 168             for my $pat (keys %ModuleByPat) {
 169                 last unless keys %ToDo;
 170                 if (-d $pat) {
 171                     my @Done;
 172                     for my $file (keys %ToDo) {
 173                         if ($file =~ m|^$pat|i) {
 174                             $ModuleByFile{$file} = $ModuleByPat{$pat};
 175                             push @Done, $file;
 176                         }
 177                     }
 178                     delete @ToDo{@Done};
 179                 }
 180             }
 181         }
 182     }
 183
 184     for my $file (@Files) {
 185         if (defined $ModuleByFile{$file}) {
 186             my $module     = $ModuleByFile{$file};
 187             my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 188             printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 189         } else {
 190             printf "%-15s ?\n", $file;
 191         }
 192     }
 193 }
 194 else {
 195     usage();
 196 }
 197