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