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