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