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