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