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