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