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