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