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