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