Commit | Line | Data |
b128a327 |
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 | |
99a7b1fa |
124 | for (@Files) { s:^\./:: } |
125 | |
b128a327 |
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 | |