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     @ModuleByFile{@Files} = ();
 125
 126     # First try fast match.
 127
 128     my %ModuleByPat;
 129     for my $module (keys %Modules) {
 130         for my $pat (get_module_pat($module)) {
 131             $ModuleByPat{$pat} = $module;
 132         }
 133     }
 134     # Expand any globs.
 135     my %ExpModuleByPat;
 136     for my $pat (keys %ModuleByPat) {
 137         if (-e $pat) {
 138             $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
 139         } else {
 140             for my $exp (glob($pat)) {
 141                 $ExpModuleByPat{$exp} = $ModuleByPat{$pat};
 142             }
 143         }
 144     }
 145     %ModuleByPat = %ExpModuleByPat;
 146     for my $file (@Files) {
 147         $ModuleByFile{$file} = $ModuleByPat{$file}
 148             if exists $ModuleByPat{$file};
 149     }
 150
 151     # If still unresolved files..
 152     if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {
 153
 154         # Cannot match what isn't there.
 155         @ToDo = grep { -e $_ } @ToDo;
 156
 157         if (@ToDo) {
 158             # Try prefix matching.
 159
 160             # Remove trailing slashes.
 161             for (@ToDo) { s|/$|| }
 162
 163             my %ToDo;
 164             @ToDo{@ToDo} = ();
 165
 166             for my $pat (keys %ModuleByPat) {
 167                 last unless keys %ToDo;
 168                 if (-d $pat) {
 169                     my @Done;
 170                     for my $file (keys %ToDo) {
 171                         if ($file =~ m|^$pat|i) {
 172                             $ModuleByFile{$file} = $ModuleByPat{$pat};
 173                             push @Done, $file;
 174                         }
 175                     }
 176                     delete @ToDo{@Done};
 177                 }
 178             }
 179         }
 180     }
 181
 182     for my $file (@Files) {
 183         if (defined $ModuleByFile{$file}) {
 184             my $module     = $ModuleByFile{$file};
 185             my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
 186             printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
 187         } else {
 188             printf "%-15s ?\n", $file;
 189         }
 190     }
 191 }
 192 else {
 193     usage();
 194 }
 195