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