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