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