ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/staticperl/perl/lib/ExtUtils/Embed.pm
Revision: 1.1
Committed: Thu Jun 30 14:27:10 2005 UTC (21 years, 4 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# Content
1 # $Id: Embed.pm,v 1.1.1.1 2002/01/16 19:27:19 schwern Exp $
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 = 1.2506_01;
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 _escape {
143 my $arg = shift;
144 $$arg =~ s/([\(\)])/\\$1/g;
145 }
146
147 sub _ldflags {
148 my $ldflags = $Config{ldflags};
149 _escape(\$ldflags);
150 return $ldflags;
151 }
152
153 sub _ccflags {
154 my $ccflags = $Config{ccflags};
155 _escape(\$ccflags);
156 return $ccflags;
157 }
158
159 sub _ccdlflags {
160 my $ccdlflags = $Config{ccdlflags};
161 _escape(\$ccdlflags);
162 return $ccdlflags;
163 }
164
165 sub ldopts {
166 require ExtUtils::MakeMaker;
167 require ExtUtils::Liblist;
168 my($std,$mods,$link_args,$path) = @_;
169 my(@mods,@link_args,@argv);
170 my($dllib,$config_libs,@potential_libs,@path);
171 local($") = ' ' unless $" eq ' ';
172 if (scalar @_) {
173 @link_args = @$link_args if $link_args;
174 @mods = @$mods if $mods;
175 }
176 else {
177 @argv = @ARGV;
178 #hmm
179 while($_ = shift @argv) {
180 /^-std$/ && do { $std = 1; next; };
181 /^--$/ && do { @link_args = @argv; last; };
182 /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
183 push(@mods, $_);
184 }
185 }
186 $std = 1 unless scalar @link_args;
187 my $sep = $Config{path_sep} || ':';
188 @path = $path ? split(/\Q$sep/, $path) : @INC;
189
190 push(@potential_libs, @link_args) if scalar @link_args;
191 # makemaker includes std libs on windows by default
192 if ($^O ne 'MSWin32' and defined($std)) {
193 push(@potential_libs, $Config{perllibs});
194 }
195
196 push(@mods, static_ext()) if $std;
197
198 my($mod,@ns,$root,$sub,$extra,$archive,@archives);
199 print STDERR "Searching (@path) for archives\n" if $Verbose;
200 foreach $mod (@mods) {
201 @ns = split(/::|\/|\\/, $mod);
202 $sub = $ns[-1];
203 $root = File::Spec->catdir(@ns);
204
205 print STDERR "searching for '$sub${lib_ext}'\n" if $Verbose;
206 foreach (@path) {
207 next unless -e ($archive = File::Spec->catdir($_,"auto",$root,"$sub$lib_ext"));
208 push @archives, $archive;
209 if(-e ($extra = File::Spec->catdir($_,"auto",$root,"extralibs.ld"))) {
210 local(*FH);
211 if(open(FH, $extra)) {
212 my($libs) = <FH>; chomp $libs;
213 push @potential_libs, split /\s+/, $libs;
214 }
215 else {
216 warn "Couldn't open '$extra'";
217 }
218 }
219 last;
220 }
221 }
222 #print STDERR "\@potential_libs = @potential_libs\n";
223
224 my $libperl;
225 if ($^O eq 'MSWin32') {
226 $libperl = $Config{libperl};
227 }
228 else {
229 $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl";
230 }
231
232 my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
233 $lpath = qq["$lpath"] if $^O eq 'MSWin32';
234 my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
235 MM->ext(join ' ', "-L$lpath", $libperl, @potential_libs);
236
237 my $ld_or_bs = $bsloadlibs || $ldloadlibs;
238 print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
239 my $ccdlflags = _ccdlflags();
240 my $ldflags = _ldflags();
241 my $linkage = "$ccdlflags $ldflags @archives $ld_or_bs";
242 print STDERR "ldopts: '$linkage'\n" if $Verbose;
243
244 return $linkage if scalar @_;
245 my_return("$linkage\n");
246 }
247
248 sub ccflags {
249 my $ccflags = _ccflags();
250 my_return(" $ccflags ");
251 }
252
253 sub ccdlflags {
254 my $ccdlflags = _ccdlflags();
255 my_return(" $ccdlflags ");
256 }
257
258 sub perl_inc {
259 my $dir = File::Spec->catdir($Config{archlibexp}, 'CORE');
260 $dir = qq["$dir"] if $^O eq 'MSWin32';
261 my_return(" -I$dir ");
262 }
263
264 sub ccopts {
265 ccflags . perl_inc;
266 }
267
268 sub canon {
269 my($as, @ext) = @_;
270 foreach(@ext) {
271 # might be X::Y or lib/auto/X/Y/Y.a
272 next if s!::!/!g;
273 s:^(lib|ext)/(auto/)?::;
274 s:/\w+\.\w+$::;
275 }
276 grep(s:/:$as:, @ext) if ($as ne '/');
277 @ext;
278 }
279
280 __END__
281
282 =head1 NAME
283
284 ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
285
286 =head1 SYNOPSIS
287
288
289 perl -MExtUtils::Embed -e xsinit
290 perl -MExtUtils::Embed -e ccopts
291 perl -MExtUtils::Embed -e ldopts
292
293 =head1 DESCRIPTION
294
295 ExtUtils::Embed provides utility functions for embedding a Perl interpreter
296 and extensions in your C/C++ applications.
297 Typically, an application B<Makefile> will invoke ExtUtils::Embed
298 functions while building your application.
299
300 =head1 @EXPORT
301
302 ExtUtils::Embed exports the following functions:
303
304 xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(),
305 ccdlflags(), xsi_header(), xsi_protos(), xsi_body()
306
307 =head1 FUNCTIONS
308
309 =over 4
310
311 =item xsinit()
312
313 Generate C/C++ code for the XS initializer function.
314
315 When invoked as C<`perl -MExtUtils::Embed -e xsinit --`>
316 the following options are recognized:
317
318 B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>)
319
320 B<-o STDOUT> will print to STDOUT.
321
322 B<-std> (Write code for extensions that are linked with the current Perl.)
323
324 Any additional arguments are expected to be names of modules
325 to generate code for.
326
327 When invoked with parameters the following are accepted and optional:
328
329 C<xsinit($filename,$std,[@modules])>
330
331 Where,
332
333 B<$filename> is equivalent to the B<-o> option.
334
335 B<$std> is boolean, equivalent to the B<-std> option.
336
337 B<[@modules]> is an array ref, same as additional arguments mentioned above.
338
339 =item Examples
340
341
342 perl -MExtUtils::Embed -e xsinit -- -o xsinit.c Socket
343
344
345 This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function
346 to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>.
347
348 Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly.
349
350 perl -MExtUtils::Embed -e xsinit
351
352
353 This will generate code for linking with B<DynaLoader> and
354 each static extension found in B<$Config{static_ext}>.
355 The code is written to the default file name B<perlxsi.c>.
356
357
358 perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle
359
360
361 Here, code is written for all the currently linked extensions along with code
362 for B<DBI> and B<DBD::Oracle>.
363
364 If you have a working B<DynaLoader> then there is rarely any need to statically link in any
365 other extensions.
366
367 =item ldopts()
368
369 Output arguments for linking the Perl library and extensions to your
370 application.
371
372 When invoked as C<`perl -MExtUtils::Embed -e ldopts --`>
373 the following options are recognized:
374
375 B<-std>
376
377 Output arguments for linking the Perl library and any extensions linked
378 with the current Perl.
379
380 B<-I> E<lt>path1:path2E<gt>
381
382 Search path for ModuleName.a archives.
383 Default path is B<@INC>.
384 Library archives are expected to be found as
385 B</some/path/auto/ModuleName/ModuleName.a>
386 For example, when looking for B<Socket.a> relative to a search path,
387 we should find B<auto/Socket/Socket.a>
388
389 When looking for B<DBD::Oracle> relative to a search path,
390 we should find B<auto/DBD/Oracle/Oracle.a>
391
392 Keep in mind that you can always supply B</my/own/path/ModuleName.a>
393 as an additional linker argument.
394
395 B<--> E<lt>list of linker argsE<gt>
396
397 Additional linker arguments to be considered.
398
399 Any additional arguments found before the B<--> token
400 are expected to be names of modules to generate code for.
401
402 When invoked with parameters the following are accepted and optional:
403
404 C<ldopts($std,[@modules],[@link_args],$path)>
405
406 Where:
407
408 B<$std> is boolean, equivalent to the B<-std> option.
409
410 B<[@modules]> is equivalent to additional arguments found before the B<--> token.
411
412 B<[@link_args]> is equivalent to arguments found after the B<--> token.
413
414 B<$path> is equivalent to the B<-I> option.
415
416 In addition, when ldopts is called with parameters, it will return the argument string
417 rather than print it to STDOUT.
418
419 =item Examples
420
421
422 perl -MExtUtils::Embed -e ldopts
423
424
425 This will print arguments for linking with B<libperl.a>, B<DynaLoader> and
426 extensions found in B<$Config{static_ext}>. This includes libraries
427 found in B<$Config{libs}> and the first ModuleName.a library
428 for each extension that is found by searching B<@INC> or the path
429 specified by the B<-I> option.
430 In addition, when ModuleName.a is found, additional linker arguments
431 are picked up from the B<extralibs.ld> file in the same directory.
432
433
434 perl -MExtUtils::Embed -e ldopts -- -std Socket
435
436
437 This will do the same as the above example, along with printing additional arguments for linking with the B<Socket> extension.
438
439
440 perl -MExtUtils::Embed -e ldopts -- DynaLoader
441
442
443 This will print arguments for linking with just the B<DynaLoader> extension
444 and B<libperl.a>.
445
446
447 perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql
448
449
450 Any arguments after the second '--' token are additional linker
451 arguments that will be examined for potential conflict. If there is no
452 conflict, the additional arguments will be part of the output.
453
454
455 =item perl_inc()
456
457 For including perl header files this function simply prints:
458
459 -I$Config{archlibexp}/CORE
460
461 So, rather than having to say:
462
463 perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"'
464
465 Just say:
466
467 perl -MExtUtils::Embed -e perl_inc
468
469 =item ccflags(), ccdlflags()
470
471 These functions simply print $Config{ccflags} and $Config{ccdlflags}
472
473 =item ccopts()
474
475 This function combines perl_inc(), ccflags() and ccdlflags() into one.
476
477 =item xsi_header()
478
479 This function simply returns a string defining the same B<EXTERN_C> macro as
480 B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>.
481
482 =item xsi_protos(@modules)
483
484 This function returns a string of B<boot_$ModuleName> prototypes for each @modules.
485
486 =item xsi_body(@modules)
487
488 This function returns a string of calls to B<newXS()> that glue the module B<bootstrap>
489 function to B<boot_ModuleName> for each @modules.
490
491 B<xsinit()> uses the xsi_* functions to generate most of its code.
492
493 =back
494
495 =head1 EXAMPLES
496
497 For examples on how to use B<ExtUtils::Embed> for building C/C++ applications
498 with embedded perl, see L<perlembed>.
499
500 =head1 SEE ALSO
501
502 L<perlembed>
503
504 =head1 AUTHOR
505
506 Doug MacEachern E<lt>F<dougm@osf.org>E<gt>
507
508 Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and
509 B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce.
510
511 =cut
512