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