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