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