git.oblomov.eu Git - wine/blob - tools/winapi/config.pm

   1 package config;
   2
   3 use strict;
   4
   5 use setup qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
   6
   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
   8 require Exporter;
   9
  10 @ISA = qw(Exporter);
  11 @EXPORT = qw(
  12     &file_absolutize &file_normalize
  13     &file_directory
  14     &file_type &files_filter
  15     &file_skip &files_skip
  16     &get_api_files &get_c_files &get_h_files &get_spec_files
  17 );
  18 @EXPORT_OK = qw(
  19     $current_dir $wine_dir $winapi_dir $winapi_check_dir
  20 );
  21
  22 use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
  23
  24 use output qw($output);
  25
  26 use File::Find;
  27
  28 sub file_type {
  29     local $_ = shift;
  30
  31     $_ = file_absolutize($_);
  32
  33     m%^(?:libtest|rc|server|tests|tools)/% && return "";
  34     m%^(?:programs|debugger|miscemu)/% && return "wineapp";
  35     m%^(?:library|tsx11|unicode)/% && return "library";
  36     m%^windows/x11drv/wineclipsrv\.c$% && return "application";
  37
  38     return "winelib";
  39 }
  40
  41 sub files_filter {
  42     my $type = shift;
  43
  44     my @files;
  45     foreach my $file (@_) {
  46         if(file_type($file) eq $type) {
  47             push @files, $file;
  48         }
  49     }
  50
  51     return @files;
  52 }
  53
  54 sub file_skip {
  55     local $_ = shift;
  56
  57     $_ = file_absolutize($_);
  58
  59     m%^(?:libtest|programs|rc|server|tests|tools)/% && return 1;
  60     m%^(?:debugger|miscemu|tsx11|server|unicode)/% && return 1;
  61     m%^dlls/wineps/data/% && return 1;
  62     m%^windows/x11drv/wineclipsrv\.c$% && return 1;
  63     m%^dlls/winmm/wineoss/midipatch\.c$% && return 1;
  64     m%(?:glue|spec)\.c$% && return 1;
  65
  66     return 0;
  67 }
  68
  69 sub files_skip {
  70     my @files;
  71     foreach my $file (@_) {
  72         if(!file_skip($file)) {
  73             push @files, $file;
  74         }
  75     }
  76
  77     return @files;
  78 }
  79
  80 sub file_absolutize {
  81     local $_ = shift;
  82
  83     $_ = file_normalize($_);
  84     if(!s%^$wine_dir/%%) {
  85         $_ = "$current_dir/$_";
  86     }
  87     s%^\./%%;
  88
  89     return $_;
  90 }
  91
  92 sub file_normalize {
  93     local $_ = shift;
  94
  95     foreach my $dir (split(m%/%, $current_dir)) {
  96         if(s%^(\.\./)*\.\./$dir/%%) {
  97             if(defined($1)) {
  98                 $_ = "$1$_";
  99             }
 100         }
 101     }
 102
 103     while(m%^(.*?)([^/\.]+)/\.\./(.*?)$%) {
 104         if($2 ne "." && $2 ne "..") {
 105             $_ = "$1$3";
 106         }
 107     }
 108
 109     return $_;
 110 }
 111
 112 sub file_directory {
 113     my $file = shift;
 114     $file =~ s%^./%%;
 115
 116     my $dir = $file;
 117     $dir =~ s%/?[^/]*$%%;
 118     if(!$dir) {
 119         $dir = ".";
 120     }
 121
 122     return $dir;
 123 }
 124
 125 sub _get_files {
 126     my $extension = shift;
 127     my $type = shift;
 128     my $dir = shift;
 129
 130     $output->progress("$wine_dir: searching for *.$extension");
 131
 132     if(!defined($dir)) {
 133         $dir = $wine_dir;
 134     }
 135
 136     my @files;
 137
 138     my @dirs = ($dir);
 139     while(defined(my $dir = shift @dirs)) {
 140         opendir(DIR, $dir);
 141         my @entries= readdir(DIR);
 142         closedir(DIR);
 143         foreach (@entries) {
 144             $_ = "$dir/$_";
 145             if(/\.\.?$/) {
 146                 # Nothing
 147             } elsif(-d $_) {
 148                 push @dirs, $_;
 149             } elsif(/\.$extension$/ && (!defined($type) || file_type($_) eq $type)) {
 150                 s%^$wine_dir/%%;
 151                 push @files, $_;
 152             }
 153         }
 154     }
 155
 156     return @files;
 157 }
 158
 159 sub get_api_files {
 160     my $name = shift;
 161     return _get_files("api", undef, "$winapi_check_dir/$name");
 162 }
 163 sub get_c_files { return _get_files("c", @_); }
 164 sub get_h_files { return _get_files("h", @_); }
 165 sub get_spec_files { return _get_files("spec", @_); }
 166
 167 1;