lib/ExtUtils/Embed.pm

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