lib/perl5/5.8.8/ExtUtils/Embed.pm

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