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