Sweden-Number/tools/winapi/config.pm

186 lines
3.8 KiB
Perl
Raw Normal View History

#
# 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
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
package config;
use strict;
use setup qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
2001-07-11 19:27:45 +02:00
&file_absolutize &file_normalize
&file_directory
2001-06-21 00:53:21 +02:00
&file_type &files_filter
&file_skip &files_skip
&get_api_files &get_c_files &get_h_files &get_spec_files
);
@EXPORT_OK = qw(
$current_dir $wine_dir $winapi_dir $winapi_check_dir
);
use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
use output qw($output);
2001-07-11 19:27:45 +02:00
use File::Find;
sub file_type {
2001-06-21 00:53:21 +02:00
local $_ = shift;
2001-06-21 00:53:21 +02:00
$_ = file_absolutize($_);
2001-06-21 00:53:21 +02:00
m%^(?:libtest|rc|server|tests|tools)/% && return "";
m%^(?:programs|debugger|miscemu)/% && return "wineapp";
m%^(?:library|tsx11|unicode)/% && return "library";
m%^windows/x11drv/wineclipsrv\.c$% && return "application";
2001-06-21 00:53:21 +02:00
return "winelib";
}
sub files_filter {
my $type = shift;
my @files;
foreach my $file (@_) {
if(file_type($file) eq $type) {
push @files, $file;
}
}
2001-06-21 00:53:21 +02:00
return @files;
}
sub file_skip {
local $_ = shift;
2001-06-21 00:53:21 +02:00
$_ = file_absolutize($_);
m%^(?:libtest|programs|rc|server|tests|tools)/% && return 1;
m%^(?:debugger|miscemu|tsx11|server|unicode)/% && return 1;
m%^dlls/wineps/data/% && return 1;
m%^windows/x11drv/wineclipsrv\.c$% && return 1;
m%^dlls/winmm/wineoss/midipatch\.c$% && return 1;
m%(?:glue|spec)\.c$% && return 1;
return 0;
}
sub files_skip {
my @files;
foreach my $file (@_) {
if(!file_skip($file)) {
push @files, $file;
}
}
return @files;
}
2001-06-21 00:53:21 +02:00
sub file_absolutize {
local $_ = shift;
$_ = file_normalize($_);
if(!s%^$wine_dir/%%) {
$_ = "$current_dir/$_";
}
s%^\./%%;
return $_;
}
2001-06-19 05:34:39 +02:00
sub file_normalize {
local $_ = shift;
foreach my $dir (split(m%/%, $current_dir)) {
2001-07-29 22:19:14 +02:00
if(s%^(\.\./)*\.\./$dir/%%) {
if(defined($1)) {
$_ = "$1$_";
}
}
}
while(m%^(.*?)([^/\.]+)/\.\./(.*?)$%) {
if($2 ne "." && $2 ne "..") {
$_ = "$1$3";
2001-06-19 05:34:39 +02:00
}
}
return $_;
}
sub file_directory {
2001-07-30 20:49:10 +02:00
local $_ = shift;
2001-07-30 20:49:10 +02:00
s%/?[^/]*$%%;
if(!$_) {
$_ = ".";
}
2001-07-30 20:49:10 +02:00
s%^(?:\./)?(.*?)(?:/\.)?%$1%;
return $_;
}
2001-07-18 22:09:12 +02:00
sub _get_files {
my $extension = shift;
my $type = shift;
my $dir = shift;
2001-07-18 22:09:12 +02:00
$output->progress("$wine_dir: searching for *.$extension");
if(!defined($dir)) {
$dir = $wine_dir;
}
my @files;
my @dirs = ($dir);
while(defined(my $dir = shift @dirs)) {
opendir(DIR, $dir);
my @entries= readdir(DIR);
closedir(DIR);
foreach (@entries) {
2002-06-01 04:55:48 +02:00
$_ = "$dir/$_";
if(/\.\.?$/) {
# Nothing
} elsif(-d $_) {
push @dirs, $_;
} elsif(/\.$extension$/ && (!defined($type) || file_type($_) eq $type)) {
s%^$wine_dir/%%;
push @files, $_;
}
}
}
2001-07-18 22:09:12 +02:00
return @files;
}
2002-06-01 04:55:48 +02:00
sub get_api_files {
my $name = shift;
return _get_files("api", undef, "$winapi_check_dir/$name");
}
2001-07-18 22:09:12 +02:00
sub get_c_files { return _get_files("c", @_); }
sub get_h_files { return _get_files("h", @_); }
sub get_spec_files { return _get_files("spec", @_); }
1;