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