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     my $MM = bless {} => 'MY';
 150     if (scalar @_) {
 151        @link_args = @$link_args if $link_args;
 152        @mods = @$mods if $mods;
 153     }
 154     else {
 155        @argv = @ARGV;
 156        #hmm
 157        while($_ = shift @argv) {
 158            /^-std$/  && do { $std = 1; next; };
 159            /^--$/    && do { @link_args = @argv; last; };
 160            /^-I(.*)/ && do { $path = $1 || shift @argv; next; };
 161            push(@mods, $_);
 162        }
 163     }
 164     $std = 1 unless scalar @link_args;
 165     my $sep = $Config{path_sep} || ':';
 166     @path = $path ? split(/\Q$sep/, $path) : @INC;
 167
 168     push(@potential_libs, @link_args)    if scalar @link_args;
 169     # makemaker includes std libs on windows by default
 170     if ($^O ne 'MSWin32' and defined($std)) {
 171         push(@potential_libs, $Config{perllibs});
 172     }
 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;
 203     if ($^O eq 'MSWin32') {
 204         $libperl = $Config{libperl};
 205     }
 206     else {
 207         $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl";
 208     }
 209
 210     my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
 211     $lpath = qq["$lpath"] if $^O eq 'MSWin32';
 212     my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) =
 213         $MM->ext(join ' ', "-L$lpath", $libperl, @potential_libs);
 214
 215     my $ld_or_bs = $bsloadlibs || $ldloadlibs;
 216     print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose;
 217     my $linkage = "$Config{ccdlflags} $Config{ldflags} @archives $ld_or_bs";
 218     print STDERR "ldopts: '$linkage'\n" if $Verbose;
 219
 220     return $linkage if scalar @_;
 221     my_return("$linkage\n");
 222 }
 223
 224 sub ccflags {
 225     my_return(" $Config{ccflags} ");
 226 }
 227
 228 sub ccdlflags {
 229     my_return(" $Config{ccdlflags} ");
 230 }
 231
 232 sub perl_inc {
 233     my $dir = File::Spec->catdir($Config{archlibexp}, 'CORE');
 234     $dir = qq["$dir"] if $^O eq 'MSWin32';
 235     my_return(" -I$dir ");
 236 }
 237
 238 sub ccopts {
 239    ccflags . perl_inc;
 240 }
 241
 242 sub canon {
 243     my($as, @ext) = @_;
 244     foreach(@ext) {
 245        # might be X::Y or lib/auto/X/Y/Y.a
 246        next if s!::!/!g;
 247        s:^(lib|ext)/(auto/)?::;
 248        s:/\w+\.\w+$::;
 249     }
 250     grep(s:/:$as:, @ext) if ($as ne '/');
 251     @ext;
 252 }
 253
 254 __END__
 255
 256 =head1 NAME
 257
 258 ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications
 259
 260 =head1 SYNOPSIS
 261
 262
 263  perl -MExtUtils::Embed -e xsinit
 264  perl -MExtUtils::Embed -e ccopts
 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 4
 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 F<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 that 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 specified 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 its 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 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