This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor ExtUtils::Embed::xsi_{protos,body} to use a scalar $retval.
[perl5.git] / lib / ExtUtils / Embed.pm
CommitLineData
a2c6f8f1 1package ExtUtils::Embed;
2require Exporter;
a2c6f8f1 3use Config;
566e3efe 4require File::Spec;
a2c6f8f1 5
a2c6f8f1 6use vars qw(@ISA @EXPORT $VERSION
7 @Extensions $Verbose $lib_ext
8 $opt_o $opt_s
9 );
10use strict;
11
7975e7c1 12# This is not a dual-life module, so no need for development version numbers
566e3efe 13$VERSION = '1.31';
a2c6f8f1 14
15@ISA = qw(Exporter);
16@EXPORT = qw(&xsinit &ldopts
17 &ccopts &ccflags &ccdlflags &perl_inc
18 &xsi_header &xsi_protos &xsi_body);
19
a2c6f8f1 20$Verbose = 0;
21$lib_ext = $Config{lib_ext} || '.a';
22
7e24002c
DM
23sub is_cmd { $0 eq '-e' }
24
25sub my_return {
26 my $val = shift;
27 if(is_cmd) {
28 print $val;
29 }
30 else {
31 return $val;
32 }
33}
34
a2c6f8f1 35sub xsinit {
36 my($file, $std, $mods) = @_;
37 my($fh,@mods,%seen);
38 $file ||= "perlxsi.c";
acfe0abc 39 my $xsinit_proto = "pTHX";
a2c6f8f1 40
41 if (@_) {
42 @mods = @$mods if $mods;
43 }
44 else {
566e3efe
NC
45 require Getopt::Std;
46 Getopt::Std::getopts('o:s:');
a2c6f8f1 47 $file = $opt_o if defined $opt_o;
48 $std = $opt_s if defined $opt_s;
49 @mods = @ARGV;
50 }
51 $std = 1 unless scalar @mods;
52
53 if ($file eq "STDOUT") {
54 $fh = \*STDOUT;
55 }
56 else {
566e3efe
NC
57 open $fh, '>', $file
58 or die "Can't open '$file': $!";
a2c6f8f1 59 }
60
61 push(@mods, static_ext()) if defined $std;
62 @mods = grep(!$seen{$_}++, @mods);
63
64 print $fh &xsi_header();
5ec3aaed 65 print $fh "\nEXTERN_C void xs_init ($xsinit_proto);\n\n";
a2c6f8f1 66 print $fh &xsi_protos(@mods);
67
8bdb6b78 68 print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n";
a2c6f8f1 69 print $fh &xsi_body(@mods);
70 print $fh "}\n";
71
72}
73
74sub xsi_header {
75 return <<EOF;
5ec3aaed
NC
76#include "EXTERN.h"
77#include "perl.h"
78#include "XSUB.h"
a2c6f8f1 79EOF
80}
81
82sub xsi_protos {
2d7ce4f0
NC
83 my @exts = @_;
84 my %seen;
85 my $retval = '';
8d68a8a5 86 foreach my $cname (canon('__', @exts)) {
2d7ce4f0
NC
87 my $ccode = "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
88 $retval .= $ccode
89 unless $seen{$ccode}++;
a2c6f8f1 90 }
2d7ce4f0 91 return $retval;
a2c6f8f1 92}
93
94sub xsi_body {
2d7ce4f0
NC
95 my @exts = @_;
96 my %seen;
97 my $retval;
98 $retval .= " static const char file[] = __FILE__;\n"
5ec3aaed 99 if @exts;
2d7ce4f0
NC
100 $retval .= <<'EOT';
101 dXSUB_SYS;
102 PERL_UNUSED_CONTEXT;
103EOT
104 $retval .= "\n"
5ec3aaed 105 if @exts;
a2c6f8f1 106
8d68a8a5 107 foreach my $pname (canon('/', @exts)) {
2d7ce4f0
NC
108 next
109 if $seen{$pname}++;
110 (my $mname = $pname) =~ s!/!::!g;
111 (my $cname = $pname) =~ s!/!__!g;
112 my $fname;
8d68a8a5 113 if ($pname eq 'DynaLoader'){
a2c6f8f1 114 # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
115 # boot_DynaLoader is called directly in DynaLoader.pm
2d7ce4f0
NC
116 $retval .= " /* DynaLoader is a special case */\n";
117 $fname = "${mname}::boot_DynaLoader";
a2c6f8f1 118 } else {
2d7ce4f0 119 $fname = "${mname}::bootstrap";
a2c6f8f1 120 }
2d7ce4f0 121 $retval .= " newXS(\"$fname\", boot_${cname}, file);\n"
a2c6f8f1 122 }
2d7ce4f0 123 return $retval;
a2c6f8f1 124}
125
126sub static_ext {
8d68a8a5
NC
127 @Extensions = ('DynaLoader', sort $Config{static_ext} =~ /(\S+)/g)
128 unless @Extensions;
a2c6f8f1 129 @Extensions;
130}
131
03f2ffd8
JH
132sub _escape {
133 my $arg = shift;
0ab03fee 134 return $$arg if $^O eq 'VMS'; # parens legal in qualifier lists
03f2ffd8
JH
135 $$arg =~ s/([\(\)])/\\$1/g;
136}
137
f0595bdd
JH
138sub _ldflags {
139 my $ldflags = $Config{ldflags};
03f2ffd8 140 _escape(\$ldflags);
f0595bdd
JH
141 return $ldflags;
142}
143
144sub _ccflags {
145 my $ccflags = $Config{ccflags};
03f2ffd8 146 _escape(\$ccflags);
f0595bdd
JH
147 return $ccflags;
148}
149
150sub _ccdlflags {
151 my $ccdlflags = $Config{ccdlflags};
03f2ffd8 152 _escape(\$ccdlflags);
f0595bdd
JH
153 return $ccdlflags;
154}
155
a2c6f8f1 156sub ldopts {
157 require ExtUtils::MakeMaker;
158 require ExtUtils::Liblist;
159 my($std,$mods,$link_args,$path) = @_;
160 my(@mods,@link_args,@argv);
161 my($dllib,$config_libs,@potential_libs,@path);
162 local($") = ' ' unless $" eq ' ';
a2c6f8f1 163 if (scalar @_) {
164 @link_args = @$link_args if $link_args;
165 @mods = @$mods if $mods;
166 }
167 else {
168 @argv = @ARGV;
169 #hmm
170 while($_ = shift @argv) {
171 /^-std$/ && do { $std = 1; next; };
172 /^--$/ && do { @link_args = @argv; last; };
173 /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
174 push(@mods, $_);
175 }
176 }
177 $std = 1 unless scalar @link_args;
9bbedd82
JH
178 my $sep = $Config{path_sep} || ':';
179 @path = $path ? split(/\Q$sep/, $path) : @INC;
a2c6f8f1 180
181 push(@potential_libs, @link_args) if scalar @link_args;
9bbedd82
JH
182 # makemaker includes std libs on windows by default
183 if ($^O ne 'MSWin32' and defined($std)) {
184 push(@potential_libs, $Config{perllibs});
185 }
a2c6f8f1 186
187 push(@mods, static_ext()) if $std;
188
189 my($mod,@ns,$root,$sub,$extra,$archive,@archives);
190 print STDERR "Searching (@path) for archives\n" if $Verbose;
191 foreach $mod (@mods) {
3ab83790 192 @ns = split(/::|\/|\\/, $mod);
a2c6f8f1 193 $sub = $ns[-1];
56c2fb36 194 $root = File::Spec->catdir(@ns);
a2c6f8f1 195
196 print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose;
197 foreach (@path) {
56c2fb36 198 next unless -e ($archive = File::Spec->catdir($_,"auto",$root,"$sub$lib_ext"));
a2c6f8f1 199 push @archives, $archive;
56c2fb36 200 if(-e ($extra = File::Spec->catdir($_,"auto",$root,"extralibs.ld"))) {
a2c6f8f1 201 local(*FH);
202 if(open(FH, $extra)) {
203 my($libs) = <FH>; chomp $libs;
204 push @potential_libs, split /\s+/, $libs;
205 }
206 else {
207 warn "Couldn't open '$extra'";
208 }
209 }
210 last;
211 }
212 }
213 #print STDERR "\@potential_libs = @potential_libs\n";
214
9bbedd82
JH
215 my $libperl;
216 if ($^O eq 'MSWin32') {
217 $libperl = $Config{libperl};
218 }
2f3efc97
JH
219 elsif ($^O eq 'os390' && $Config{usedl}) {
220 # Nothing for OS/390 (z/OS) dynamic.
221 } else {
9720141b
MR
222 $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0]
223 || ($Config{libperl} =~ /^lib(\w+)(\Q$lib_ext\E|\.\Q$Config{dlext}\E)$/
224 ? "-l$1" : '')
2f3efc97 225 || "-lperl";
9bbedd82 226 }
af248097 227
9bbedd82
JH
228 my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
229 $lpath = qq["$lpath"] if $^O eq 'MSWin32';
a2c6f8f1 230 my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
5de3f0da 231 MM->ext(join ' ', "-L$lpath", $libperl, @potential_libs);
a2c6f8f1 232
233 my $ld_or_bs = $bsloadlibs || $ldloadlibs;
234 print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
f0595bdd
JH
235 my $ccdlflags = _ccdlflags();
236 my $ldflags = _ldflags();
237 my $linkage = "$ccdlflags $ldflags @archives $ld_or_bs";
a2c6f8f1 238 print STDERR "ldopts: '$linkage'\n" if $Verbose;
239
240 return $linkage if scalar @_;
7e24002c 241 my_return("$linkage\n");
a2c6f8f1 242}
243
244sub ccflags {
f0595bdd
JH
245 my $ccflags = _ccflags();
246 my_return(" $ccflags ");
a2c6f8f1 247}
248
249sub ccdlflags {
f0595bdd
JH
250 my $ccdlflags = _ccdlflags();
251 my_return(" $ccdlflags ");
a2c6f8f1 252}
253
254sub perl_inc {
9bbedd82
JH
255 my $dir = File::Spec->catdir($Config{archlibexp}, 'CORE');
256 $dir = qq["$dir"] if $^O eq 'MSWin32';
257 my_return(" -I$dir ");
a2c6f8f1 258}
259
260sub ccopts {
7e24002c 261 ccflags . perl_inc;
a2c6f8f1 262}
263
264sub canon {
265 my($as, @ext) = @_;
266 foreach(@ext) {
8d68a8a5
NC
267 # might be X::Y or lib/auto/X/Y/Y.a
268 next
269 if s!::!/!g;
270 s!^(?:lib|ext|dist|cpan)/(?:auto/)?!!;
271 s!/\w+\.\w+$!!;
272 }
273 if ($as ne '/') {
274 s!/!$as!
275 foreach @ext;
a2c6f8f1 276 }
a2c6f8f1 277 @ext;
278}
279
280__END__
281
282=head1 NAME
283
284ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
285
286=head1 SYNOPSIS
287
288
289 perl -MExtUtils::Embed -e xsinit
9bbedd82 290 perl -MExtUtils::Embed -e ccopts
a2c6f8f1 291 perl -MExtUtils::Embed -e ldopts
292
293=head1 DESCRIPTION
294
295ExtUtils::Embed provides utility functions for embedding a Perl interpreter
296and extensions in your C/C++ applications.
297Typically, an application B<Makefile> will invoke ExtUtils::Embed
298functions while building your application.
299
300=head1 @EXPORT
301
302ExtUtils::Embed exports the following functions:
a6006777 303
4e864201
JM
304xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(),
305ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
a2c6f8f1 306
307=head1 FUNCTIONS
308
bbc7dcd2 309=over 4
2ae324a7 310
a2c6f8f1 311=item xsinit()
312
4e864201 313Generate C/C++ code for the XS initializer function.
a2c6f8f1 314
315When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
316the following options are recognized:
317
4e864201 318B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
a2c6f8f1 319
320B<-o STDOUT> will print to STDOUT.
321
322B<-std> (Write code for extensions that are linked with the current Perl.)
323
324Any additional arguments are expected to be names of modules
325to generate code for.
326
327When invoked with parameters the following are accepted and optional:
328
329C<xsinit($filename,$std,[@modules])>
330
331Where,
332
333B<$filename> is equivalent to the B<-o> option.
334
335B<$std> is boolean, equivalent to the B<-std> option.
336
337B<[@modules]> is an array ref, same as additional arguments mentioned above.
338
339=item Examples
340
a6006777 341
a2c6f8f1 342 perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
343
344
345This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function
a7665c5e 346to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>.
a2c6f8f1 347
348Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
349
350 perl -MExtUtils::Embed -e xsinit
351
352
353This will generate code for linking with B<DynaLoader> and
354each static extension found in B<$Config{static_ext}>.
355The code is written to the default file name B<perlxsi.c>.
356
357
358 perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
359
360
361Here, code is written for all the currently linked extensions along with code
362for B<DBI> and B<DBD::Oracle>.
363
364If you have a working B<DynaLoader> then there is rarely any need to statically link in any
365other extensions.
366
367=item ldopts()
368
369Output arguments for linking the Perl library and extensions to your
370application.
371
372When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
373the following options are recognized:
374
375B<-std>
376
377Output arguments for linking the Perl library and any extensions linked
378with the current Perl.
379
4e864201 380B<-I> E<lt>path1:path2E<gt>
a2c6f8f1 381
382Search path for ModuleName.a archives.
383Default path is B<@INC>.
384Library archives are expected to be found as
385B</some/path/auto/ModuleName/ModuleName.a>
386For example, when looking for B<Socket.a> relative to a search path,
387we should find B<auto/Socket/Socket.a>
388
389When looking for B<DBD::Oracle> relative to a search path,
390we should find B<auto/DBD/Oracle/Oracle.a>
391
a7665c5e 392Keep in mind that you can always supply B</my/own/path/ModuleName.a>
a2c6f8f1 393as an additional linker argument.
394
4e864201 395B<--> E<lt>list of linker argsE<gt>
a2c6f8f1 396
397Additional linker arguments to be considered.
398
399Any additional arguments found before the B<--> token
400are expected to be names of modules to generate code for.
401
402When invoked with parameters the following are accepted and optional:
403
404C<ldopts($std,[@modules],[@link_args],$path)>
405
a7665c5e 406Where:
a2c6f8f1 407
408B<$std> is boolean, equivalent to the B<-std> option.
409
410B<[@modules]> is equivalent to additional arguments found before the B<--> token.
411
412B<[@link_args]> is equivalent to arguments found after the B<--> token.
413
414B<$path> is equivalent to the B<-I> option.
415
416In addition, when ldopts is called with parameters, it will return the argument string
417rather than print it to STDOUT.
418
419=item Examples
420
421
422 perl -MExtUtils::Embed -e ldopts
423
424
a90be013 425This will print arguments for linking with B<libperl> and
a2c6f8f1 426extensions found in B<$Config{static_ext}>. This includes libraries
427found in B<$Config{libs}> and the first ModuleName.a library
428for each extension that is found by searching B<@INC> or the path
de592821 429specified by the B<-I> option.
a2c6f8f1 430In addition, when ModuleName.a is found, additional linker arguments
431are picked up from the B<extralibs.ld> file in the same directory.
432
433
434 perl -MExtUtils::Embed -e ldopts -- -std Socket
a6006777 435
a2c6f8f1 436
437This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
438
a2c6f8f1 439 perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
440
a2c6f8f1 441Any arguments after the second '--' token are additional linker
442arguments that will be examined for potential conflict. If there is no
443conflict, the additional arguments will be part of the output.
444
445
446=item perl_inc()
447
448For including perl header files this function simply prints:
449
36477c24 450 -I$Config{archlibexp}/CORE
a2c6f8f1 451
452So, rather than having to say:
453
36477c24 454 perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
a2c6f8f1 455
456Just say:
457
458 perl -MExtUtils::Embed -e perl_inc
459
460=item ccflags(), ccdlflags()
461
462These functions simply print $Config{ccflags} and $Config{ccdlflags}
463
464=item ccopts()
465
466This function combines perl_inc(), ccflags() and ccdlflags() into one.
467
468=item xsi_header()
469
470This function simply returns a string defining the same B<EXTERN_C> macro as
471B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.
472
473=item xsi_protos(@modules)
474
475This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
476
477=item xsi_body(@modules)
478
479This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
480function to B<boot_ModuleName> for each @modules.
481
022735b4 482B<xsinit()> uses the xsi_* functions to generate most of its code.
a2c6f8f1 483
2ae324a7 484=back
485
a2c6f8f1 486=head1 EXAMPLES
487
488For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
0325b4c4 489with embedded perl, see L<perlembed>.
a6006777 490
a2c6f8f1 491=head1 SEE ALSO
492
4e864201 493L<perlembed>
a2c6f8f1 494
495=head1 AUTHOR
496
4e864201 497Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
a2c6f8f1 498
4e864201
JM
499Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
500B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
a2c6f8f1 501
502=cut
503