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