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