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