lib/ExtUtils/Embed.pm

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