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