tools/winapi/modules.pm

   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;