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