modules.pm 7.53 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# 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
#

Patrik Stridvall's avatar
Patrik Stridvall committed
19 20 21 22
package modules;

use strict;

23 24 25 26 27 28 29 30 31
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($modules);

use vars qw($modules);

32
use config qw(
33 34 35
    file_type files_skip
    file_directory
    get_c_files get_spec_files
36 37 38 39 40
    $current_dir $wine_dir
);
use options qw($options);
use output qw($output);

41
sub import(@) {
42
    $Exporter::ExportLevel++;
43
    Exporter::import(@_);
44 45
    $Exporter::ExportLevel--;

Patrik Stridvall's avatar
Patrik Stridvall committed
46 47 48 49
    if (defined($modules)) {
	return;
    }

50 51
    $modules = 'modules'->new;
}
52

53
sub get_spec_file_type($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
54 55 56 57 58
    my $file = shift;

    my $module;
    my $type;

59 60 61
    $module = $file;
    $module =~ s%^.*?([^/]+)\.spec$%$1%;

Patrik Stridvall's avatar
Patrik Stridvall committed
62 63
    open(IN, "< $file") || die "$file: $!\n";
    local $/ = "\n";
64 65 66 67
    my $header = 1;
    my $lookahead = 0;
    while($lookahead || defined($_ = <IN>)) {
	$lookahead = 0;
Patrik Stridvall's avatar
Patrik Stridvall committed
68 69 70 71
	s/^\s*(.*?)\s*$/$1/;
	s/^(.*?)\s*#.*$/$1/;
	/^$/ && next;

72
	if($header)  {
73
	    if(/^(?:\d+|@)/) { $header = 0; $lookahead = 1; }
74 75
	    next;
	}
Patrik Stridvall's avatar
Patrik Stridvall committed
76

77 78 79 80
	if(/^(\d+|@)\s+pascal(?:16)?/) {
	    $type = "win16";
	    last;
	}
Patrik Stridvall's avatar
Patrik Stridvall committed
81 82 83 84
    }
    close(IN);

    if(!defined($type)) {
85
	$type = "win32";
Patrik Stridvall's avatar
Patrik Stridvall committed
86 87 88 89 90
    }

    return ($type, $module);
}

91
sub find_spec_files($) {
92 93
    my $self = shift;

94 95
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
Patrik Stridvall's avatar
Patrik Stridvall committed
96

97
    $output->progress("modules");
Patrik Stridvall's avatar
Patrik Stridvall committed
98

99
    my $spec_file_found = {};
Patrik Stridvall's avatar
Patrik Stridvall committed
100 101 102
    my $allowed_dir;
    my $spec_file;

103
    my @spec_files = <{dlls/*/*.spec,dlls/*/*/*.spec}>;
Patrik Stridvall's avatar
Patrik Stridvall committed
104

105 106
    foreach $spec_file (@spec_files) {
        $spec_file =~ /(.*)\/.*\.spec/;
Patrik Stridvall's avatar
Patrik Stridvall committed
107

108
        $allowed_dir = $1;
Patrik Stridvall's avatar
Patrik Stridvall committed
109

110 111 112
        $$spec_file_found{$spec_file}++;
        $$spec_file2dir{$spec_file}{$allowed_dir}++;
        $$dir2spec_file{$allowed_dir}{$spec_file}++;
Patrik Stridvall's avatar
Patrik Stridvall committed
113 114
    }

115 116 117
    return $spec_file_found;
}

118
sub read_spec_files($$) {
119
    my $self = shift;
120

121 122 123 124 125 126 127 128
    my $spec_file_found = shift;

    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_files16 = \@{$self->{SPEC_FILES16}};
    my $spec_files32 = \@{$self->{SPEC_FILES32}};
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};

Patrik Stridvall's avatar
Patrik Stridvall committed
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
    my @spec_files;
    if($wine_dir eq ".") {
	@spec_files = get_spec_files("winelib");
    } else {
	my %spec_files = ();
	foreach my $dir ($options->directories) {
	    $dir = "$current_dir/$dir";
	    $dir =~ s%/\.$%%;
	    foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
		$spec_files{$spec_file}++;
	    }
	}
	@spec_files = sort(keys(%spec_files));
    }

    @$spec_files16 = ();
    @$spec_files32 = ();
    foreach my $spec_file (@spec_files) {
	(my $type, my $module) = get_spec_file_type("$wine_dir/$spec_file");

	$$spec_file2module{$spec_file} = $module;
	$$module2spec_file{$module} = $spec_file;

	if($type eq "win16") {
	    push @$spec_files16, $spec_file;
	} elsif($type eq "win32") {
	    push @$spec_files32, $spec_file;
	} else {
	    $output->write("$spec_file: unknown type '$type'\n");
	}
    }

    foreach my $spec_file (@spec_files) {
162
	if(!$$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) {
163
	    $output->write("modules: $spec_file: exists but is not specified\n");
164 165
	}
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
166 167
}

168 169 170 171 172 173 174 175 176 177 178 179 180
sub new($) {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

    my $spec_file_found = $self->find_spec_files();
    $self->read_spec_files($spec_file_found);

    return $self;
}

sub all_modules($) {
181 182 183 184 185 186 187
    my $self = shift;

    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};

    return sort(keys(%$module2spec_file));
}

188
sub is_allowed_module($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
189 190
    my $self = shift;

191
    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
Patrik Stridvall's avatar
Patrik Stridvall committed
192 193

    my $module = shift;
Patrik Stridvall's avatar
Patrik Stridvall committed
194 195

    return defined($$module2spec_file{$module});
Patrik Stridvall's avatar
Patrik Stridvall committed
196 197
}

198
sub is_allowed_module_in_file($$$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
199 200
    my $self = shift;

201
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
202
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
Patrik Stridvall's avatar
Patrik Stridvall committed
203 204 205 206 207 208 209 210

    my $module = shift;
    my $file = shift;
    $file =~ s/^\.\///;

    my $dir = $file;
    $dir =~ s/\/[^\/]*$//;

211 212 213 214
    if($dir =~ m%^include%) {
	return 1;
    }

215 216
    foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	if($$spec_file2module{$spec_file} eq $module) {
Patrik Stridvall's avatar
Patrik Stridvall committed
217 218 219 220 221 222 223
	    return 1;
	}
    }

    return 0;
}

224
sub allowed_modules_in_file($$) {
Patrik Stridvall's avatar
Patrik Stridvall committed
225 226
    my $self = shift;

227
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
228
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
Patrik Stridvall's avatar
Patrik Stridvall committed
229 230 231 232 233 234 235 236

    my $file = shift;
    $file =~ s/^\.\///;

    my $dir = $file;
    $dir =~ s/\/[^\/]*$//;

    my %allowed_modules = ();
237 238 239
    foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	my $module = $$spec_file2module{$spec_file};
	$allowed_modules{$module}++;
Patrik Stridvall's avatar
Patrik Stridvall committed
240 241
    }

Patrik Stridvall's avatar
Patrik Stridvall committed
242 243 244
    my $module = join(" & ", sort(keys(%allowed_modules)));

    return $module;
Patrik Stridvall's avatar
Patrik Stridvall committed
245 246
}

247
sub allowed_dirs_for_module($$) {
248 249 250
   my $self = shift;

   my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
251
   my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
252 253 254 255 256 257 258 259

   my $module = shift;

   my $spec_file = $$module2spec_file{$module};

   return sort(keys(%{$$spec_file2dir{$spec_file}}));
}

260
sub allowed_spec_files16($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
261 262
    my $self = shift;

Patrik Stridvall's avatar
Patrik Stridvall committed
263
    my $spec_files16 = \@{$self->{SPEC_FILES16}};
Patrik Stridvall's avatar
Patrik Stridvall committed
264

Patrik Stridvall's avatar
Patrik Stridvall committed
265 266
    return @$spec_files16;
}
Patrik Stridvall's avatar
Patrik Stridvall committed
267

268
sub allowed_spec_files32($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
269 270 271
    my $self = shift;

    my $spec_files32 = \@{$self->{SPEC_FILES32}};
Patrik Stridvall's avatar
Patrik Stridvall committed
272

Patrik Stridvall's avatar
Patrik Stridvall committed
273
    return @$spec_files32;
Patrik Stridvall's avatar
Patrik Stridvall committed
274 275
}

276
sub found_module_in_dir($$$) {
277 278 279 280 281 282 283
    my $self = shift;

    my $module = shift;
    my $dir = shift;

    my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};

Patrik Stridvall's avatar
Patrik Stridvall committed
284 285 286
    $dir = "$current_dir/$dir";
    $dir =~ s%/\.$%%;

287 288 289
    $$used_module_dirs{$module}{$dir}++;
}

290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
sub complete_modules($$) {
    my $self = shift;

    my $c_files = shift;

    my %dirs;

    foreach my $file (@$c_files) {
	my $dir = file_directory("$current_dir/$file");
	$dirs{$dir}++;
    }

    my @c_files = get_c_files("winelib");
    @c_files = files_skip(@c_files);
    foreach my $file (@c_files) {
	my $dir = file_directory($file);
	if(exists($dirs{$dir})) {
	    $dirs{$dir}--;
	}
    }

    my @complete_modules = ();
    foreach my $module ($self->all_modules) {
	my $index = -1;
	my @dirs = $self->allowed_dirs_for_module($module);
	foreach my $dir (@dirs) {
	    if(exists($dirs{$dir}) && $dirs{$dir} == 0) {
		$index++;
	    }
	}
	if($index == $#dirs) {
	    push @complete_modules, $module;
	}
    }

    return @complete_modules;
}

328
sub global_report($) {
329 330
    my $self = shift;

Patrik Stridvall's avatar
Patrik Stridvall committed
331
    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
332 333 334
    my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};

    my @messages;
Patrik Stridvall's avatar
Patrik Stridvall committed
335 336 337 338
    foreach my $dir ($options->directories) {
	$dir = "$current_dir/$dir";
	$dir =~ s%/\.$%%;
	foreach my $module ($self->all_modules) {
339
	    if(!$$used_module_dirs{$module}{$dir}) {
Patrik Stridvall's avatar
Patrik Stridvall committed
340
		my $spec_file = $$module2spec_file{$module};
341
		push @messages, "modules: $spec_file: directory ($dir) is not used\n";
342 343 344
	    }
	}
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
345

346
    foreach my $message (sort(@messages)) {
347
	$output->write($message);
348 349
    }
}
Patrik Stridvall's avatar
Patrik Stridvall committed
350

351
1;