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