view release on metacpan or  search on metacpan

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

    # Ok, I give up.  Just use backticks.

    my $xsubpp = Module::Metadata->find_module_by_name('ExtUtils::xsubpp')
      or die "Can't find ExtUtils::xsubpp in INC (@INC)";

    my @typemaps;
    push @typemaps, Module::Metadata->find_module_by_name(
        'ExtUtils::typemap', \@INC
    );
    my $lib_typemap = Module::Metadata->find_module_by_name(
        'typemap', [File::Basename::dirname($file), File::Spec->rel2abs('.')]
    );
    push @typemaps, $lib_typemap if $lib_typemap;
    @typemaps = map {+'-typemap', $_} @typemaps;

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

    my @command = ($perl, "-I".$cf->get('installarchlib'), "-I".$cf->get('installprivlib'), $xsubpp, '-noprototypes',
                   @typemaps, $file);

    $self->log_info("@command\n");
    open(my $fh, '>', $args{outfile}) or die "Couldn't write $args{outfile}: $!";
    print {$fh} $self->_backticks(@command);
    close $fh;
  }
}

sub split_like_shell {
  my ($self, $string) = @_;

  return () unless defined($string);
  return @$string if ref $string eq 'ARRAY';
  $string =~ s/^\s+|\s+$//g;
  return () unless length($string);

  return Text::ParseWords::shellwords($string);
}

sub oneliner {
  # Returns a string that the shell can evaluate as a perl command.
  # This should be avoided whenever possible, since "the shell" really
  # means zillions of shells on zillions of platforms and it's really
  # hard to get it right all the time.

  # Some of this code is stolen with permission from ExtUtils::MakeMaker.

  my($self, $cmd, $switches, $args) = @_;
  $switches = [] unless defined $switches;
  $args = [] unless defined $args;

  # Strip leading and trailing newlines
  $cmd =~ s{^\n+}{};
  $cmd =~ s{\n+$}{};

  my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter;
  return $self->_quote_args($perl, @$switches, '-e', $cmd, @$args);
}

sub run_perl_script {
  my ($self, $script, $preargs, $postargs) = @_;
  foreach ($preargs, $postargs) {
    $_ = [ $self->split_like_shell($_) ] unless ref();
  }
  return $self->run_perl_command([@$preargs, $script, @$postargs]);
}

sub run_perl_command {
  # XXX Maybe we should accept @args instead of $args?  Must resolve
  # this before documenting.
  my ($self, $args) = @_;
  $args = [ $self->split_like_shell($args) ] unless ref($args);
  my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter;

  # Make sure our local additions to @INC are propagated to the subprocess
  local $ENV{PERL5LIB} = join $self->config('path_sep'), $self->_added_to_INC;

  return $self->do_system($perl, @$args);
}

# Infer various data from the path of the input filename
# that is needed to create output files.
# The input filename is expected to be of the form:
#   lib/Module/Name.ext or Module/Name.ext
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;

  $spec{base_name} = $file_base;

  $spec{src_dir} = File::Spec->catpath( $v, $d, '' );

  # the module name
  shift( @d ) while @d && ($d[0] eq 'lib' || $d[0] eq '');
  pop( @d ) while @d && $d[-1] eq '';
  $spec{module_name} = join( '::', (@d, $file_base) );

  $spec{archdir} = File::Spec->catdir($self->blib, 'arch', 'auto',
                                      @d, $file_base);

  $spec{c_file} = File::Spec->catfile( $spec{src_dir},
                                       "${file_base}.c" );

  $spec{obj_file} = File::Spec->catfile( $spec{src_dir},
                                         "${file_base}".$cf->get('obj_ext') );

  require DynaLoader;
  my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname([@d, $file_base]) : $file_base;

  $spec{bs_file} = File::Spec->catfile($spec{archdir}, "$modfname.bs");

  $spec{lib_file} = File::Spec->catfile($spec{archdir}, "$modfname.".$cf->get('dlext'));

  return \%spec;
}

sub process_xs {