File Coverage

blib/lib/InlineX/CPP2XS.pm
Criterion Covered Total %
statement 324 360 90.0
branch 155 202 76.7
condition 20 24 83.3
subroutine 10 10 100.0
pod 0 2 0.0
total 509 598 85.1


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