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