This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move code handling processing of typemap files to Utilities.pm.
[perl5.git] / dist / ExtUtils-ParseXS / lib / ExtUtils / ParseXS / Utilities.pm
CommitLineData
a65c06db
SM
1package ExtUtils::ParseXS::Utilities;
2use strict;
3use warnings;
4use Exporter;
f3aadd09 5use File::Spec;
547742ac
JK
6use lib qw( lib );
7use ExtUtils::ParseXS::Constants ();
a65c06db
SM
8our (@ISA, @EXPORT_OK);
9@ISA = qw(Exporter);
10@EXPORT_OK = qw(
11 standard_typemap_locations
1d40e528 12 trim_whitespace
73e91d5a 13 tidy_type
c1e43162 14 C_string
547742ac 15 valid_proto_string
50b96cc2 16 process_typemaps
a65c06db
SM
17);
18
f3aadd09
SM
19=head1 NAME
20
21ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
22
23=head1 SYNOPSIS
24
25 use ExtUtils::ParseXS::Utilities qw(
26 standard_typemap_locations
1d40e528 27 trim_whitespace
73e91d5a 28 tidy_type
f3aadd09
SM
29 );
30
31=head1 SUBROUTINES
32
33The following functions are not considered to be part of the public interface.
34They are documented here for the benefit of future maintainers of this module.
35
36=head2 C<standard_typemap_locations()>
37
38=over 4
39
40=item * Purpose
41
42Provide a list of filepaths where F<typemap> files may be found. The
43filepaths -- relative paths to files (not just directory paths) -- appear in this list in lowest-to-highest priority.
44
45The highest priority is to look in the current directory.
46
47 'typemap'
48
49The second and third highest priorities are to look in the parent of the
50current directory and a directory called F<lib/ExtUtils> underneath the parent
51directory.
52
53 '../typemap',
54 '../lib/ExtUtils/typemap',
55
56The fourth through ninth highest priorities are to look in the corresponding
57grandparent, great-grandparent and great-great-grandparent directories.
58
59 '../../typemap',
60 '../../lib/ExtUtils/typemap',
61 '../../../typemap',
62 '../../../lib/ExtUtils/typemap',
63 '../../../../typemap',
64 '../../../../lib/ExtUtils/typemap',
65
66The tenth and subsequent priorities are to look in directories named
67F<ExtUtils> which are subdirectories of directories found in C<@INC> --
68I<provided> a file named F<typemap> actually exists in such a directory.
69Example:
70
71 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
72
73However, these filepaths appear in the list returned by
74C<standard_typemap_locations()> in reverse order, I<i.e.>, lowest-to-highest.
75
76 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
77 '../../../../lib/ExtUtils/typemap',
78 '../../../../typemap',
79 '../../../lib/ExtUtils/typemap',
80 '../../../typemap',
81 '../../lib/ExtUtils/typemap',
82 '../../typemap',
83 '../lib/ExtUtils/typemap',
84 '../typemap',
85 'typemap'
86
87=item * Arguments
88
89 my @stl = standard_typemap_locations( \@INC );
90
91Reference to C<@INC>.
92
93=item * Return Value
94
95Array holding list of directories to be searched for F<typemap> files.
96
97=back
98
99=cut
100
a65c06db
SM
101sub standard_typemap_locations {
102 my $include_ref = shift;
a65c06db
SM
103 my @tm = qw(typemap);
104
f3aadd09
SM
105 my $updir = File::Spec->updir();
106 foreach my $dir (
107 File::Spec->catdir(($updir) x 1),
108 File::Spec->catdir(($updir) x 2),
109 File::Spec->catdir(($updir) x 3),
110 File::Spec->catdir(($updir) x 4),
111 ) {
a65c06db
SM
112 unshift @tm, File::Spec->catfile($dir, 'typemap');
113 unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
114 }
115 foreach my $dir (@{ $include_ref}) {
116 my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
117 unshift @tm, $file if -e $file;
118 }
119 return @tm;
120}
121
1d40e528
JK
122=head2 C<trim_whitespace()>
123
124=over 4
125
126=item * Purpose
127
128Perform an in-place trimming of leading and trailing whitespace from the
129first argument provided to the function.
130
131=item * Argument
132
133 trim_whitespace($arg);
134
135=item * Return Value
136
137None. Remember: this is an I<in-place> modification of the argument.
138
139=back
140
141=cut
142
143sub trim_whitespace {
144 $_[0] =~ s/^\s+|\s+$//go;
145}
146
73e91d5a
JK
147=head2 C<tidy_type()>
148
149=over 4
150
151=item * Purpose
152
153Rationalize any asterisks (C<*>) by joining them into bunches, removing
154interior whitespace, then trimming leading and trailing whitespace.
155
156=item * Arguments
157
158 ($ret_type) = tidy_type($_);
159
160String to be cleaned up.
161
162=item * Return Value
163
164String cleaned up.
165
166=back
167
168=cut
169
170sub tidy_type {
171 local ($_) = @_;
172
173 # rationalise any '*' by joining them into bunches and removing whitespace
174 s#\s*(\*+)\s*#$1#g;
175 s#(\*+)# $1 #g;
176
177 # change multiple whitespace into a single space
178 s/\s+/ /g;
179
180 # trim leading & trailing whitespace
181 trim_whitespace($_);
182
183 $_;
184}
185
c1e43162
JK
186=head2 C<C_string()>
187
188=over 4
189
190=item * Purpose
191
192Escape backslashes (C<\>) in prototype strings.
193
194=item * Arguments
195
196 $ProtoThisXSUB = C_string($_);
197
198String needing escaping.
199
200=item * Return Value
201
202Properly escaped string.
203
204=back
205
206=cut
207
208sub C_string {
209 my($string) = @_;
210
211 $string =~ s[\\][\\\\]g;
212 $string;
213}
214
547742ac
JK
215=head2 C<valid_proto_string()>
216
217=over 4
218
219=item * Purpose
220
221Validate prototype string.
222
223=item * Arguments
224
225String needing checking.
226
227=item * Return Value
228
229Upon success, returns the same string passed as argument.
230
231Upon failure, returns C<0>.
232
233=back
234
235=cut
236
237sub valid_proto_string {
238 my($string) = @_;
239
240 if ( $string =~ /^$ExtUtils::ParseXS::Constants::proto_re+$/ ) {
241 return $string;
242 }
243
244 return 0;
245}
50b96cc2
JK
246
247=head2 C<process_typemaps()>
248
249=over 4
250
251=item * Purpose
252
253Process all typemap files.
254
255=item * Arguments
256
257 my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
258 process_typemaps( $args{typemap}, $pwd );
259
260List of two elements: C<typemap> element from C<%args>; current working
261directory.
262
263=item * Return Value
264
265Upon success, returns a list of four hash references. (This will probably be
266refactored.)
267
268=back
269
270=cut
271
272sub process_typemaps {
273 my ($tmap, $pwd) = @_;
274
275 my @tm = ref $tmap ? @{$tmap} : ($tmap);
276
277 foreach my $typemap (@tm) {
278 die "Can't find $typemap in $pwd\n" unless -r $typemap;
279 }
280
281 push @tm, standard_typemap_locations( \@INC );
282
283 my (%type_kind, %proto_letter, %input_expr, %output_expr);
284
285 foreach my $typemap (@tm) {
286 next unless -f $typemap;
287 # skip directories, binary files etc.
288 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
289 unless -T $typemap;
290 open my $TYPEMAP, '<', $typemap
291 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
292 my $mode = 'Typemap';
293 my $junk = "";
294 my $current = \$junk;
295 while (<$TYPEMAP>) {
296 next if /^\s*#/;
297 if (/^INPUT\s*$/) {
298 $mode = 'Input'; $current = \$junk; next;
299 }
300 if (/^OUTPUT\s*$/) {
301 $mode = 'Output'; $current = \$junk; next;
302 }
303 if (/^TYPEMAP\s*$/) {
304 $mode = 'Typemap'; $current = \$junk; next;
305 }
306 if ($mode eq 'Typemap') {
307 chomp;
308 my $line = $_;
309 trim_whitespace($_);
310 # skip blank lines and comment lines
311 next if /^$/ or /^#/;
312 my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::proto_re*)\s*$/ or
313 warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
314 $type = tidy_type($type);
315 $type_kind{$type} = $kind;
316 # prototype defaults to '$'
317 $proto = "\$" unless $proto;
318 warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
319 unless valid_proto_string($proto);
320 $proto_letter{$type} = C_string($proto);
321 }
322 elsif (/^\s/) {
323 $$current .= $_;
324 }
325 elsif ($mode eq 'Input') {
326 s/\s+$//;
327 $input_expr{$_} = '';
328 $current = \$input_expr{$_};
329 }
330 else {
331 s/\s+$//;
332 $output_expr{$_} = '';
333 $current = \$output_expr{$_};
334 }
335 }
336 close $TYPEMAP;
337 }
338 return (\%type_kind, \%proto_letter, \%input_expr, \%output_expr);
339}
340
a65c06db 3411;