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.32'; 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 -std DBI DBD::Oracle 354 355Here, code is written for all the currently linked extensions along with code 356for C<DBI> and C<DBD::Oracle>. 357 358If you have a working C<DynaLoader> then there is rarely any need to statically link in any 359other extensions. 360 361=item ldopts() 362 363Output arguments for linking the Perl library and extensions to your 364application. 365 366When invoked as C<`perl -MExtUtils::Embed -e ldopts --`> 367the following options are recognized: 368 369B<-std> 370 371Output arguments for linking the Perl library and any extensions linked 372with the current Perl. 373 374B<-I> E<lt>path1:path2E<gt> 375 376Search path for ModuleName.a archives. 377Default path is C<@INC>. 378Library archives are expected to be found as 379F</some/path/auto/ModuleName/ModuleName.a> 380For example, when looking for F<Socket.a> relative to a search path, 381we should find F<auto/Socket/Socket.a> 382 383When looking for C<DBD::Oracle> relative to a search path, 384we should find F<auto/DBD/Oracle/Oracle.a> 385 386Keep in mind that you can always supply F</my/own/path/ModuleName.a> 387as an additional linker argument. 388 389B<--> E<lt>list of linker argsE<gt> 390 391Additional linker arguments to be considered. 392 393Any additional arguments found before the B<--> token 394are expected to be names of modules to generate code for. 395 396When invoked with parameters the following are accepted and optional: 397 398C<ldopts($std,[@modules],[@link_args],$path)> 399 400Where: 401 402B<$std> is boolean, equivalent to the B<-std> option. 403 404B<[@modules]> is equivalent to additional arguments found before the B<--> token. 405 406B<[@link_args]> is equivalent to arguments found after the B<--> token. 407 408B<$path> is equivalent to the B<-I> option. 409 410In addition, when ldopts is called with parameters, it will return the argument string 411rather than print it to STDOUT. 412 413=item Examples 414 415 perl -MExtUtils::Embed -e ldopts 416 417This will print arguments for linking with C<libperl> and 418extensions found in C<$Config{static_ext}>. This includes libraries 419found in C<$Config{libs}> and the first ModuleName.a library 420for each extension that is found by searching C<@INC> or the path 421specified by the B<-I> option. 422In addition, when ModuleName.a is found, additional linker arguments 423are picked up from the F<extralibs.ld> file in the same directory. 424 425 perl -MExtUtils::Embed -e ldopts -- -std Socket 426 427This will do the same as the above example, along with printing additional arguments for linking with the C<Socket> extension. 428 429 perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql 430 431Any arguments after the second '--' token are additional linker 432arguments that will be examined for potential conflict. If there is no 433conflict, the additional arguments will be part of the output. 434 435=item perl_inc() 436 437For including perl header files this function simply prints: 438 439 -I$Config{archlibexp}/CORE 440 441So, rather than having to say: 442 443 perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"' 444 445Just say: 446 447 perl -MExtUtils::Embed -e perl_inc 448 449=item ccflags(), ccdlflags() 450 451These functions simply print $Config{ccflags} and $Config{ccdlflags} 452 453=item ccopts() 454 455This function combines C<perl_inc()>, C<ccflags()> and C<ccdlflags()> into one. 456 457=item xsi_header() 458 459This function simply returns a string defining the same C<EXTERN_C> macro as 460F<perlmain.c> along with #including F<perl.h> and F<EXTERN.h>. 461 462=item xsi_protos(@modules) 463 464This function returns a string of C<boot_$ModuleName> prototypes for each @modules. 465 466=item xsi_body(@modules) 467 468This function returns a string of calls to C<newXS()> that glue the module I<bootstrap> 469function to I<boot_ModuleName> for each @modules. 470 471C<xsinit()> uses the xsi_* functions to generate most of its code. 472 473=back 474 475=head1 EXAMPLES 476 477For examples on how to use C<ExtUtils::Embed> for building C/C++ applications 478with embedded perl, see L<perlembed>. 479 480=head1 SEE ALSO 481 482L<perlembed> 483 484=head1 AUTHOR 485 486Doug MacEachern E<lt>C<dougm@osf.org>E<gt> 487 488Based on ideas from Tim Bunce E<lt>C<Tim.Bunce@ig.co.uk>E<gt> and 489F<minimod.pl> by Andreas Koenig E<lt>C<k@anna.in-berlin.de>E<gt> and Tim Bunce. 490 491=cut 492