[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # $Id: Embed.pm,v 1.1.1.1 2002/01/16 19:27:19 schwern Exp $ 2 require 5.002; 3 4 package ExtUtils::Embed; 5 require Exporter; 6 require FileHandle; 7 use Config; 8 use Getopt::Std; 9 use File::Spec; 10 11 #Only when we need them 12 #require ExtUtils::MakeMaker; 13 #require ExtUtils::Liblist; 14 15 use vars qw(@ISA @EXPORT $VERSION 16 @Extensions $Verbose $lib_ext 17 $opt_o $opt_s 18 ); 19 use strict; 20 21 # This is not a dual-life module, so no need for development version numbers 22 $VERSION = '1.27'; 23 24 @ISA = qw(Exporter); 25 @EXPORT = qw(&xsinit &ldopts 26 &ccopts &ccflags &ccdlflags &perl_inc 27 &xsi_header &xsi_protos &xsi_body); 28 29 #let's have Miniperl borrow from us instead 30 #require ExtUtils::Miniperl; 31 #*canon = \&ExtUtils::Miniperl::canon; 32 33 $Verbose = 0; 34 $lib_ext = $Config{lib_ext} || '.a'; 35 36 sub is_cmd { $0 eq '-e' } 37 38 sub my_return { 39 my $val = shift; 40 if(is_cmd) { 41 print $val; 42 } 43 else { 44 return $val; 45 } 46 } 47 48 sub xsinit { 49 my($file, $std, $mods) = @_; 50 my($fh,@mods,%seen); 51 $file ||= "perlxsi.c"; 52 my $xsinit_proto = "pTHX"; 53 54 if (@_) { 55 @mods = @$mods if $mods; 56 } 57 else { 58 getopts('o:s:'); 59 $file = $opt_o if defined $opt_o; 60 $std = $opt_s if defined $opt_s; 61 @mods = @ARGV; 62 } 63 $std = 1 unless scalar @mods; 64 65 if ($file eq "STDOUT") { 66 $fh = \*STDOUT; 67 } 68 else { 69 $fh = new FileHandle "> $file"; 70 } 71 72 push(@mods, static_ext()) if defined $std; 73 @mods = grep(!$seen{$_}++, @mods); 74 75 print $fh &xsi_header(); 76 print $fh "EXTERN_C void xs_init ($xsinit_proto);\n\n"; 77 print $fh &xsi_protos(@mods); 78 79 print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n"; 80 print $fh &xsi_body(@mods); 81 print $fh "}\n"; 82 83 } 84 85 sub xsi_header { 86 return <<EOF; 87 #include <EXTERN.h> 88 #include <perl.h> 89 90 EOF 91 } 92 93 sub xsi_protos { 94 my(@exts) = @_; 95 my(@retval,%seen); 96 my $boot_proto = "pTHX_ CV* cv"; 97 foreach $_ (@exts){ 98 my($pname) = canon('/', $_); 99 my($mname, $cname); 100 ($mname = $pname) =~ s!/!::!g; 101 ($cname = $pname) =~ s!/!__!g; 102 my($ccode) = "EXTERN_C void boot_$cname} ($boot_proto);\n"; 103 next if $seen{$ccode}++; 104 push(@retval, $ccode); 105 } 106 return join '', @retval; 107 } 108 109 sub xsi_body { 110 my(@exts) = @_; 111 my($pname,@retval,%seen); 112 my($dl) = canon('/','DynaLoader'); 113 push(@retval, "\tchar *file = __FILE__;\n"); 114 push(@retval, "\tdXSUB_SYS;\n") if $] > 5.002; 115 push(@retval, "\n"); 116 117 foreach $_ (@exts){ 118 my($pname) = canon('/', $_); 119 my($mname, $cname, $ccode); 120 ($mname = $pname) =~ s!/!::!g; 121 ($cname = $pname) =~ s!/!__!g; 122 if ($pname eq $dl){ 123 # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'! 124 # boot_DynaLoader is called directly in DynaLoader.pm 125 $ccode = "\t/* DynaLoader is a special case */\n\tnewXS(\"$mname}::boot_$cname}\", boot_$cname}, file);\n"; 126 push(@retval, $ccode) unless $seen{$ccode}++; 127 } else { 128 $ccode = "\tnewXS(\"$mname}::bootstrap\", boot_$cname}, file);\n"; 129 push(@retval, $ccode) unless $seen{$ccode}++; 130 } 131 } 132 return join '', @retval; 133 } 134 135 sub static_ext { 136 unless (scalar @Extensions) { 137 my $static_ext = $Config{static_ext}; 138 $static_ext =~ s/^\s+//; 139 @Extensions = sort split /\s+/, $static_ext; 140 unshift @Extensions, qw(DynaLoader); 141 } 142 @Extensions; 143 } 144 145 sub _escape { 146 my $arg = shift; 147 $$arg =~ s/([\(\)])/\\$1/g; 148 } 149 150 sub _ldflags { 151 my $ldflags = $Config{ldflags}; 152 _escape(\$ldflags); 153 return $ldflags; 154 } 155 156 sub _ccflags { 157 my $ccflags = $Config{ccflags}; 158 _escape(\$ccflags); 159 return $ccflags; 160 } 161 162 sub _ccdlflags { 163 my $ccdlflags = $Config{ccdlflags}; 164 _escape(\$ccdlflags); 165 return $ccdlflags; 166 } 167 168 sub 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 256 sub ccflags { 257 my $ccflags = _ccflags(); 258 my_return(" $ccflags "); 259 } 260 261 sub ccdlflags { 262 my $ccdlflags = _ccdlflags(); 263 my_return(" $ccdlflags "); 264 } 265 266 sub 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 272 sub ccopts { 273 ccflags . perl_inc; 274 } 275 276 sub 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 grep(s:/:$as:, @ext) if ($as ne '/'); 285 @ext; 286 } 287 288 __END__ 289 290 =head1 NAME 291 292 ExtUtils::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 303 ExtUtils::Embed provides utility functions for embedding a Perl interpreter 304 and extensions in your C/C++ applications. 305 Typically, an application B<Makefile> will invoke ExtUtils::Embed 306 functions while building your application. 307 308 =head1 @EXPORT 309 310 ExtUtils::Embed exports the following functions: 311 312 xsinit(), ldopts(), ccopts(), perl_inc(), ccflags(), 313 ccdlflags(), xsi_header(), xsi_protos(), xsi_body() 314 315 =head1 FUNCTIONS 316 317 =over 4 318 319 =item xsinit() 320 321 Generate C/C++ code for the XS initializer function. 322 323 When invoked as C<`perl -MExtUtils::Embed -e xsinit --`> 324 the following options are recognized: 325 326 B<-o> E<lt>output filenameE<gt> (Defaults to B<perlxsi.c>) 327 328 B<-o STDOUT> will print to STDOUT. 329 330 B<-std> (Write code for extensions that are linked with the current Perl.) 331 332 Any additional arguments are expected to be names of modules 333 to generate code for. 334 335 When invoked with parameters the following are accepted and optional: 336 337 C<xsinit($filename,$std,[@modules])> 338 339 Where, 340 341 B<$filename> is equivalent to the B<-o> option. 342 343 B<$std> is boolean, equivalent to the B<-std> option. 344 345 B<[@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 353 This will generate code with an B<xs_init> function that glues the perl B<Socket::bootstrap> function 354 to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>. 355 356 Note that B<DynaLoader> is a special case where it must call B<boot_DynaLoader> directly. 357 358 perl -MExtUtils::Embed -e xsinit 359 360 361 This will generate code for linking with B<DynaLoader> and 362 each static extension found in B<$Config{static_ext}>. 363 The 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 369 Here, code is written for all the currently linked extensions along with code 370 for B<DBI> and B<DBD::Oracle>. 371 372 If you have a working B<DynaLoader> then there is rarely any need to statically link in any 373 other extensions. 374 375 =item ldopts() 376 377 Output arguments for linking the Perl library and extensions to your 378 application. 379 380 When invoked as C<`perl -MExtUtils::Embed -e ldopts --`> 381 the following options are recognized: 382 383 B<-std> 384 385 Output arguments for linking the Perl library and any extensions linked 386 with the current Perl. 387 388 B<-I> E<lt>path1:path2E<gt> 389 390 Search path for ModuleName.a archives. 391 Default path is B<@INC>. 392 Library archives are expected to be found as 393 B</some/path/auto/ModuleName/ModuleName.a> 394 For example, when looking for B<Socket.a> relative to a search path, 395 we should find B<auto/Socket/Socket.a> 396 397 When looking for B<DBD::Oracle> relative to a search path, 398 we should find B<auto/DBD/Oracle/Oracle.a> 399 400 Keep in mind that you can always supply B</my/own/path/ModuleName.a> 401 as an additional linker argument. 402 403 B<--> E<lt>list of linker argsE<gt> 404 405 Additional linker arguments to be considered. 406 407 Any additional arguments found before the B<--> token 408 are expected to be names of modules to generate code for. 409 410 When invoked with parameters the following are accepted and optional: 411 412 C<ldopts($std,[@modules],[@link_args],$path)> 413 414 Where: 415 416 B<$std> is boolean, equivalent to the B<-std> option. 417 418 B<[@modules]> is equivalent to additional arguments found before the B<--> token. 419 420 B<[@link_args]> is equivalent to arguments found after the B<--> token. 421 422 B<$path> is equivalent to the B<-I> option. 423 424 In addition, when ldopts is called with parameters, it will return the argument string 425 rather than print it to STDOUT. 426 427 =item Examples 428 429 430 perl -MExtUtils::Embed -e ldopts 431 432 433 This will print arguments for linking with B<libperl> and 434 extensions found in B<$Config{static_ext}>. This includes libraries 435 found in B<$Config{libs}> and the first ModuleName.a library 436 for each extension that is found by searching B<@INC> or the path 437 specified by the B<-I> option. 438 In addition, when ModuleName.a is found, additional linker arguments 439 are picked up from the B<extralibs.ld> file in the same directory. 440 441 442 perl -MExtUtils::Embed -e ldopts -- -std Socket 443 444 445 This 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 449 Any arguments after the second '--' token are additional linker 450 arguments that will be examined for potential conflict. If there is no 451 conflict, the additional arguments will be part of the output. 452 453 454 =item perl_inc() 455 456 For including perl header files this function simply prints: 457 458 -I$Config{archlibexp}/CORE 459 460 So, rather than having to say: 461 462 perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"' 463 464 Just say: 465 466 perl -MExtUtils::Embed -e perl_inc 467 468 =item ccflags(), ccdlflags() 469 470 These functions simply print $Config{ccflags} and $Config{ccdlflags} 471 472 =item ccopts() 473 474 This function combines perl_inc(), ccflags() and ccdlflags() into one. 475 476 =item xsi_header() 477 478 This function simply returns a string defining the same B<EXTERN_C> macro as 479 B<perlmain.c> along with #including B<perl.h> and B<EXTERN.h>. 480 481 =item xsi_protos(@modules) 482 483 This function returns a string of B<boot_$ModuleName> prototypes for each @modules. 484 485 =item xsi_body(@modules) 486 487 This function returns a string of calls to B<newXS()> that glue the module B<bootstrap> 488 function to B<boot_ModuleName> for each @modules. 489 490 B<xsinit()> uses the xsi_* functions to generate most of its code. 491 492 =back 493 494 =head1 EXAMPLES 495 496 For examples on how to use B<ExtUtils::Embed> for building C/C++ applications 497 with embedded perl, see L<perlembed>. 498 499 =head1 SEE ALSO 500 501 L<perlembed> 502 503 =head1 AUTHOR 504 505 Doug MacEachern E<lt>F<dougm@osf.org>E<gt> 506 507 Based on ideas from Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and 508 B<minimod.pl> by Andreas Koenig E<lt>F<k@anna.in-berlin.de>E<gt> and Tim Bunce. 509 510 =cut 511
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |