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