File Coverage

blib/lib/InlineX/CPP2XS.pm
Criterion Covered Total %
statement 344 382 90.0
branch 161 214 75.2
condition 19 24 79.1
subroutine 12 12 100.0
pod 0 2 0.0
total 536 634 84.5


line stmt bran cond sub pod time code
1             package InlineX::CPP2XS;
2 11     11   5965 use warnings;
  11         14  
  11         294  
3 11     11   37 use strict;
  11         13  
  11         190  
4 11     11   34 use Config;
  11         12  
  11         16390  
5              
6             require Exporter;
7             our @ISA = qw(Exporter);
8              
9             our @EXPORT_OK = qw(cpp2xs);
10              
11             our $VERSION = '0.25';
12             #$VERSION = eval $VERSION;
13              
14             my $config_options;
15              
16             our @allowable_config_keys = ('AUTOWRAP', 'AUTO_INCLUDE', 'CODE', 'DIST', 'TYPEMAPS', 'LIBS', 'INC',
17             'WRITE_MAKEFILE_PL', 'BUILD_NOISY', 'BOOT', 'BOOT_F', 'EXPORT_ALL', 'EXPORT_OK_ALL',
18             'EXPORT_TAGS_ALL', 'MAKE', 'PREFIX', 'PREREQ_PM', 'CCFLAGS', 'CCFLAGSEX', 'LD', 'LDDLFLAGS',
19             'MYEXTLIB', 'OPTIMIZE', 'PRE_HEAD', 'CC', 'SRC_LOCATION', 'T', '_TESTING', 'USE', 'USING',
20             'WRITE_PM', 'VERSION', 'MANIF');
21              
22             ##=========================##
23              
24             sub cpp2xs {
25             ## This is basically just a copy'n'paste of the InlineX::C2XS::c2xs() function,
26             ## with all occurrences of "C" changed to "CPP" ... clever, eh ??
27 19     19 0 107606 eval {require "Inline/CPP.pm"};
  19         6054  
28 19 50 33     880352 if($@ || $Inline::CPP::VERSION < 0.39) {die "Need a functioning Inline::CPP (version 0.39 or later). $@"}
  0         0  
29 19         44 my $module = shift;
30 19         27 my $pkg = shift;
31              
32             # Set the default for $build_dir.
33             # (This will be overwritten by the build_dir argument in @_, if supplied.)
34 19         35 my $build_dir = '.';
35              
36              
37 19 100       75 if(@_) {
38 18 100       65 if(ref($_[0]) eq "HASH") {
39 6         8 $config_options = shift;
40 6 100       14 if(@_) {die "Incorrect usage - there should be no arguments to cpp2xs() after the hash reference"}
  1         4  
41             # Check for invalid config options - and die if one is found
42 5 100       12 for(keys(%$config_options)) { die "$_ is an invalid config option" if !_check_config_keys($_)}
  7         12  
43             }
44 12         28 else {$build_dir = shift}
45             }
46              
47 17 100       50 if(@_) {
48 11 100       45 if(ref($_[0]) ne "HASH") {die "Fourth arg to cpp2xs() needs to be a hash containing config options ... but it's not !!\n"}
  1         6  
49 10         15 $config_options = shift;
50             # Check for invalid config options - and die if one is found
51 10 50       58 for(keys(%$config_options)) { die "$_ is an invalid config option" if !_check_config_keys($_)}
  62         90  
52             }
53              
54 16 100       201 unless(-d $build_dir) {
55 1         6 die "$build_dir is not a valid directory";
56             }
57 15         69 my $modfname = (split /::/, $module)[-1];
58 15 100       53 my $need_inline_h = $config_options->{AUTOWRAP} ? 1 : 0;
59 15         28 my $code = '';
60 15         20 my $o;
61              
62 15 100 66     51 if(exists($config_options->{CODE}) && exists($config_options->{SRC_LOCATION})) {
63 1         4 die "You can provide either CODE *or* SRC_LOCATION arguments ... but not *both*";
64             }
65              
66 14 50 66     42 if(exists($config_options->{BOOT}) && exists($config_options->{BOOT_F})) {
67 0         0 die "You can provide either BOOT *or* BOOT_F arguments ... but not *both*";
68             }
69              
70 14 100       53 if(exists($config_options->{CODE})) {
    100          
71 2         5 $code = $config_options->{CODE};
72 2 50       11 if($code =~ /inline_stack_vars/i) {$need_inline_h = 1 }
  0         0  
73             }
74             elsif(exists($config_options->{SRC_LOCATION})) {
75 5 100       153 open(RD, "<", $config_options->{SRC_LOCATION}) or die "Can't open ", $config_options->{SRC_LOCATION}, " for reading: $!";
76 4         53 while() {
77 454         298 $code .= $_;
78 454 50       863 if($_ =~ /inline_stack_vars/i) {$need_inline_h = 1}
  0         0  
79             }
80 4 50       35 close(RD) or die "Can't close ", $config_options->{SRC_LOCATION}, " after reading: $!";
81             }
82             else {
83 7 50       148 open(RD, "<", "src/$modfname.cpp") or die "Can't open src/${modfname}.cpp for reading: $!";
84 7         63 while() {
85 63         58 $code .= $_;
86 63 100       150 if($_ =~ /inline_stack_vars/i) {$need_inline_h = 1}
  2         5  
87             }
88 7 50       47 close(RD) or die "Can't close src/$modfname.cpp after reading: $!";
89             }
90              
91             ## Initialise $o.
92             ## Many of these keys may not be needed for the purpose of this
93             ## specific exercise - but they shouldn't do any harm, so I'll
94             ## leave them in, just in case they're ever needed.
95 13         47 $o->{CONFIG}{BUILD_TIMERS} = 0;
96 13         29 $o->{CONFIG}{PRINT_INFO} = 0;
97 13         35 $o->{CONFIG}{USING} = [];
98 13         29 $o->{CONFIG}{WARNINGS} = 1;
99 13         24 $o->{CONFIG}{PRINT_VERSION} = 0;
100 13         28 $o->{CONFIG}{CLEAN_BUILD_AREA} = 0;
101 13         25 $o->{CONFIG}{GLOBAL_LOAD} = 0;
102 13         116 $o->{CONFIG}{DIRECTORY} = '';
103 13         39 $o->{CONFIG}{SAFEMODE} = -1;
104 13         24 $o->{CONFIG}{CLEAN_AFTER_BUILD} = 1;
105 13         56 $o->{CONFIG}{FORCE_BUILD} = 0;
106 13         32 $o->{CONFIG}{NAME} = '';
107 13         23 $o->{CONFIG}{_INSTALL_} = 0;
108 13         24 $o->{CONFIG}{WITH} = [];
109 13         36 $o->{CONFIG}{AUTONAME} = 1;
110 13         34 $o->{CONFIG}{REPORTBUG} = 0;
111 13         21 $o->{CONFIG}{UNTAINT} = 0;
112 13         26 $o->{CONFIG}{VERSION} = '';
113 13         20 $o->{CONFIG}{BUILD_NOISY} = 1;
114 13         180 $o->{INLINE}{ILSM_suffix} = $Config::Config{dlext};
115 13         37 $o->{INLINE}{ILSM_module} = 'Inline::CPP';
116 13         27 $o->{INLINE}{version} = $Inline::VERSION;
117 13         28 $o->{INLINE}{ILSM_type} = 'compiled';
118 13         19 $o->{INLINE}{DIRECTORY} = 'irrelevant_0';
119 13         28 $o->{INLINE}{object_ready} = 0;
120 13         23 $o->{INLINE}{md5} = 'irrelevant_1';
121 13         33 $o->{API}{modfname} = $modfname;
122 13         24 $o->{API}{script} = 'irrelevant_2';
123 13         25 $o->{API}{location} = 'irrelevant_3';
124 13         21 $o->{API}{language} = 'CPP';
125 13         26 $o->{API}{modpname} = 'irrelevant_4';
126 13         22 $o->{API}{directory} = 'irrelevant_5';
127 13         23 $o->{API}{install_lib} = 'irrelevant_6';
128 13         30 $o->{API}{build_dir} = $build_dir;
129 13         22 $o->{API}{language_id} = 'CPP';
130 13         22 $o->{API}{pkg} = $pkg;
131 13         57 $o->{API}{suffix} = $Config::Config{dlext};
132 13         28 $o->{API}{cleanup} = 1;
133 13         25 $o->{API}{module} = $module;
134 13         41 $o->{API}{code} = $code;
135              
136 13 100       42 if(exists($config_options->{BUILD_NOISY})) {$o->{CONFIG}{BUILD_NOISY} = $config_options->{BUILD_NOISY}}
  1         2  
137              
138 13 100       41 if($config_options->{DIST}) {
139 1         2 $config_options->{WRITE_MAKEFILE_PL} = 'P';
140 1         2 $config_options->{WRITE_PM} = 1;
141 1         1 $config_options->{MANIF} = 1;
142 1         3 $config_options->{T} = 1;
143             }
144              
145 13 100       35 if($config_options->{AUTOWRAP}) {$o->{ILSM}{AUTOWRAP} = 1}
  6         16  
146              
147 13 100       37 if($config_options->{BOOT}) {$o->{ILSM}{XS}{BOOT} = $config_options->{BOOT}}
  1         3  
148              
149 13 50       45 if($config_options->{BOOT_F}) {
150 0         0 my $code;
151 0 0       0 open(RD, "<", $config_options->{BOOT_F}) or die "Can't open ", $config_options->{BOOT_F}, " for reading: $!";
152 0         0 while() {
153 0         0 $code .= $_;
154 0 0       0 if($_ =~ /inline_stack_vars/i) {$need_inline_h = 1}
  0         0  
155             }
156 0 0       0 close(RD) or die "Can't close ", $config_options->{BOOT_F}, " after reading: $!";
157 0         0 $o->{ILSM}{XS}{BOOT} = $code;
158             }
159              
160             # This is what Inline::C does with the MAKE parameter ... so we'll do the same.
161             # Not sure that this achieves anything in the context of InlineX::CPP2XS.
162 13 100       33 if($config_options->{MAKE}) {$o->{ILSM}{MAKE} = $config_options->{MAKE}}
  1         3  
163              
164 13 100       38 if(exists($config_options->{TYPEMAPS})) {
165 7 100       25 if(ref($config_options->{TYPEMAPS}) eq 'ARRAY') {
166 5         7 for(@{$config_options->{TYPEMAPS}}) {
  5         16  
167 5 100       144 die "Couldn't locate the typemap $_" unless -f $_;
168             }
169 4         15 $o->{ILSM}{MAKEFILE}{TYPEMAPS} = $config_options->{TYPEMAPS};
170             }
171             else {
172 2         7 my @vals = split /\s+/, $config_options->{TYPEMAPS};
173 2         4 for(@vals) {
174 2 50       20 die "Couldn't locate the typemap $_" unless -f $_;
175             }
176 2         8 $o->{ILSM}{MAKEFILE}{TYPEMAPS} = \@vals;
177             }
178             }
179             else {
180 6         31 $o->{ILSM}{MAKEFILE}{TYPEMAPS} = [];
181             }
182              
183 12         18 my @uncorrupted_typemaps = @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}};
  12         34  
184 12         31 push @uncorrupted_typemaps, 'CPP.map';
185              
186 12 100       39 if($config_options->{PREFIX}) {$o->{ILSM}{XS}{PREFIX} = $config_options->{PREFIX}}
  1         2  
187              
188 12         45 bless($o, 'Inline::CPP');
189              
190 12         51 Inline::CPP::validate($o);
191              
192 12 100       660 if($config_options->{LIBS}) {
193 1         1 my @init;
194             my $init;
195 1 50       5 if(ref($o->{ILSM}{MAKEFILE}{LIBS}) eq 'ARRAY') {
196 1         1 @init = @{$o->{ILSM}{MAKEFILE}{LIBS}};
  1         3  
197 1         2 $init = join ' ', @init;
198             }
199 0         0 else {$init = $o->{ILSM}{MAKEFILE}{LIBS};}
200              
201 1         2 my @add;
202             my $add;
203 1 50       3 if(ref($config_options->{LIBS}) eq 'ARRAY') {
204 1         1 @add = @{$config_options->{LIBS}};
  1         2  
205 1         2 $add = join ' ', @add;
206             }
207 0         0 else {$add = $config_options->{LIBS};}
208 1         3 $o->{ILSM}{MAKEFILE}{LIBS} = $init . ' ' . $add;
209             }
210             #else { $o->{ILSM}{MAKEFILE}{LIBS} = []} # We don't want this with Inline::CPP
211             # as it clobbers any setting that was
212             # made by Inline::CPP::validate()
213              
214 12 100       42 if($config_options->{PRE_HEAD}) {
215 2         4 my $v = $config_options->{PRE_HEAD};
216             #{ # open scope
217             # no warnings 'newline';
218 2 100       44 unless( -f $v) {
219 1         55 $o->{ILSM}{AUTO_INCLUDE} = $v . "\n" . $o->{ILSM}{AUTO_INCLUDE};
220             }
221             else {
222 1         1 my $insert;
223 1 50       16 open RD, '<', $v or die "Couldn't open $v for reading: $!";
224 1         8 while() {$insert .= $_}
  5         10  
225 1 50       6 close RD or die "Couldn't close $v after reading: $!";
226 1         6 $o->{ILSM}{AUTO_INCLUDE} = $insert . "\n" . $o->{ILSM}{AUTO_INCLUDE};
227             }
228             #} # close scope
229             }
230              
231 12 100       37 if($config_options->{AUTO_INCLUDE}) {$o->{ILSM}{AUTO_INCLUDE} .= $config_options->{AUTO_INCLUDE} . "\n"}
  6         21  
232              
233 12 100       35 if($config_options->{CC}) {$o->{ILSM}{MAKEFILE}{CC} = $config_options->{CC}}
  1         2  
234              
235 12 100       37 if($config_options->{CCFLAGS}) {$o->{ILSM}{MAKEFILE}{CCFLAGS} = " " . $config_options->{CCFLAGS}}
  1         3  
236              
237 12 50       41 if($config_options->{CCFLAGSEX}) {$o->{ILSM}{MAKEFILE}{CCFLAGS} = $Config{ccflags} . " "
238 0         0 . $config_options->{CCFLAGSEX}}
239              
240 12 100       39 if(exists($config_options->{INC})) {
241 6 50       17 if(ref($config_options->{INC}) eq 'ARRAY') {$o->{ILSM}{MAKEFILE}{INC} = join ' ', @{$config_options->{INC}};}
  0         0  
  0         0  
242 6         17 else {$o->{ILSM}{MAKEFILE}{INC} = $config_options->{INC};}
243             }
244 6         20 else {$o->{ILSM}{MAKEFILE}{INC} = ''}
245              
246 12         31 my $uncorrupted_inc = $o->{ILSM}{MAKEFILE}{INC};
247              
248 12 100       35 if($config_options->{LD}) {$o->{ILSM}{MAKEFILE}{LD} = " " . $config_options->{LD}}
  1         3  
249              
250 12 100       36 if($config_options->{PREREQ_PM}) {$o->{ILSM}{MAKEFILE}{PREREQ_PM} = $config_options->{PREREQ_PM}}
  1         2  
251              
252 12 100       32 if($config_options->{LDDLFLAGS}) {$o->{ILSM}{MAKEFILE}{LDDLFLAGS} = " " . $config_options->{LDDLFLAGS}}
  1         3  
253              
254             # Here, we'll add the MAKE parameter to $o->{ILSM}{MAKEFILE}{MAKE} ... which
255             # could be useful (given that recent versions of Extutils::MakeMaker now recognise it):
256 12 100       32 if($config_options->{MAKE}) {$o->{ILSM}{MAKEFILE}{MAKE} = $config_options->{MAKE}}
  1         3  
257              
258 12 100       33 if($config_options->{MYEXTLIB}) {$o->{ILSM}{MAKEFILE}{MYEXTLIB} = " " . $config_options->{MYEXTLIB}}
  1         2  
259              
260 12 100       35 if($config_options->{OPTIMIZE}) {$o->{ILSM}{MAKEFILE}{OPTIMIZE} = " " . $config_options->{OPTIMIZE}}
  1         3  
261              
262 12 50       33 if($config_options->{USING}) {
263 0         0 my $val = $config_options->{USING};
264 0 0       0 if(ref($val) eq 'ARRAY') {
265 0         0 $o->{CONFIG}{USING} = $val;
266             }
267             else {
268 0         0 $o->{CONFIG}{USING} = [$val];
269             }
270 0         0 Inline::push_overrides($o);
271             }
272              
273 12 100       29 if(!$need_inline_h) {$o->{ILSM}{AUTO_INCLUDE} =~ s/#include "INLINE\.h"//i}
  5         37  
274              
275 12         20 my $portable;
276             {
277 11     11   75 no warnings 'uninitialized';
  11         15  
  11         24553  
  12         13  
278 12 100       56 $portable = uc($config_options->{WRITE_MAKEFILE_PL}) eq 'P' ? 1 : 0;
279             }
280              
281 12         39 _build($o, $need_inline_h, $portable);
282              
283 12 100       1233 if($config_options->{WRITE_MAKEFILE_PL}) {
284 4         17 $o->{ILSM}{MAKEFILE}{INC}= $uncorrupted_inc; # Otherwise cwd is automatically added.
285 4         13 $o->{ILSM}{MAKEFILE}{TYPEMAPS}= \@uncorrupted_typemaps; # Otherwise standard perl typemap is added.
286 4 50       22 if($config_options->{VERSION}) {$o->{API}{version} = $config_options->{VERSION}}
  4         13  
287 0         0 else {warn "'VERSION' being set to '0.00' in the Makefile.PL. Did you supply a correct version number to cpp2xs() ?"}
288 4         11 print "Writing Makefile.PL in the ", $o->{API}{build_dir}, " directory\n";
289 4         15 $o->call('write_Makefile_PL', 'Build Glue 3');
290 4 100       1428 if(uc($config_options->{WRITE_MAKEFILE_PL}) eq 'P') { # Need to rewrite the genrated Makefile.PL
291 1         6 rewrite_makefile_pl($build_dir);
292             }
293             }
294              
295 12 100       50 if($config_options->{WRITE_PM}) {
296 4 50       15 if($config_options->{VERSION}) {$o->{API}{version} = $config_options->{VERSION}}
  4         36  
297             else {
298 0         0 warn "'\$VERSION' being set to '0.00' in ", $o->{API}{modfname}, ".pm. Did you supply a correct version number to cpp2xs() ?";
299 0         0 $o->{API}{version} = '0.00';
300             }
301 4         17 _write_pm($o);
302             }
303              
304 12 100       44 if($config_options->{MANIF}) {
305 2         7 _write_manifest($modfname, $build_dir, $config_options, $need_inline_h);
306             }
307              
308 12 100       161 if($config_options->{T}) {
309 1         3 _write_test_script($module, $build_dir);
310             }
311             }
312              
313             ##=========================##
314              
315             sub _build {
316 12     12   17 my $o = shift;
317 12         16 my $need_inline_headers = shift;
318 12         19 my $portable = shift;
319 12         21 my $save;
320              
321 12         111 $o->call('preprocess', 'Build Preprocess');
322 12         76041 $o->call('parse', 'Build Parse');
323              
324 12         5131586 my $modfname = $o->{API}{modfname};
325 12         41 my $build_dir = $o->{API}{build_dir};
326              
327 12         480 print "Writing ${modfname}.xs in the $build_dir directory\n";
328 12 100       60 if($portable) {
329 1         5 $save = $o->{ILSM}{AUTO_INCLUDE};
330 1         35 my @s = split /\n/, $save;
331 1 50       109 open WRA, '>', "$build_dir/auto_include.in" or die "Couldn't open $build_dir/auto_include.in for writing: $!";
332 1         4 for my $l(@s) {
333 18 100 100     59 $l = '' if($l =~ /__INLINE_CPP_STANDARD_HEADERS/ || $l =~ /__INLINE_CPP_NAMESPACE_STD/);
334 18         24 print WRA $l, "\n";
335             }
336 1 50       64 close WRA or die "Couldn't close $build_dir/auto_include.in after writing: $!";
337 1         6 $o->{ILSM}{AUTO_INCLUDE} = "\n#include \"icppdefines.h\"\n";;
338             }
339              
340 12         39 $Inline::CPP::Config::cpp_flavor_defs = ''; # Otherwise we find one more occurrence of
341             # $Inline::CPP::Config::cpp_flavor_defs in the generated XS
342             # file than we want.
343 12         76 $o->call('write_XS', 'Build Glue 1');
344 12 100       15129 $o->{ILSM}{AUTO_INCLUDE} = $save if $portable;
345              
346 12 100       50 if($need_inline_headers) {
347 7         175 print "Writing INLINE.h in the ", $o->{API}{build_dir}, " directory\n";
348 7         29 $o->call('write_Inline_headers', 'Build Glue 2');
349             }
350              
351             }
352              
353             ##=========================##
354              
355             sub _check_config_keys {
356 69     69   83 for(@allowable_config_keys) {
357 980 100       1352 return 1 if $_ eq $_[0]; # it's a valid config option
358             }
359 1         7 return 0; # it's an invalid config option
360             }
361              
362             ##=========================##
363              
364             sub _write_pm {
365 4     4   7 my $o = shift;
366 4         6 my $offset = 4;
367 4         6 my $max = 100;
368 4         6 my $length = $offset;
369 4         4 my @use;
370              
371 4 100       45 if($config_options->{USE}) {
372             die "Value supplied to config option USE must be an array reference"
373 2 50       9 if ref($config_options->{USE}) ne 'ARRAY';
374 2         2 @use = @{$config_options->{USE}};
  2         7  
375             }
376              
377 4 50       220 open(WR, '>', $o->{API}{build_dir} . '/' . $o->{API}{modfname} . ".pm")
378             or die "Couldn't create the .pm file: $!";
379 4         17 print "Writing ", $o->{API}{modfname}, ".pm in the ", $o->{API}{build_dir}, " directory\n";
380 4         25 print WR "## This file generated by InlineX::CPP2XS (version ",
381             $InlineX::CPP2XS::VERSION, ") using Inline::CPP (version ", $Inline::CPP::VERSION, ")\n";
382 4         11 print WR "package ", $o->{API}{module}, ";\n";
383 4         12 for(@use) {
384 2         7 print WR "use ${_};\n";
385             }
386 4         7 print WR "\n";
387 4         9 print WR "require Exporter;\n*import = \\&Exporter::import;\nrequire DynaLoader;\n\n";
388 4         36 print WR "our \$VERSION = '", $o->{API}{version}, "';\n";
389 4         6 print WR "\$VERSION = eval \$VERSION;\n";
390 4         11 print WR "DynaLoader::bootstrap ", $o->{API}{module}, " \$VERSION;\n\n";
391              
392 4 100       13 unless($config_options->{EXPORT_ALL}) {
393 3         8 print WR "\@", $o->{API}{module}, "::EXPORT = ();\n";
394             }
395             else {
396 1         2 print WR "\@", $o->{API}{module}, "::EXPORT = qw(\n";
397 1         1 for(@{$o->{ILSM}{parser}{data}{functions}}) {
  1         5  
398             # exclude function names that begin with a single underscore
399 8 100 100     27 if ($_ =~ /^_/ && $_ !~ /^__/) {next}
  4         5  
400 4         3 my $l = length($_);
401 4 50       8 if($length + $l > $max) {
402 0         0 print WR "\n", " " x $offset, "$_ ";
403 0         0 $length = $offset + $l + 1;
404             }
405 4 100       6 if($length == $offset) {print WR " " x $offset, "$_ "}
  1         4  
406 3         3 else {print WR "$_ " }
407 4         6 $length += $l + 1;
408             }
409 1         4 print WR "\n", " " x $offset, ");\n\n";
410 1         2 $length = $offset;
411             }
412              
413 4 100 66     21 unless($config_options->{EXPORT_OK_ALL} || $config_options->{EXPORT_TAGS_ALL}) {
414 1         3 print WR "\@", $o->{API}{module}, "::EXPORT_OK = ();\n\n";
415             }
416             else {
417 3         7 print WR "\@", $o->{API}{module}, "::EXPORT_OK = qw(\n";
418 3         4 for(@{$o->{ILSM}{parser}{data}{functions}}) {
  3         10  
419             # exclude function names that begin with a single underscore
420 26 100 100     92 if ($_ =~ /^_/ && $_ !~ /^__/) {next}
  20         16  
421 6         8 my $l = length($_);
422 6 50       38 if($length + $l > $max) {
423 0         0 print WR "\n", " " x $offset, "$_ ";
424 0         0 $length = $offset + $l + 1;
425             }
426 6 100       11 if($length == $offset) {print WR " " x $offset, "$_ "}
  3         13  
427 3         4 else {print WR "$_ " }
428 6         8 $length += $l + 1;
429             }
430 3         6 print WR "\n", " " x $offset, ");\n\n";
431 3         4 $length = $offset;
432             }
433              
434 4 100       16 if($config_options->{EXPORT_TAGS_ALL}){
435 1         4 print WR "\%", $o->{API}{module}, "::EXPORT_TAGS = (", $config_options->{EXPORT_TAGS_ALL}, " => [qw(\n";
436 1         1 for(@{$o->{ILSM}{parser}{data}{functions}}) {
  1         3  
437             # exclude function names that begin with a single underscore
438 8 100 100     24 if ($_ =~ /^_/ && $_ !~ /^__/) {next}
  4         4  
439 4         4 my $l = length($_);
440 4 50       7 if($length + $l > $max) {
441 0         0 print WR "\n", " " x $offset, "$_ ";
442 0         0 $length = $offset + $l + 1;
443             }
444 4 100       6 if($length == $offset) {print WR " " x $offset, "$_ "}
  1         3  
445 3         5 else {print WR "$_ " }
446 4         4 $length += $l + 1;
447             }
448 1         3 print WR "\n", " " x $offset, ")]);\n\n";
449 1         1 $length = $offset;
450             }
451              
452 4         7 print WR "sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking\n\n";
453 4         8 print WR "1;\n";
454 4 50       107 close(WR) or die "Couldn't close the .pm file after writing to it: $!";
455             }
456              
457             ##=========================##
458              
459             sub rewrite_makefile_pl {
460             # This sub will get called if we want to write a portable Makefile.PL - ie iff
461             # WRITE_MAKEFILE_PL is set to 'p' or 'P'.
462             # Lines starting with '>>' are heredoc entries. (All occurrences of '>>' are
463             # removed before the heredoc gets written to file.)
464 1     1 0 2 my $bd = shift; # build directory
465              
466 1 50       57 die "Couldn't rename $bd/Makefile.PL"
467             unless rename "$bd/Makefile.PL", "$bd/Makefile.PL_first";
468              
469             # Use the cpp test script from Inline::CPP
470 1         2 my $test_cpp = <<' TEST_CPP';
471             >>#include
472             >>int main(){
473             >> return 0;
474             >>}
475             >>
476             TEST_CPP
477              
478 1         5 $test_cpp =~ s/>>//g;
479              
480 1 50       54 open WRT, '>', "$bd/ilcpptest.cpp" or die "Couldn't open $bd/ilcpptest.cpp for writing: $!";
481 1         8 print WRT $test_cpp;
482 1 50       25 close WRT or die "Couldn't close $bd/ilcpptest.cpp: $!";
483              
484              
485 1 50       21 open RD, '<', "$bd/Makefile.PL_first" or die "Couldn't open $bd/Makefile.PL_first for reading: $!";
486 1 50       41 open WR, '>', "$bd/Makefile.PL" or die "Couldn't open Makefile.PL for writing: $!";
487              
488 1         19 my @make = ;
489              
490 1         3 my $insert = <<' IN';
491             >>
492             >> my ($cc_guess, $libs_guess) = _guess();
493             >>
494             >> my $iostream = which_iostream($cc_guess);
495             >>
496             >> my $standard;
497             >> if($iostream eq '' ) {
498             >> $standard = <<'STD';
499             >>
500             >>#define __INLINE_CPP_STANDARD_HEADERS 1
501             >>#define __INLINE_CPP_NAMESPACE_STD 1
502             >>
503             >>STD
504             >> }
505             >> else {$standard = ''}
506             >>
507             >>write_icppdefines_h($standard);
508             >>
509             >>sub _guess {
510             >>
511             >> my $cc_guess;
512             >> my $libs_guess;
513             >>
514             >> if($Config{osname} eq 'darwin'){
515             >> my $stdlib_query =
516             >> 'find /usr/lib/gcc -name "libstdc++*" | grep $( uname -p )';
517             >> my $stdcpp =
518             >> `$stdlib_query`; + $stdcpp =~ s/^(.*)\/[^\/]+$/$1/;
519             >> $cc_guess = 'g++';
520             >> $libs_guess = "-L$stdcpp -lstdc++";
521             >> }
522             >> elsif (
523             >> $Config{osname} ne 'darwin' and
524             >> $Config{gccversion} and
525             >> $Config{cc} =~ m#\bgcc\b[^/]*$# ) {
526             >> ($cc_guess = $Config{cc}) =~ s[\bgcc\b([^/]*)$(?:)][g\+\+$1];
527             >> $libs_guess = '-lstdc++';
528             >> }
529             >> elsif ($Config{osname} =~ m/^MSWin/) {
530             >> $cc_guess = 'cl -TP -EHsc';
531             >> $libs_guess = 'MSVCIRT.LIB';
532             >> }
533             >> elsif ($Config{osname} eq 'linux') {
534             >> $cc_guess = 'g++';
535             >> $libs_guess = '-lstdc++';
536             >> }
537             >> # Dragonfly patch is just a hunch...
538             >> elsif( $Config{osname} eq 'netbsd' || $Config{osname} eq 'dragonfly' ) {
539             >> $cc_guess = 'g++';
540             >> $libs_guess = '-lstdc++ -lgcc_s';
541             >> }
542             >> elsif ($Config{osname} eq 'cygwin') {
543             >> $cc_guess = 'g++';
544             >> $libs_guess = '-lstdc++';
545             >> }
546             >> elsif ($Config{osname} eq 'solaris' or $Config{osname} eq 'SunOS') {
547             >> if(
548             >> $Config{cc} eq 'gcc' ||( exists( $Config{gccversion} ) && $Config{gccversion} > 0)) {
549             >> $cc_guess = 'g++';
550             >> $libs_guess = '-lstdc++';
551             >> }
552             >> else {
553             >> $cc_guess = 'CC';
554             >> $libs_guess ='-lCrun';
555             >> }
556             >> }
557             >> elsif ($Config{osname} eq 'mirbsd') {
558             >> my $stdlib_query =
559             >> 'find /usr/lib/gcc -name "libstdc++*" | grep $( uname -p ) | head -1';
560             >> my $stdcpp =
561             >> `$stdlib_query`; + $stdcpp =~ s/^(.*)\/[^\/]+$/$1/;
562             >> $cc_guess = 'g++';
563             >> $libs_guess = "-L$stdcpp -lstdc++ -lc -lgcc_s";
564             >> }
565             >> # Sane defaults for other (probably unix-like) operating systems
566             >> else {
567             >> $cc_guess = 'g++';
568             >> $libs_guess = '-lstdc++';
569             >> }
570             >>
571             >> return ($cc_guess, $libs_guess);
572             >>}
573             >>
574             >>sub which_iostream {
575             >>
576             >> my $cpp_compiler = shift;
577             >>
578             >> my $result;
579             >> if( $cpp_compiler =~ m/^cl/ ) {
580             >> $result = system(
581             >> qq{$cpp_compiler -Fe:ilcpptest.exe } .
582             >> qq{ilcpptest.cpp}
583             >> );
584             >> }
585             >> else {
586             >> $result = system(
587             >> qq{$cpp_compiler -o ilcpptest.exe } .
588             >> qq{ilcpptest.cpp}
589             >> );
590             >> }
591             >>
592             >> if( $result != 0 ) {
593             >> # Compiling with failed, so we'll assume .h headers.
594             >> $result = '';
595             >> }
596             >> else {
597             >> # Compiling with succeeded.
598             >> $result = '';
599             >> unlink "ilcpptest.exe" or warn $!; # Unlink the executable.
600             >> }
601             >> return $result;
602             >>}
603             >>
604             >>sub write_icppdefines_h {
605             >>
606             >> my $standard = shift;
607             >>
608             >> open RDA, '<', 'auto_include.in' or die "Couldn't open auto_include.in for reading: $!";
609             >> my @auto = ;
610             >> close RDA or die "Couldn't close auto_include.in after reading: $!";
611             >>
612             >> my $auto = join '', @auto;
613             >>
614             >> if($standard) {$auto =~ s///g}
615             >> else {$auto =~ s///g}
616             >>
617             >> open WRXS, '>', "icppdefines.h" or die "Couldn't open icppdefines.h for writing: $!";
618             >>
619             >> print WRXS "\n/* This file generated by the Makefile.PL */\n\n";
620             >> print WRXS $standard;
621             >> print WRXS $auto;
622             >>
623             >> close WRXS or die "Couldn't close icppdefines.h: $!";
624             >>
625             >>}
626             >>
627             IN
628              
629 1         36 $insert =~ s/>>//g;
630              
631 1         3 $make[0] .= $insert;
632 1         4 for(@make) {
633 19 50       27 if($_ =~ /'LIBS' => '/) {
634 0         0 my @t = split /'LIBS' => /;
635 0         0 $t[1] =~ s/'/"/g;
636 0         0 $t[1] =~ s/"/\$libs_guess /;
637 0         0 $_ = join "'LIBS' => \"", @t;
638             }
639 19 100       39 if($_ =~ /'CC' =>/) {$_ = ' \'CC\' => "$cc_guess",' . "\n"}
  1         3  
640             }
641              
642 1         2 for(@make) {print WR $_}
  19         16  
643 1 50       8 close RD or die "Couldn't close $bd/Makefile.PL_first: $!";
644 1 50       22 close WR or die "Couldn't close $bd/Makefile.PL: $!";
645 1 50       72 unlink "$bd/Makefile.PL_first" or die "Couldn't unlink $bd/Makefile.PL_first: $!";
646             }
647              
648             ##=========================##
649              
650             sub _write_manifest {
651 2     2   6 my $m = shift; # name of pm and xs files
652 2         4 my $bd = shift; # build directory
653 2         3 my $c = shift; # config options
654 2         2 my $ih = shift; # INLINE.h required ?
655              
656 2         19 print "Writing the MANIFEST file in the $bd directory\n";
657              
658 2 50       113 open WRM, '>', "$bd/MANIFEST" or die "Can't open MANIFEST for writing: $!";
659 2         6 print WRM "MANIFEST\n";
660 2 50       9 if($c->{WRITE_PM}) {print WRM "$m.pm\n"}
  2         6  
661 2 50       5 if($ih) {print WRM "INLINE.h\n"}
  0         0  
662 2         5 print WRM "$m.xs\nCPP.map\n";
663 2 50       7 if($c->{WRITE_MAKEFILE_PL}) {
664 2         4 print WRM "Makefile.PL\n";
665 2 100       10 if(uc($c->{WRITE_MAKEFILE_PL}) eq 'P') {
666 1         2 print WRM "auto_include.in\nilcpptest.cpp\n";
667             }
668             }
669 2         40 close WRM;
670             }
671              
672             ##=========================##
673              
674             sub _write_test_script {
675 11     11   80 use File::Path;
  11         20  
  11         11908  
676 1     1   2 my $mod = $_[0];
677 1         2 my $path = "$_[1]/t";
678 1 50       13 unless(-d $path) {
679 0 0       0 if(!File::Path::make_path($path, {verbose => 1})) {die "Failed to create $path directory"};
  0         0  
680             }
681              
682 1         3 print "Writing 00load.t in the $path directory\n";
683 1 50       45 open WRT, '>', "$path/00load.t" or die "Couldn't open $path/00load.t for writing: $!";
684 1         4 print WRT "## This file auto-generated by InlineX-CPP2XS-" . $InlineX::CPP2XS::VERSION . "\n\n";
685 1         2 print WRT "use strict;\nuse warnings;\n\n";
686 1         1 print WRT "print \"1..1\\n\";\n\n";
687 1         3 print WRT "eval{require $mod;};\n";
688 1         2 print WRT "if(\$\@) {\n warn \"\\\$\\\@: \$\@\";\n print \"not ok 1\\n\";\n}\n";
689 1         1 print WRT "else {print \"ok 1\\n\"}\n";
690 1 50       33 close WRT or die "Couldn't close $path/00load.t after writing: $!";
691             }
692              
693             ##=========================##
694              
695             ##=========================##
696              
697             ##=========================##
698              
699             1;
700              
701             __END__