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