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