This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change $ALIAS from 'my' to 'our'
[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
a65c06db
SM
16);
17
f3aadd09
SM
18=head1 NAME
19
20ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
21
22=head1 SYNOPSIS
23
24 use ExtUtils::ParseXS::Utilities qw(
25 standard_typemap_locations
1d40e528 26 trim_whitespace
73e91d5a 27 tidy_type
f3aadd09
SM
28 );
29
30=head1 SUBROUTINES
31
32The following functions are not considered to be part of the public interface.
33They are documented here for the benefit of future maintainers of this module.
34
35=head2 C<standard_typemap_locations()>
36
37=over 4
38
39=item * Purpose
40
41Provide a list of filepaths where F<typemap> files may be found. The
42filepaths -- relative paths to files (not just directory paths) -- appear in this list in lowest-to-highest priority.
43
44The highest priority is to look in the current directory.
45
46 'typemap'
47
48The second and third highest priorities are to look in the parent of the
49current directory and a directory called F<lib/ExtUtils> underneath the parent
50directory.
51
52 '../typemap',
53 '../lib/ExtUtils/typemap',
54
55The fourth through ninth highest priorities are to look in the corresponding
56grandparent, great-grandparent and great-great-grandparent directories.
57
58 '../../typemap',
59 '../../lib/ExtUtils/typemap',
60 '../../../typemap',
61 '../../../lib/ExtUtils/typemap',
62 '../../../../typemap',
63 '../../../../lib/ExtUtils/typemap',
64
65The tenth and subsequent priorities are to look in directories named
66F<ExtUtils> which are subdirectories of directories found in C<@INC> --
67I<provided> a file named F<typemap> actually exists in such a directory.
68Example:
69
70 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
71
72However, these filepaths appear in the list returned by
73C<standard_typemap_locations()> in reverse order, I<i.e.>, lowest-to-highest.
74
75 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
76 '../../../../lib/ExtUtils/typemap',
77 '../../../../typemap',
78 '../../../lib/ExtUtils/typemap',
79 '../../../typemap',
80 '../../lib/ExtUtils/typemap',
81 '../../typemap',
82 '../lib/ExtUtils/typemap',
83 '../typemap',
84 'typemap'
85
86=item * Arguments
87
88 my @stl = standard_typemap_locations( \@INC );
89
90Reference to C<@INC>.
91
92=item * Return Value
93
94Array holding list of directories to be searched for F<typemap> files.
95
96=back
97
98=cut
99
a65c06db
SM
100sub standard_typemap_locations {
101 my $include_ref = shift;
a65c06db
SM
102 my @tm = qw(typemap);
103
f3aadd09
SM
104 my $updir = File::Spec->updir();
105 foreach my $dir (
106 File::Spec->catdir(($updir) x 1),
107 File::Spec->catdir(($updir) x 2),
108 File::Spec->catdir(($updir) x 3),
109 File::Spec->catdir(($updir) x 4),
110 ) {
a65c06db
SM
111 unshift @tm, File::Spec->catfile($dir, 'typemap');
112 unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
113 }
114 foreach my $dir (@{ $include_ref}) {
115 my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
116 unshift @tm, $file if -e $file;
117 }
118 return @tm;
119}
120
1d40e528
JK
121=head2 C<trim_whitespace()>
122
123=over 4
124
125=item * Purpose
126
127Perform an in-place trimming of leading and trailing whitespace from the
128first argument provided to the function.
129
130=item * Argument
131
132 trim_whitespace($arg);
133
134=item * Return Value
135
136None. Remember: this is an I<in-place> modification of the argument.
137
138=back
139
140=cut
141
142sub trim_whitespace {
143 $_[0] =~ s/^\s+|\s+$//go;
144}
145
73e91d5a
JK
146=head2 C<tidy_type()>
147
148=over 4
149
150=item * Purpose
151
152Rationalize any asterisks (C<*>) by joining them into bunches, removing
153interior whitespace, then trimming leading and trailing whitespace.
154
155=item * Arguments
156
157 ($ret_type) = tidy_type($_);
158
159String to be cleaned up.
160
161=item * Return Value
162
163String cleaned up.
164
165=back
166
167=cut
168
169sub tidy_type {
170 local ($_) = @_;
171
172 # rationalise any '*' by joining them into bunches and removing whitespace
173 s#\s*(\*+)\s*#$1#g;
174 s#(\*+)# $1 #g;
175
176 # change multiple whitespace into a single space
177 s/\s+/ /g;
178
179 # trim leading & trailing whitespace
180 trim_whitespace($_);
181
182 $_;
183}
184
c1e43162
JK
185=head2 C<C_string()>
186
187=over 4
188
189=item * Purpose
190
191Escape backslashes (C<\>) in prototype strings.
192
193=item * Arguments
194
195 $ProtoThisXSUB = C_string($_);
196
197String needing escaping.
198
199=item * Return Value
200
201Properly escaped string.
202
203=back
204
205=cut
206
207sub C_string {
208 my($string) = @_;
209
210 $string =~ s[\\][\\\\]g;
211 $string;
212}
213
547742ac
JK
214=head2 C<valid_proto_string()>
215
216=over 4
217
218=item * Purpose
219
220Validate prototype string.
221
222=item * Arguments
223
224String needing checking.
225
226=item * Return Value
227
228Upon success, returns the same string passed as argument.
229
230Upon failure, returns C<0>.
231
232=back
233
234=cut
235
236sub valid_proto_string {
237 my($string) = @_;
238
239 if ( $string =~ /^$ExtUtils::ParseXS::Constants::proto_re+$/ ) {
240 return $string;
241 }
242
243 return 0;
244}
a65c06db 2451;