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