clock: Clock is a program, not a library. So tweak the license and warranty messages...
[wine/hacks.git] / tools / winapi / modules.pm
blobcbf1a2a97da957d74f9eeb05a5930404248d66cd
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
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.
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.
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
19 package modules;
21 use strict;
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw($modules);
30 use vars qw($modules);
32 use config qw(
33 file_type files_skip
34 file_directory
35 get_c_files get_spec_files
36 $current_dir $wine_dir
38 use options qw($options);
39 use output qw($output);
41 sub import(@) {
42 $Exporter::ExportLevel++;
43 Exporter::import(@_);
44 $Exporter::ExportLevel--;
46 if (defined($modules)) {
47 return;
50 $modules = 'modules'->new;
53 sub get_spec_file_type($) {
54 my $file = shift;
56 my $module;
57 my $type;
59 $module = $file;
60 $module =~ s%^.*?([^/]+)\.spec$%$1%;
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;
72 if($header) {
73 if(/^(?:\d+|@)/) { $header = 0; $lookahead = 1; }
74 next;
77 if(/^(\d+|@)\s+pascal(?:16)?/) {
78 $type = "win16";
79 last;
82 close(IN);
84 if(!defined($type)) {
85 $type = "win32";
88 return ($type, $module);
91 sub find_spec_files($) {
92 my $self = shift;
94 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
95 my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
97 $output->progress("modules");
99 my $spec_file_found = {};
100 my $allowed_dir;
101 my $spec_file;
103 my @spec_files = <{dlls/*/*.spec}>;
105 foreach $spec_file (@spec_files) {
106 $spec_file =~ /(.*)\/.*\.spec/;
108 $allowed_dir = $1;
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$!)
116 $$spec_file2dir{$spec_file}{"$allowed_dir/enhmfdrv"}++;
117 $$dir2spec_file{"$allowed_dir/enhmfdrv"}{$spec_file}++;
119 if ($spec_file =~ m!/gdi(?:32|\.exe)\.spec$!)
121 $$spec_file2dir{$spec_file}{"$allowed_dir/mfdrv"}++;
122 $$dir2spec_file{"$allowed_dir/mfdrv"}{$spec_file}++;
126 return $spec_file_found;
129 sub read_spec_files($$) {
130 my $self = shift;
132 my $spec_file_found = shift;
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}};
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}++;
152 @spec_files = sort(keys(%spec_files));
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");
160 $$spec_file2module{$spec_file} = $module;
161 $$module2spec_file{$module} = $spec_file;
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");
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");
179 sub new($) {
180 my $proto = shift;
181 my $class = ref($proto) || $proto;
182 my $self = {};
183 bless ($self, $class);
185 my $spec_file_found = $self->find_spec_files();
186 $self->read_spec_files($spec_file_found);
188 return $self;
191 sub all_modules($) {
192 my $self = shift;
194 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
196 return sort(keys(%$module2spec_file));
199 sub is_allowed_module($$) {
200 my $self = shift;
202 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
204 my $module = shift;
206 return defined($$module2spec_file{$module});
209 sub is_allowed_module_in_file($$$) {
210 my $self = shift;
212 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
213 my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
215 my $module = shift;
216 my $file = shift;
217 $file =~ s/^\.\///;
219 my $dir = $file;
220 $dir =~ s/\/[^\/]*$//;
222 if($dir =~ m%^include%) {
223 return 1;
226 foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
227 if($$spec_file2module{$spec_file} eq $module) {
228 return 1;
232 return 0;
235 sub allowed_modules_in_file($$) {
236 my $self = shift;
238 my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
239 my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
241 my $file = shift;
242 $file =~ s/^\.\///;
244 my $dir = $file;
245 $dir =~ s/\/[^\/]*$//;
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}++;
253 my $module = join(" & ", sort(keys(%allowed_modules)));
255 return $module;
258 sub allowed_dirs_for_module($$) {
259 my $self = shift;
261 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
262 my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
264 my $module = shift;
266 my $spec_file = $$module2spec_file{$module};
268 return sort(keys(%{$$spec_file2dir{$spec_file}}));
271 sub allowed_spec_files16($) {
272 my $self = shift;
274 my $spec_files16 = \@{$self->{SPEC_FILES16}};
276 return @$spec_files16;
279 sub allowed_spec_files32($) {
280 my $self = shift;
282 my $spec_files32 = \@{$self->{SPEC_FILES32}};
284 return @$spec_files32;
287 sub found_module_in_dir($$$) {
288 my $self = shift;
290 my $module = shift;
291 my $dir = shift;
293 my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
295 $dir = "$current_dir/$dir";
296 $dir =~ s%/\.$%%;
298 $$used_module_dirs{$module}{$dir}++;
301 sub complete_modules($$) {
302 my $self = shift;
304 my $c_files = shift;
306 my %dirs;
308 foreach my $file (@$c_files) {
309 my $dir = file_directory("$current_dir/$file");
310 $dirs{$dir}++;
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}--;
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++;
331 if($index == $#dirs) {
332 push @complete_modules, $module;
336 return @complete_modules;
339 sub global_report($) {
340 my $self = shift;
342 my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
343 my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
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";
357 foreach my $message (sort(@messages)) {
358 $output->write($message);