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