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         if(!$type) { $type = "win32"; }
 147
 148         $$spec_file2module{$spec_file} = $module;
 149         $$module2spec_file{$module} = $spec_file;
 150
 151         if($type eq "win16") {
 152             push @$spec_files16, $spec_file;
 153         } elsif($type eq "win32") {
 154             push @$spec_files32, $spec_file;
 155         } else {
 156             $output->write("$spec_file: unknown type '$type'\n");
 157         }
 158     }
 159
 160     foreach my $spec_file (@spec_files) {
 161         if(!$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) {
 162             $output->write("modules.dat: $spec_file: exists but is not specified\n");
 163         }
 164     }
 165
 166     $modules = $self;
 167
 168     return $self;
 169 }
 170
 171 sub all_modules {
 172     my $self = shift;
 173
 174     my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
 175
 176     return sort(keys(%$module2spec_file));
 177 }
 178
 179 sub complete_modules {
 180     my $self = shift;
 181
 182     my $c_files = shift;
 183
 184     my %dirs;
 185
 186     foreach my $file (@$c_files) {
 187         my $dir = file_directory("$current_dir/$file");
 188         $dirs{$dir}++;
 189     }
 190
 191     my @c_files = get_c_files("winelib");
 192     @c_files = files_skip(@c_files);
 193     foreach my $file (@c_files) {
 194         my $dir = file_directory($file);
 195         if(exists($dirs{$dir})) {
 196             $dirs{$dir}--;
 197         }
 198     }
 199
 200     my @complete_modules = ();
 201     foreach my $module ($self->all_modules) {
 202         my $index = -1;
 203         my @dirs = $self->allowed_dirs_for_module($module);
 204         foreach my $dir (@dirs) {
 205             if(exists($dirs{$dir}) && $dirs{$dir} == 0) {
 206                 $index++;
 207             }
 208         }
 209         if($index == $#dirs) {
 210             push @complete_modules, $module;
 211         }
 212     }
 213
 214     return @complete_modules;
 215 }
 216
 217 sub is_allowed_module {
 218     my $self = shift;
 219
 220     my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
 221
 222     my $module = shift;
 223
 224     return defined($$module2spec_file{$module});
 225 }
 226
 227 sub is_allowed_module_in_file {
 228     my $self = shift;
 229
 230     my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
 231     my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
 232
 233     my $module = shift;
 234     my $file = shift;
 235     $file =~ s/^\.\///;
 236
 237     my $dir = $file;
 238     $dir =~ s/\/[^\/]*$//;
 239
 240     if($dir =~ m%^include%) {
 241         return 1;
 242     }
 243
 244     foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
 245         if($$spec_file2module{$spec_file} eq $module) {
 246             return 1;
 247         }
 248     }
 249
 250     return 0;
 251 }
 252
 253 sub allowed_modules_in_file {
 254     my $self = shift;
 255
 256     my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
 257     my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
 258
 259     my $file = shift;
 260     $file =~ s/^\.\///;
 261
 262     my $dir = $file;
 263     $dir =~ s/\/[^\/]*$//;
 264
 265     my %allowed_modules = ();
 266     foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
 267         my $module = $$spec_file2module{$spec_file};
 268         $allowed_modules{$module}++;
 269     }
 270
 271     my $module = join(" & ", sort(keys(%allowed_modules)));
 272
 273     return $module;
 274 }
 275
 276 sub allowed_dirs_for_module {
 277    my $self = shift;
 278
 279    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
 280    my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
 281
 282    my $module = shift;
 283
 284    my $spec_file = $$module2spec_file{$module};
 285
 286    return sort(keys(%{$$spec_file2dir{$spec_file}}));
 287 }
 288
 289 sub allowed_spec_files16 {
 290     my $self = shift;
 291
 292     my $spec_files16 = \@{$self->{SPEC_FILES16}};
 293
 294     return @$spec_files16;
 295 }
 296
 297 sub allowed_spec_files32 {
 298     my $self = shift;
 299
 300     my $spec_files32 = \@{$self->{SPEC_FILES32}};
 301
 302     return @$spec_files32;
 303 }
 304
 305 sub found_module_in_dir {
 306     my $self = shift;
 307
 308     my $module = shift;
 309     my $dir = shift;
 310
 311     my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
 312
 313     $dir = "$current_dir/$dir";
 314     $dir =~ s%/\.$%%;
 315
 316     $$used_module_dirs{$module}{$dir}++;
 317 }
 318
 319 sub global_report {
 320     my $self = shift;
 321
 322     my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
 323     my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
 324     my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};
 325
 326     my @messages;
 327     foreach my $dir ($options->directories) {
 328         $dir = "$current_dir/$dir";
 329         $dir =~ s%/\.$%%;
 330         foreach my $module ($self->all_modules) {
 331             if(!$$used_module_dirs{$module}{$dir}) {
 332                 my $spec_file = $$module2spec_file{$module};
 333                 push @messages, "modules.dat: $spec_file: directory ($dir) is not used\n";
 334             }
 335         }
 336     }
 337
 338     foreach my $message (sort(@messages)) {
 339         $output->write($message);
 340     }
 341 }
 342
 343 1;