[Summary view] [Print] [Text view]

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