lib/ExtUtils/Embed.pm

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