lib/ExtUtils/Embed.pm

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