Small char -> const char fix.
[wine] / 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_normalize($) {
50     local $_ = shift;
51
52     foreach my $dir (split(m%/%, $current_dir)) {
53         if(s%^(\.\./)*\.\./$dir/%%) {
54             if(defined($1)) {
55                 $_ = "$1$_";
56             }
57         }
58     }
59
60     while(m%^(.*?)([^/\.]+)/\.\./(.*?)$%) {
61         if($2 ne "." && $2 ne "..") {
62             $_ = "$1$3";
63         }
64     }
65
66     return $_;
67 }
68
69 sub file_absolutize($) {
70     local $_ = shift;
71
72     $_ = file_normalize($_);
73     if(!s%^$wine_dir/%%) {
74         $_ = "$current_dir/$_";
75     }
76     s%^\./%%;
77
78     return $_;
79 }
80
81 sub file_type($) {
82     local $_ = shift;
83
84     $_ = file_absolutize($_);
85
86     m%^(?:libtest|rc|server|tests|tools)/% && return "";
87     m%^(?:programs|debugger|miscemu)/% && return "wineapp";
88     m%^(?:libs)/% && return "library";
89     m%^windows/x11drv/wineclipsrv\.c$% && return "application";
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%^(?:libtest|programs|rc|server|tests|tools)/% && return 1;
113     m%^(?:debugger|miscemu|libs|server)/% && return 1;
114     m%^dlls/wineps/data/% && return 1;
115     m%^windows/x11drv/wineclipsrv\.c$% && return 1;
116     m%^dlls/winmm/wineoss/midipatch\.c$% && return 1;
117     m%(?:glue|spec)\.c$% && return 1;
118
119     return 0;
120 }
121
122 sub files_skip(@) {
123     my @files;
124     foreach my $file (@_) {
125         if(!file_skip($file)) {
126             push @files, $file;
127         }
128     }
129
130     return @files;
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$', $_[0], $_[1]); }
182 sub get_h_files($;$) { return _get_files('\.h$', $_[0], $_[1]); }
183 sub get_spec_files($;$) { return _get_files('\.spec$', $_[0], $_[1]); }
184 sub get_makefile_in_files($;$) { return _get_files('^Makefile.in$', $_[0], $_[1]); }
185
186 1;