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