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