| # |
| # 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 |
| # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA |
| # |
| |
| package modules; |
| |
| use strict; |
| |
| use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
| require Exporter; |
| |
| @ISA = qw(Exporter); |
| @EXPORT = qw(); |
| @EXPORT_OK = qw($modules); |
| |
| use vars qw($modules); |
| |
| use config qw( |
| file_type files_skip |
| file_directory |
| get_c_files get_spec_files |
| $current_dir $wine_dir |
| ); |
| use options qw($options); |
| use output qw($output); |
| |
| sub import(@) { |
| $Exporter::ExportLevel++; |
| Exporter::import(@_); |
| $Exporter::ExportLevel--; |
| |
| if (defined($modules)) { |
| return; |
| } |
| |
| $modules = 'modules'->new; |
| } |
| |
| sub get_spec_file_type($) { |
| my $file = shift; |
| |
| my $module; |
| my $type; |
| |
| $module = $file; |
| $module =~ s%^.*?([^/]+)\.spec$%$1%; |
| |
| open(IN, "< $file") || die "$file: $!\n"; |
| local $/ = "\n"; |
| my $header = 1; |
| my $lookahead = 0; |
| while($lookahead || defined($_ = <IN>)) { |
| $lookahead = 0; |
| s/^\s*(.*?)\s*$/$1/; |
| s/^(.*?)\s*#.*$/$1/; |
| /^$/ && next; |
| |
| if($header) { |
| if(/^(?:\d+|@)/) { $header = 0; $lookahead = 1; } |
| next; |
| } |
| |
| if(/^(\d+|@)\s+pascal(?:16)?/) { |
| $type = "win16"; |
| last; |
| } |
| } |
| close(IN); |
| |
| if(!defined($type)) { |
| $type = "win32"; |
| } |
| |
| return ($type, $module); |
| } |
| |
| sub find_spec_files($) { |
| my $self = shift; |
| |
| my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}}; |
| my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}}; |
| |
| $output->progress("modules"); |
| |
| my $spec_file_found = {}; |
| my $allowed_dir; |
| my $spec_file; |
| |
| my @spec_files = <{dlls/*/*.spec}>; |
| |
| foreach $spec_file (@spec_files) { |
| $spec_file =~ /(.*)\/.*\.spec/; |
| |
| $allowed_dir = $1; |
| |
| $$spec_file_found{$spec_file}++; |
| $$spec_file2dir{$spec_file}{$allowed_dir}++; |
| $$dir2spec_file{$allowed_dir}{$spec_file}++; |
| # gdi32.dll and gdi.exe have some extra sources in subdirectories |
| if ($spec_file =~ m!/gdi32\.spec$!) |
| { |
| $$spec_file2dir{$spec_file}{"$allowed_dir/enhmfdrv"}++; |
| $$dir2spec_file{"$allowed_dir/enhmfdrv"}{$spec_file}++; |
| } |
| if ($spec_file =~ m!/gdi(?:32|\.exe)\.spec$!) |
| { |
| $$spec_file2dir{$spec_file}{"$allowed_dir/mfdrv"}++; |
| $$dir2spec_file{"$allowed_dir/mfdrv"}{$spec_file}++; |
| } |
| } |
| |
| return $spec_file_found; |
| } |
| |
| sub read_spec_files($$) { |
| my $self = shift; |
| |
| 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}}; |
| |
| 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) { |
| if(!$$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) { |
| $output->write("modules: $spec_file: exists but is not specified\n"); |
| } |
| } |
| } |
| |
| 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($) { |
| my $self = shift; |
| |
| my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}}; |
| |
| return sort(keys(%$module2spec_file)); |
| } |
| |
| sub is_allowed_module($$) { |
| my $self = shift; |
| |
| my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}}; |
| |
| my $module = shift; |
| |
| return defined($$module2spec_file{$module}); |
| } |
| |
| sub is_allowed_module_in_file($$$) { |
| my $self = shift; |
| |
| my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}}; |
| my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}}; |
| |
| my $module = shift; |
| my $file = shift; |
| $file =~ s/^\.\///; |
| |
| my $dir = $file; |
| $dir =~ s/\/[^\/]*$//; |
| |
| if($dir =~ m%^include%) { |
| return 1; |
| } |
| |
| foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) { |
| if($$spec_file2module{$spec_file} eq $module) { |
| return 1; |
| } |
| } |
| |
| return 0; |
| } |
| |
| sub allowed_modules_in_file($$) { |
| my $self = shift; |
| |
| my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}}; |
| my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}}; |
| |
| my $file = shift; |
| $file =~ s/^\.\///; |
| |
| my $dir = $file; |
| $dir =~ s/\/[^\/]*$//; |
| |
| my %allowed_modules = (); |
| foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) { |
| my $module = $$spec_file2module{$spec_file}; |
| $allowed_modules{$module}++; |
| } |
| |
| my $module = join(" & ", sort(keys(%allowed_modules))); |
| |
| return $module; |
| } |
| |
| sub allowed_dirs_for_module($$) { |
| my $self = shift; |
| |
| my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}}; |
| my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}}; |
| |
| my $module = shift; |
| |
| my $spec_file = $$module2spec_file{$module}; |
| |
| return sort(keys(%{$$spec_file2dir{$spec_file}})); |
| } |
| |
| sub allowed_spec_files16($) { |
| my $self = shift; |
| |
| my $spec_files16 = \@{$self->{SPEC_FILES16}}; |
| |
| return @$spec_files16; |
| } |
| |
| sub allowed_spec_files32($) { |
| my $self = shift; |
| |
| my $spec_files32 = \@{$self->{SPEC_FILES32}}; |
| |
| return @$spec_files32; |
| } |
| |
| sub found_module_in_dir($$$) { |
| my $self = shift; |
| |
| my $module = shift; |
| my $dir = shift; |
| |
| my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}}; |
| |
| $dir = "$current_dir/$dir"; |
| $dir =~ s%/\.$%%; |
| |
| $$used_module_dirs{$module}{$dir}++; |
| } |
| |
| 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; |
| } |
| |
| sub global_report($) { |
| my $self = shift; |
| |
| my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}}; |
| my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}}; |
| |
| my @messages; |
| foreach my $dir ($options->directories) { |
| $dir = "$current_dir/$dir"; |
| $dir =~ s%/\.$%%; |
| foreach my $module ($self->all_modules) { |
| if(!$$used_module_dirs{$module}{$dir}) { |
| my $spec_file = $$module2spec_file{$module}; |
| push @messages, "modules: $spec_file: directory ($dir) is not used\n"; |
| } |
| } |
| } |
| |
| foreach my $message (sort(@messages)) { |
| $output->write($message); |
| } |
| } |
| |
| 1; |
