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