1# Id: Embed.pm,v 10.2 1996/09/19 09:12:51 bostic Exp
2require 5.002;
3
4package ExtUtils::Embed;
5require Exporter;
6require FileHandle;
7use Config;
8use Getopt::Std;
9
10#Only when we need them
11#require ExtUtils::MakeMaker;
12#require ExtUtils::Liblist;
13
14use vars qw(@ISA @EXPORT $VERSION
15	    @Extensions $Verbose $lib_ext
16	    $opt_o $opt_s
17	    );
18use strict;
19
20$VERSION = sprintf("%d.%02d", qRevision: 10.2 =~ /(\d+)\.(\d+)/);
21#for the namespace change
22$Devel::embed::VERSION = "99.99";
23
24sub 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
38sub 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
74sub xsi_header {
75    return <<EOF;
76#ifdef __cplusplus
77extern "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
94EOF
95}
96
97sub 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
113sub 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
138sub static_ext {
139    unless (scalar @Extensions) {
140	@Extensions = sort split /\s+/, $Config{static_ext};
141	unshift @Extensions, qw(DynaLoader);
142    }
143    @Extensions;
144}
145
146sub 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{archlib}", "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
216sub ccflags {
217   print " $Config{ccflags} ";
218}
219
220sub ccdlflags {
221   print " $Config{ccdlflags} ";
222}
223
224sub perl_inc {
225   print " -I$Config{archlib}/CORE ";
226}
227
228sub ccopts {
229   ccflags;
230   ccdlflags;
231   perl_inc;
232}
233
234sub 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
250ExtUtils::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
260ExtUtils::Embed provides utility functions for embedding a Perl interpreter
261and extensions in your C/C++ applications.
262Typically, an application B<Makefile> will invoke ExtUtils::Embed
263functions while building your application.
264
265=head1 @EXPORT
266
267ExtUtils::Embed exports the following functions:
268
269L<xsinit()>, L<ldopts()>, L<ccopts()>, L<perl_inc()>, L<ccflags()>,
270L<ccdlflags()>, L<xsi_header()>, L<xsi_protos()>, L<xsi_body()>
271
272=head1 FUNCTIONS
273
274=item xsinit()
275
276Generate C/C++ code for the XS intializer function.
277
278When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
279the following options are recognized:
280
281B<-o> <output filename> (Defaults to B<perlxsi.c>)
282
283B<-o STDOUT> will print to STDOUT.
284
285B<-std> (Write code for extensions that are linked with the current Perl.)
286
287Any additional arguments are expected to be names of modules
288to generate code for.
289
290When invoked with parameters the following are accepted and optional:
291
292C<xsinit($filename,$std,[@modules])>
293
294Where,
295
296B<$filename> is equivalent to the B<-o> option.
297
298B<$std> is boolean, equivalent to the B<-std> option.
299
300B<[@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
308This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function
309to the C B<boot_Socket> function and writes it to a file named "xsinit.c".
310
311Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
312
313 perl -MExtUtils::Embed -e xsinit
314
315
316This will generate code for linking with B<DynaLoader> and
317each static extension found in B<$Config{static_ext}>.
318The 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
324Here, code is written for all the currently linked extensions along with code
325for B<DBI> and B<DBD::Oracle>.
326
327If you have a working B<DynaLoader> then there is rarely any need to statically link in any
328other extensions.
329
330=item ldopts()
331
332Output arguments for linking the Perl library and extensions to your
333application.
334
335When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
336the following options are recognized:
337
338B<-std>
339
340Output arguments for linking the Perl library and any extensions linked
341with the current Perl.
342
343B<-I> <path1:path2>
344
345Search path for ModuleName.a archives.
346Default path is B<@INC>.
347Library archives are expected to be found as
348B</some/path/auto/ModuleName/ModuleName.a>
349For example, when looking for B<Socket.a> relative to a search path,
350we should find B<auto/Socket/Socket.a>
351
352When looking for B<DBD::Oracle> relative to a search path,
353we should find B<auto/DBD/Oracle/Oracle.a>
354
355Keep in mind, you can always supply B</my/own/path/ModuleName.a>
356as an additional linker argument.
357
358B<-->  <list of linker args>
359
360Additional linker arguments to be considered.
361
362Any additional arguments found before the B<--> token
363are expected to be names of modules to generate code for.
364
365When invoked with parameters the following are accepted and optional:
366
367C<ldopts($std,[@modules],[@link_args],$path)>
368
369Where,
370
371B<$std> is boolean, equivalent to the B<-std> option.
372
373B<[@modules]> is equivalent to additional arguments found before the B<--> token.
374
375B<[@link_args]> is equivalent to arguments found after the B<--> token.
376
377B<$path> is equivalent to the B<-I> option.
378
379In addition, when ldopts is called with parameters, it will return the argument string
380rather than print it to STDOUT.
381
382=item Examples
383
384
385 perl -MExtUtils::Embed -e ldopts
386
387
388This will print arguments for linking with B<libperl.a>, B<DynaLoader> and
389extensions found in B<$Config{static_ext}>.  This includes libraries
390found in B<$Config{libs}> and the first ModuleName.a library
391for each extension that is found by searching B<@INC> or the path
392specifed by the B<-I> option.
393In addition, when ModuleName.a is found, additional linker arguments
394are picked up from the B<extralibs.ld> file in the same directory.
395
396
397 perl -MExtUtils::Embed -e ldopts -- -std Socket
398
399
400This 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
406This will print arguments for linking with just the B<DynaLoader> extension
407and B<libperl.a>.
408
409
410 perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
411
412
413Any arguments after the second '--' token are additional linker
414arguments that will be examined for potential conflict.  If there is no
415conflict, the additional arguments will be part of the output.
416
417
418=item perl_inc()
419
420For including perl header files this function simply prints:
421
422 -I $Config{archlib}/CORE
423
424So, rather than having to say:
425
426 perl -MConfig -e 'print "-I $Config{archlib}/CORE"'
427
428Just say:
429
430 perl -MExtUtils::Embed -e perl_inc
431
432=item ccflags(), ccdlflags()
433
434These functions simply print $Config{ccflags} and $Config{ccdlflags}
435
436=item ccopts()
437
438This function combines perl_inc(), ccflags() and ccdlflags() into one.
439
440=item xsi_header()
441
442This function simply returns a string defining the same B<EXTERN_C> macro as
443B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.
444
445=item xsi_protos(@modules)
446
447This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
448
449=item xsi_body(@modules)
450
451This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
452function to B<boot_ModuleName> for each @modules.
453
454B<xsinit()> uses the xsi_* functions to generate most of it's code.
455
456=head1 EXAMPLES
457
458For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
459with embedded perl, see the eg/ directory and the I<perlembed> man page.
460
461=head1 SEE ALSO
462
463the I<perlembed> man page
464
465=head1 AUTHOR
466
467Doug MacEachern <dougm@osf.org>
468
469Based on ideas from Tim Bunce <Tim.Bunce@ig.co.uk> and
470B<minimod.pl> by Andreas Koenig <k@anna.in-berlin.de> and Tim Bunce.
471
472=cut
473
474