Mac OS X: tweak once again the installation directories.
[p5sagit/p5-mst-13.2.git] / 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