lib/ExtUtils/Embed.pm

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