1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 #
18
19 package modules;
20
21 use strict;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
25
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw($modules);
29
30 use vars qw($modules);
31
32 use config qw(
33 file_type files_skip
34 file_directory
35 get_c_files get_spec_files
36 $current_dir $wine_dir
37 );
38 use options qw($options);
39 use output qw($output);
40
41 sub import(@) {
42 $Exporter::ExportLevel++;
43 Exporter::import(@_);
44 $Exporter::ExportLevel--;
45
46 if (defined($modules)) {
47 return;
48 }
49
50 $modules = 'modules'->new;
51 }
52
53 sub get_spec_file_type($) {
54 my $file = shift;
55
56 my $module;
57 my $type;
58
59 $module = $file;
60 $module =~ s%^.*?([^/]+)\.spec$%$1%;
61
62 open(IN, "< $file") || die "$file: $!\n";
63 local $/ = "\n";
64 my $header = 1;
65 my $lookahead = 0;
66 while($lookahead || defined($_ = <IN>)) {
67 $lookahead = 0;
68 s/^\s*(.*?)\s*$/$1/;
69 s/^(.*?)\s*#.*$/$1/;
70 /^$/ && next;
71
72 if($header) {
73 if(/^(?:\d+|@)/) { $header = 0; $lookahead = 1; }
74 next;
75 }
76
77 if(/^(\d+|@)\s+pascal(?:16)?/) {
78 $type = "win16";
79 last;
80 }
81 }
82 close(IN);
83
84 if(!defined($type)) {
85 $type = "win32";
86 }
87
88 return ($type, $module);
89 }
90
91 sub find_spec_files($) {
92 my $self = shift;
93
94 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
95 my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
96
97 $output->progress("modules");
98
99 my $spec_file_found = {};
100 my $allowed_dir;
101 my $spec_file;
102
103 my @spec_files = <{dlls/*/*.spec}>;
104
105 foreach $spec_file (@spec_files) {
106 $spec_file =~ /(.*)\/.*\.spec/;
107
108 $allowed_dir = $1;
109
110 $$spec_file_found{$spec_file}++;
111 $$spec_file2dir{$spec_file}{$allowed_dir}++;
112 $$dir2spec_file{$allowed_dir}{$spec_file}++;
113 # gdi32.dll and gdi.exe have some extra sources in subdirectories
114 if ($spec_file =~ m!/gdi32\.spec$!)
115 {
116 $$spec_file2dir{$spec_file}{"$allowed_dir/enhmfdrv"}++;
117 $$dir2spec_file{"$allowed_dir/enhmfdrv"}{$spec_file}++;
118 }
119 if ($spec_file =~ m!/gdi(?:32|\.exe)\.spec$!)
120 {
121 $$spec_file2dir{$spec_file}{"$allowed_dir/mfdrv"}++;
122 $$dir2spec_file{"$allowed_dir/mfdrv"}{$spec_file}++;
123 }
124 }
125
126 return $spec_file_found;
127 }
128
129 sub read_spec_files($$) {
130 my $self = shift;
131
132 my $spec_file_found = shift;
133
134 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
135 my $spec_files16 = \@{$self->{SPEC_FILES16}};
136 my $spec_files32 = \@{$self->{SPEC_FILES32}};
137 my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
138 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
139
140 my @spec_files;
141 if($wine_dir eq ".") {
142 @spec_files = get_spec_files("winelib");
143 } else {
144 my %spec_files = ();
145 foreach my $dir ($options->directories) {
146 $dir = "$current_dir/$dir";
147 $dir =~ s%/\.$%%;
148 foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
149 $spec_files{$spec_file}++;
150 }
151 }
152 @spec_files = sort(keys(%spec_files));
153 }
154
155 @$spec_files16 = ();
156 @$spec_files32 = ();
157 foreach my $spec_file (@spec_files) {
158 (my $type, my $module) = get_spec_file_type("$wine_dir/$spec_file");
159
160 $$spec_file2module{$spec_file} = $module;
161 $$module2spec_file{$module} = $spec_file;
162
163 if($type eq "win16") {
164 push @$spec_files16, $spec_file;
165 } elsif($type eq "win32") {
166 push @$spec_files32, $spec_file;
167 } else {
168 $output->write("$spec_file: unknown type '$type'\n");
169 }
170 }
171
172 foreach my $spec_file (@spec_files) {
173 if(!$$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) {
174 $output->write("modules: $spec_file: exists but is not specified\n");
175 }
176 }
177 }
178
179 sub new($) {
180 my $proto = shift;
181 my $class = ref($proto) || $proto;
182 my $self = {};
183 bless ($self, $class);
184
185 my $spec_file_found = $self->find_spec_files();
186 $self->read_spec_files($spec_file_found);
187
188 return $self;
189 }
190
191 sub all_modules($) {
192 my $self = shift;
193
194 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
195
196 return sort(keys(%$module2spec_file));
197 }
198
199 sub is_allowed_module($$) {
200 my $self = shift;
201
202 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
203
204 my $module = shift;
205
206 return defined($$module2spec_file{$module});
207 }
208
209 sub is_allowed_module_in_file($$$) {
210 my $self = shift;
211
212 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
213 my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
214
215 my $module = shift;
216 my $file = shift;
217 $file =~ s/^\.\///;
218
219 my $dir = $file;
220 $dir =~ s/\/[^\/]*$//;
221
222 if($dir =~ m%^include%) {
223 return 1;
224 }
225
226 foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
227 if($$spec_file2module{$spec_file} eq $module) {
228 return 1;
229 }
230 }
231
232 return 0;
233 }
234
235 sub allowed_modules_in_file($$) {
236 my $self = shift;
237
238 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
239 my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
240
241 my $file = shift;
242 $file =~ s/^\.\///;
243
244 my $dir = $file;
245 $dir =~ s/\/[^\/]*$//;
246
247 my %allowed_modules = ();
248 foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
249 my $module = $$spec_file2module{$spec_file};
250 $allowed_modules{$module}++;
251 }
252
253 my $module = join(" & ", sort(keys(%allowed_modules)));
254
255 return $module;
256 }
257
258 sub allowed_dirs_for_module($$) {
259 my $self = shift;
260
261 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
262 my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
263
264 my $module = shift;
265
266 my $spec_file = $$module2spec_file{$module};
267
268 return sort(keys(%{$$spec_file2dir{$spec_file}}));
269 }
270
271 sub allowed_spec_files16($) {
272 my $self = shift;
273
274 my $spec_files16 = \@{$self->{SPEC_FILES16}};
275
276 return @$spec_files16;
277 }
278
279 sub allowed_spec_files32($) {
280 my $self = shift;
281
282 my $spec_files32 = \@{$self->{SPEC_FILES32}};
283
284 return @$spec_files32;
285 }
286
287 sub found_module_in_dir($$$) {
288 my $self = shift;
289
290 my $module = shift;
291 my $dir = shift;
292
293 my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
294
295 $dir = "$current_dir/$dir";
296 $dir =~ s%/\.$%%;
297
298 $$used_module_dirs{$module}{$dir}++;
299 }
300
301 sub complete_modules($$) {
302 my $self = shift;
303
304 my $c_files = shift;
305
306 my %dirs;
307
308 foreach my $file (@$c_files) {
309 my $dir = file_directory("$current_dir/$file");
310 $dirs{$dir}++;
311 }
312
313 my @c_files = get_c_files("winelib");
314 @c_files = files_skip(@c_files);
315 foreach my $file (@c_files) {
316 my $dir = file_directory($file);
317 if(exists($dirs{$dir})) {
318 $dirs{$dir}--;
319 }
320 }
321
322 my @complete_modules = ();
323 foreach my $module ($self->all_modules) {
324 my $index = -1;
325 my @dirs = $self->allowed_dirs_for_module($module);
326 foreach my $dir (@dirs) {
327 if(exists($dirs{$dir}) && $dirs{$dir} == 0) {
328 $index++;
329 }
330 }
331 if($index == $#dirs) {
332 push @complete_modules, $module;
333 }
334 }
335
336 return @complete_modules;
337 }
338
339 sub global_report($) {
340 my $self = shift;
341
342 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
343 my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
344
345 my @messages;
346 foreach my $dir ($options->directories) {
347 $dir = "$current_dir/$dir";
348 $dir =~ s%/\.$%%;
349 foreach my $module ($self->all_modules) {
350 if(!$$used_module_dirs{$module}{$dir}) {
351 my $spec_file = $$module2spec_file{$module};
352 push @messages, "modules: $spec_file: directory ($dir) is not used\n";
353 }
354 }
355 }
356
357 foreach my $message (sort(@messages)) {
358 $output->write($message);
359 }
360 }
361
362 1;
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.