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