This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[inseparable changes from patch from perl5.003_24 to perl5.003_25]
[perl5.git] / lib / ExtUtils / Embed.pm
1 # $Id: Embed.pm,v 1.22 1997/01/30 00:37:09 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.22 $ =~ /(\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{ccdlflags} $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    perl_inc;
231 }
232
233 sub canon {
234     my($as, @ext) = @_;
235     foreach(@ext) {
236        # might be X::Y or lib/auto/X/Y/Y.a
237        next if s!::!/!g;
238        s:^(lib|ext)/(auto/)?::;
239        s:/\w+\.\w+$::;
240     }
241     grep(s:/:$as:, @ext) if ($as ne '/');
242     @ext;
243 }
244
245 __END__
246
247 =head1 NAME
248
249 ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
250
251 =head1 SYNOPSIS
252
253
254  perl -MExtUtils::Embed -e xsinit 
255  perl -MExtUtils::Embed -e ldopts 
256
257 =head1 DESCRIPTION
258
259 ExtUtils::Embed provides utility functions for embedding a Perl interpreter
260 and extensions in your C/C++ applications.  
261 Typically, an application B<Makefile> will invoke ExtUtils::Embed
262 functions while building your application.  
263
264 =head1 @EXPORT
265
266 ExtUtils::Embed exports the following functions:
267
268 xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(), 
269 ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
270
271 =head1 FUNCTIONS
272
273 =item xsinit()
274
275 Generate C/C++ code for the XS initializer function.
276
277 When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
278 the following options are recognized:
279
280 B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
281
282 B<-o STDOUT> will print to STDOUT.
283
284 B<-std> (Write code for extensions that are linked with the current Perl.)
285
286 Any additional arguments are expected to be names of modules
287 to generate code for.
288
289 When invoked with parameters the following are accepted and optional:
290
291 C<xsinit($filename,$std,[@modules])>
292
293 Where,
294
295 B<$filename> is equivalent to the B<-o> option.
296
297 B<$std> is boolean, equivalent to the B<-std> option.  
298
299 B<[@modules]> is an array ref, same as additional arguments mentioned above.
300
301 =item Examples
302
303
304  perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
305
306
307 This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function 
308 to the C B<boot_Socket> function and writes it to a file named "xsinit.c".
309
310 Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
311
312  perl -MExtUtils::Embed -e xsinit
313
314
315 This will generate code for linking with B<DynaLoader> and 
316 each static extension found in B<$Config{static_ext}>.
317 The code is written to the default file name B<perlxsi.c>.
318
319
320  perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
321
322
323 Here, code is written for all the currently linked extensions along with code
324 for B<DBI> and B<DBD::Oracle>.
325
326 If you have a working B<DynaLoader> then there is rarely any need to statically link in any 
327 other extensions.
328
329 =item ldopts()
330
331 Output arguments for linking the Perl library and extensions to your
332 application.
333
334 When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
335 the following options are recognized:
336
337 B<-std> 
338
339 Output arguments for linking the Perl library and any extensions linked
340 with the current Perl.
341
342 B<-I> E<lt>path1:path2E<gt>
343
344 Search path for ModuleName.a archives.  
345 Default path is B<@INC>.
346 Library archives are expected to be found as 
347 B</some/path/auto/ModuleName/ModuleName.a>
348 For example, when looking for B<Socket.a> relative to a search path, 
349 we should find B<auto/Socket/Socket.a>  
350
351 When looking for B<DBD::Oracle> relative to a search path,
352 we should find B<auto/DBD/Oracle/Oracle.a>
353
354 Keep in mind, you can always supply B</my/own/path/ModuleName.a>
355 as an additional linker argument.
356
357 B<-->  E<lt>list of linker argsE<gt>
358
359 Additional linker arguments to be considered.
360
361 Any additional arguments found before the B<--> token 
362 are expected to be names of modules to generate code for.
363
364 When invoked with parameters the following are accepted and optional:
365
366 C<ldopts($std,[@modules],[@link_args],$path)>
367
368 Where,
369
370 B<$std> is boolean, equivalent to the B<-std> option.  
371
372 B<[@modules]> is equivalent to additional arguments found before the B<--> token.
373
374 B<[@link_args]> is equivalent to arguments found after the B<--> token.
375
376 B<$path> is equivalent to the B<-I> option.
377
378 In addition, when ldopts is called with parameters, it will return the argument string
379 rather than print it to STDOUT.
380
381 =item Examples
382
383
384  perl -MExtUtils::Embed -e ldopts
385
386
387 This will print arguments for linking with B<libperl.a>, B<DynaLoader> and 
388 extensions found in B<$Config{static_ext}>.  This includes libraries
389 found in B<$Config{libs}> and the first ModuleName.a library
390 for each extension that is found by searching B<@INC> or the path 
391 specifed by the B<-I> option.  
392 In addition, when ModuleName.a is found, additional linker arguments
393 are picked up from the B<extralibs.ld> file in the same directory.
394
395
396  perl -MExtUtils::Embed -e ldopts -- -std Socket
397
398
399 This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
400
401
402  perl -MExtUtils::Embed -e ldopts -- DynaLoader
403
404
405 This will print arguments for linking with just the B<DynaLoader> extension
406 and B<libperl.a>.
407
408
409  perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
410
411
412 Any arguments after the second '--' token are additional linker
413 arguments that will be examined for potential conflict.  If there is no
414 conflict, the additional arguments will be part of the output.  
415
416
417 =item perl_inc()
418
419 For including perl header files this function simply prints:
420
421  -I$Config{archlibexp}/CORE  
422
423 So, rather than having to say:
424
425  perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
426
427 Just say:
428
429  perl -MExtUtils::Embed -e perl_inc
430
431 =item ccflags(), ccdlflags()
432
433 These functions simply print $Config{ccflags} and $Config{ccdlflags}
434
435 =item ccopts()
436
437 This function combines perl_inc(), ccflags() and ccdlflags() into one.
438
439 =item xsi_header()
440
441 This function simply returns a string defining the same B<EXTERN_C> macro as
442 B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.  
443
444 =item xsi_protos(@modules)
445
446 This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
447
448 =item xsi_body(@modules)
449
450 This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
451 function to B<boot_ModuleName> for each @modules.
452
453 B<xsinit()> uses the xsi_* functions to generate most of it's code.
454
455 =head1 EXAMPLES
456
457 For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
458 with embedded perl, see the eg/ directory and L<perlembed>.
459
460 =head1 SEE ALSO
461
462 L<perlembed>
463
464 =head1 AUTHOR
465
466 Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
467
468 Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
469 B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
470
471 =cut
472