view release on metacpan or  search on metacpan

inc/inc_Module-Build/Module/Build/WithXSpp.pm  view on Meta::CPAN

use warnings;

use Module::Build;
use ExtUtils::CppGuess ();

our @ISA = qw(Module::Build);
our $VERSION = '0.12';

# TODO
# - configurable set of xsp and xspt files (and XS typemaps?)
#   => works via directories for now.
# - configurable includes/C-preamble for the XS?
#   => Works in the .xsp files, but the order of XS++ inclusion
#      is undefined.
# - configurable C++ source folder(s) (works, needs docs)
#   => to be documented another time. This is really not a feature that
#      should be commonly used.

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %args = @_;

  # This gives us the correct settings for the C++ compile (hopefully)
  my $guess = ExtUtils::CppGuess->new();
  if (defined $args{extra_compiler_flags}) {
    if (ref($args{extra_compiler_flags})) {
      $guess->add_extra_compiler_flags($_) for @{$args{extra_compiler_flags}};
    }
    else {
      $guess->add_extra_compiler_flags($args{extra_compiler_flags})
    }
    delete $args{extra_compiler_flags};
  }

  if (defined $args{extra_linker_flags}) {
    if (ref($args{extra_linker_flags})) {
      $guess->add_extra_linker_flags($_) for @{$args{extra_linker_flags}};
    }
    else {
      $guess->add_extra_linker_flags($args{extra_linker_flags})
    }
    delete $args{extra_linker_flags};
  }

  # add the typemap modules to the build dependencies
  my $build_requires = $args{build_requires}||{};
  my $extra_typemap_modules = $args{extra_typemap_modules}||{};
  # FIXME: This prevents any potential subclasses from fudging with the extra typemaps?
  foreach my $module (keys %$extra_typemap_modules) {
    if (not defined $build_requires->{$module}
        or defined($extra_typemap_modules->{$module})
           && $build_requires->{$module} < $extra_typemap_modules->{$module})
    {
      $build_requires->{$module} = $extra_typemap_modules->{$module};
    }
  }
  $args{build_requires} = $build_requires;

  # Construct object using C++ options guess
  my $self = $class->SUPER::new(
    %args,
    $guess->module_build_options # FIXME find a way to let the user override this
  );

  push @{$self->extra_compiler_flags},
    map "-I$_",
    (@{$self->cpp_source_dirs||[]}, $self->build_dir);

  $self->_init(\%args);

  return $self;
}

sub _init {
  my $self = shift;
  my $args = shift;
}

sub auto_require {
  my ($self) = @_;
  my $p = $self->{properties};

  if ($self->dist_name ne 'Module-Build-WithXSpp'
      and $self->auto_configure_requires)
  {
    if (not exists $p->{configure_requires}{'Module::Build::WithXSpp'}) {
      (my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
      $self->_add_prereq('configure_requires', 'Module::Build::WithXSpp', $ver);
    }
    if (not exists $p->{configure_requires}{'ExtUtils::CppGuess'}) {
      (my $ver = $ExtUtils::CppGuess::VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
      $self->_add_prereq('configure_requires', 'ExtUtils::CppGuess', $ver);
    }
    if (not exists $p->{build_requires}{'ExtUtils::CppGuess'}
        and eval("require ExtUtils::XSpp;")
        and defined $ExtUtils::XSpp::VERSION)
    {
      (my $ver = $ExtUtils::XSpp::VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
      $self->_add_prereq('build_requires', 'ExtUtils::XSpp', $ver);
    }
  }

  $self->SUPER::auto_require();

  return;
}

sub ACTION_create_buildarea {
  my $self = shift;
  mkdir($self->build_dir);
  $self->add_to_cleanup($self->build_dir);
}

sub ACTION_code {
  my $self = shift;
  $self->depends_on('create_buildarea');
  $self->depends_on('generate_typemap');
  $self->depends_on('generate_main_xs');

  my $files = {};
  foreach my $ext (qw(c cc cxx cpp C)) {
    foreach my $dir (@{$self->cpp_source_dirs||[]}) {
      my $this = $self->_find_file_by_type($ext, $dir);
      $files = $self->_merge_hashes($files, $this);
    }
  }

  my @objects;
  foreach my $file (keys %$files) {
    my $obj = $self->compile_c($file);
    push @objects, $obj;
    $self->add_to_cleanup($obj);
  }

  $self->{properties}{objects} ||= [];
  push @{$self->{properties}{objects}}, @objects;

  return $self->SUPER::ACTION_code(@_);
}

# I guess I should use a module here.
sub _naive_shell_escape {
  my $s = shift;
  $s =~ s/\\/\\\\/g;
  $s =~ s/"/\\"/g;
  $s
}

sub ACTION_generate_main_xs {
  my $self = shift;

  my $xs_files = $self->find_xs_files;
  my $main_xs_file = File::Spec->catfile($self->build_dir, 'main.xs');

  if (keys(%$xs_files) > 1) {
    # user knows what she's doing, do not generate XS
    $self->log_info("Found custom XS files. Not auto-generating main XS file...\n");
    return 1;
  }

  my $xsp_files = $self->find_xsp_files;
  my $xspt_files = $self->find_xsp_typemaps;

  my $newest = $self->_calc_newest(
    keys(%$xsp_files),
    keys(%$xspt_files),
    'Build.PL',
    File::Spec->catdir($self->build_dir, 'typemap'),
  );

  if (keys(%$xs_files) == 1
      && (values(%$xs_files))[0] =~ /\Q$main_xs_file\E$/)
  {
    # is main xs file still current?
    if (-M $main_xs_file < $newest) {
      return 1;
    }
  }

  $self->log_info("Generating main XS file...\n");

  my $early_includes = join "\n",
                       map {
                         s/^\s*#\s*include\s*//i;
                         /^"/ or $_ = "<$_>";
                         "#include $_"
                       }
                       @{ $self->early_includes || [] };

  my $module_name = $self->module_name;
  my $xs_code = <<"HERE";
/*
 * WARNING: This file was auto-generated. Changes will be lost!
 */

$early_includes

#ifdef __cplusplus

inc/inc_Module-Build/Module/Build/WithXSpp.pm  view on Meta::CPAN

                    map File::Spec->catfile($_, '*.map'),
                    (@{$self->extra_xs_dirs||[]});

  $files->{$_} = $_ foreach map $self->localize_file_path($_),
                            @extra_files;

  $files->{'typemap'} = 'typemap' if -f 'typemap';

  return $files;
}


sub find_xsp_files  {
  my $self = shift;

  my @extra_files = map glob($_),
                    map File::Spec->catfile($_, '*.xsp'),
                    (@{$self->extra_xs_dirs||[]});

  my $files = $self->_find_file_by_type('xsp', 'lib');
  $files->{$_} = $_ foreach map $self->localize_file_path($_),
                            @extra_files;

  require File::Basename;
  # XS++ typemaps aren't XSP files in this regard
  foreach my $file (keys %$files) {
    delete $files->{$file}
      if File::Basename::basename($file) eq 'typemap.xsp';
  }

  return $files;
}

sub find_xsp_typemaps {
  my $self = shift;

  my $xsp_files = $self->_find_file_by_type('xsp', 'lib');
  my $xspt_files = $self->_find_file_by_type('xspt', 'lib');

  foreach (keys %$xsp_files) { # merge over 'typemap.xsp's
    next unless File::Basename::basename($_) eq 'typemap.xsp';
    $xspt_files->{$_} = $_
  }

  my @extra_files = grep -e $_,
                    map glob($_),
                    grep defined $_ && /\S/,
                    map { ( File::Spec->catfile($_, 'typemap.xsp'),
                            File::Spec->catfile($_, '*.xspt') ) }
                    @{$self->extra_xs_dirs||[]};
  $xspt_files->{$_} = $_ foreach map $self->localize_file_path($_),
                                 @extra_files;
  return $xspt_files;
}


# This overrides the equivalent in the base class to add the buildtmp and
# the main directory
sub find_xs_files {
  my $self = shift;
  my $xs_files = $self->SUPER::find_xs_files;

  my @extra_files = map glob($_),
                    map File::Spec->catfile($_, '*.xs'),
                    @{$self->extra_xs_dirs||[]};

  $xs_files->{$_} = $_ foreach map $self->localize_file_path($_),
                               @extra_files;

  my $auto_gen_file = File::Spec->catfile($self->build_dir, 'main.xs');
  if (-e $auto_gen_file) {
    $xs_files->{$auto_gen_file} =  $self->localize_file_path($auto_gen_file);
  }
  return $xs_files;
}


# overridden from original. We really require
# EU::ParseXS, so the "if (eval{require EU::PXS})" is gone.
sub compile_xs {
  my ($self, $file, %args) = @_;
  $self->log_verbose("$file -> $args{outfile}\n");

  require ExtUtils::ParseXS;

  my $main_dir = Cwd::abs_path( Cwd::cwd() );
  my $build_dir = Cwd::abs_path( $self->build_dir );
  ExtUtils::ParseXS::process_file(
    filename   => $file,
    prototypes => 0,
    output     => $args{outfile},
    # not default:
    'C++' => 1,
    hiertype => 1,
    typemap    => File::Spec->catfile($build_dir, 'typemap'),
  );
}

# modified from orinal M::B (FIXME: shouldn't do this with private methods)
# Changes from the original:
# - If we're looking at the "main.xs" file in the build
#   directory, override the TARGET paths with the real
#   module name.
# - In that case, also override the file basename for further
#   build products (maybe this should only be done on installation
#   into blib/.../?)
sub _infer_xs_spec {
  my $self = shift;
  my $file = shift;

  my $cf = $self->{config};

  my %spec;

  my( $v, $d, $f ) = File::Spec->splitpath( $file );
  my @d = File::Spec->splitdir( $d );
  (my $file_base = $f) =~ s/\.[^.]+$//i;

  my $build_folder = $self->build_dir;
  if ($d =~ /\Q$build_folder\E/ && $file_base eq 'main') {
    my $name = $self->module_name;