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