config.pm 3.57 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# 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 20 21
package config;

use strict;
22
use warnings 'all';
23

24
use setup qw($current_dir $wine_dir $winapi_dir);
25 26 27 28 29 30

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(
31 32 33 34 35 36 37 38
    file_absolutize file_normalize
    file_directory
    file_type files_filter
    file_skip files_skip
    get_c_files
    get_h_files
    get_makefile_in_files
    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 49
use File::Find;

50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
sub file_normalize($) {
    local $_ = shift;

    foreach my $dir (split(m%/%, $current_dir)) {
	if(s%^(\.\./)*\.\./$dir/%%) {
	    if(defined($1)) {
		$_ = "$1$_";
	    }
	}
    }

    while(m%^(.*?)([^/\.]+)/\.\./(.*?)$%) {
	if($2 ne "." && $2 ne "..") {
	    $_ = "$1$3";
	}
    }

    return $_;
}

sub file_absolutize($) {
    local $_ = shift;

    $_ = file_normalize($_);
    if(!s%^$wine_dir/%%) {
	$_ = "$current_dir/$_";
    }
    s%^\./%%;

    return $_;
}

sub file_type($) {
83
    local $_ = shift;
84

85
    $_ = file_absolutize($_);
86

87 88
    m%^(?:server|tests|tools)/% && return "";
    m%^(?:programs)/% && return "wineapp";
Patrik Stridvall's avatar
Patrik Stridvall committed
89
    m%^(?:libs)/% && return "library";
90

91 92 93
    return "winelib";
}

94
sub files_filter($@) {
95 96 97 98 99 100 101
    my $type = shift;

    my @files;
    foreach my $file (@_) {
	if(file_type($file) eq $type) {
	    push @files, $file;
	}
102
    }
103 104

    return @files;
105 106
}

107
sub file_skip($) {
108 109
    local $_ = shift;

110
    $_ = file_absolutize($_);
111

112 113
    m%^(?:dlls|include)/% || return 1;
    m%^dlls/wineps\.drv/data/% && return 1;
114 115 116
    return 0;
}

117
sub files_skip(@) {
118 119 120 121 122 123 124 125 126 127
    my @files;
    foreach my $file (@_) {
	if(!file_skip($file)) {
	    push @files, $file;
	}
    }

    return @files;
}

128
sub file_directory($) {
Patrik Stridvall's avatar
Patrik Stridvall committed
129
    local $_ = shift;
130

Patrik Stridvall's avatar
Patrik Stridvall committed
131 132 133
    s%/?[^/]*$%%;
    if(!$_) {
	$_ = ".";
134
    }
Patrik Stridvall's avatar
Patrik Stridvall committed
135 136 137 138

    s%^(?:\./)?(.*?)(?:/\.)?%$1%;

    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 149 150 151 152 153 154 155
    if(!defined($dir)) {
	$dir = $wine_dir;
    }

    my @files;

    my @dirs = ($dir);
    while(defined(my $dir = shift @dirs)) {
156
	opendir(DIR, $dir) || die "Can't open directory $dir: $!\n";
157 158 159
	my @entries= readdir(DIR);
	closedir(DIR);
	foreach (@entries) {
160
	    my $basefile = $_;
161
	    $_ = "$dir/$_";
162 163 164 165
	    if(/\.\.?$/) {
		# Nothing
	    } elsif(-d $_) {
		push @dirs, $_;
166
	    } elsif($basefile =~ /$pattern/ && (!defined($type) || file_type($_) eq $type)) {
167 168 169
		s%^$wine_dir/%%;
		push @files, $_;
	    }
170
	}
171
    }
172

173
    return @files;
174 175
}

176 177 178 179
sub get_c_files($;$) { return _get_files('\.c$', $_[0], $_[1]); }
sub get_h_files($;$) { return _get_files('\.h$', $_[0], $_[1]); }
sub get_spec_files($;$) { return _get_files('\.spec$', $_[0], $_[1]); }
sub get_makefile_in_files($;$) { return _get_files('^Makefile.in$', $_[0], $_[1]); }
180

181
1;