Alien-V8

 view release on metacpan or  search on metacpan

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

}

sub current {
  # hmm, wonder what the right thing to do here is
  local @ARGV;
  return shift()->resume;
}

sub _construct {
  my ($package, %input) = @_;

  my $args   = delete $input{args}   || {};
  my $config = delete $input{config} || {};

  my $self = bless {
		    args => {%$args},
		    config => Module::Build::Config->new(values => $config),
		    properties => {
				   base_dir        => $package->cwd,
				   mb_version      => $Module::Build::VERSION,
				   %input,
				  },
		    phash => {},
                    stash => {}, # temporary caching, not stored in _build
		   }, $package;

  $self->_set_defaults;
  my ($p, $ph) = ($self->{properties}, $self->{phash});

  foreach (qw(notes config_data features runtime_params cleanup auto_features)) {
    my $file = File::Spec->catfile($self->config_dir, $_);
    $ph->{$_} = Module::Build::Notes->new(file => $file);
    $ph->{$_}->restore if -e $file;
    if (exists $p->{$_}) {
      my $vals = delete $p->{$_};
      while (my ($k, $v) = each %$vals) {
	$self->$_($k, $v);
      }
    }
  }

  # The following warning could be unnecessary if the user is running
  # an embedded perl, but there aren't too many of those around, and
  # embedded perls aren't usually used to install modules, and the
  # installation process sometimes needs to run external scripts
  # (e.g. to run tests).
  $p->{perl} = $self->find_perl_interpreter
    or $self->log_warn("Warning: Can't locate your perl binary");

  my $blibdir = sub { File::Spec->catdir($p->{blib}, @_) };
  $p->{bindoc_dirs} ||= [ $blibdir->("script") ];
  $p->{libdoc_dirs} ||= [ $blibdir->("lib"), $blibdir->("arch") ];

  $p->{dist_author} = [ $p->{dist_author} ] if defined $p->{dist_author} and not ref $p->{dist_author};

  # Synonyms
  $p->{requires} = delete $p->{prereq} if defined $p->{prereq};
  $p->{script_files} = delete $p->{scripts} if defined $p->{scripts};

  # Convert to from shell strings to arrays
  for ('extra_compiler_flags', 'extra_linker_flags') {
    $p->{$_} = [ $self->split_like_shell($p->{$_}) ] if exists $p->{$_};
  }

  # Convert to arrays
  for ('include_dirs') {
    $p->{$_} = [ $p->{$_} ] if exists $p->{$_} && !ref $p->{$_}
  }

  $self->add_to_cleanup( @{delete $p->{add_to_cleanup}} )
    if $p->{add_to_cleanup};

  return $self;
}

################## End constructors #########################

sub log_info {
  my $self = shift;
  print @_ unless(ref($self) and $self->quiet);
}
sub log_verbose {
  my $self = shift;
  $self->log_info(@_) if(ref($self) and $self->verbose);
}
sub log_debug {
  my $self = shift;
  print @_ if ref $self && $self->debug;
}

sub log_warn {
  # Try to make our call stack invisible
  shift;
  if (@_ and $_[-1] !~ /\n$/) {
    my (undef, $file, $line) = caller();
    warn @_, " at $file line $line.\n";
  } else {
    warn @_;
  }
}


# install paths must be generated when requested to be sure all changes
# to config (from various sources) are included
sub _default_install_paths {
  my $self = shift;
  my $c = $self->{config};
  my $p = {};

  my @libstyle = $c->get('installstyle') ?
      File::Spec->splitdir($c->get('installstyle')) : qw(lib perl5);
  my $arch     = $c->get('archname');
  my $version  = $c->get('version');

  my $bindoc  = $c->get('installman1dir') || undef;
  my $libdoc  = $c->get('installman3dir') || undef;

  my $binhtml = $c->get('installhtml1dir') || $c->get('installhtmldir') || undef;
  my $libhtml = $c->get('installhtml3dir') || $c->get('installhtmldir') || undef;

  $p->{install_sets} =

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

__PACKAGE__->add_property(test_file_exts => ['.t']);
__PACKAGE__->add_property(use_tap_harness => 0);
__PACKAGE__->add_property(cpan_client => 'cpan');
__PACKAGE__->add_property(tap_harness_args => {});
__PACKAGE__->add_property(
  'installdirs',
  default => 'site',
  check   => sub {
    return 1 if /^(core|site|vendor)$/;
    return shift->property_error(
      $_ eq 'perl'
      ? 'Perhaps you meant installdirs to be "core" rather than "perl"?'
      : 'installdirs must be one of "core", "site", or "vendor"'
    );
    return shift->property_error("Perhaps you meant 'core'?") if $_ eq 'perl';
    return 0;
  },
);

{
  my $Is_ActivePerl = eval {require ActivePerl::DocTools};
  __PACKAGE__->add_property(html_css => $Is_ActivePerl ? 'Active.css' : '');
}

{
  my @prereq_action_types = qw(requires build_requires conflicts recommends);
  foreach my $type (@prereq_action_types) {
    __PACKAGE__->add_property($type => {});
  }
  __PACKAGE__->add_property(prereq_action_types => \@prereq_action_types);
}

__PACKAGE__->add_property($_ => {}) for qw(
  get_options
  install_base_relpaths
  install_path
  install_sets
  meta_add
  meta_merge
  original_prefix
  prefix_relpaths
  configure_requires
);

__PACKAGE__->add_property($_) for qw(
  PL_files
  autosplit
  base_dir
  bindoc_dirs
  c_source
  create_license
  create_makefile_pl
  create_readme
  debugger
  destdir
  dist_abstract
  dist_author
  dist_name
  dist_version
  dist_version_from
  extra_compiler_flags
  extra_linker_flags
  has_config_data
  install_base
  libdoc_dirs
  magic_number
  mb_version
  module_name
  needs_compiler
  orig_dir
  perl
  pm_files
  pod_files
  pollute
  prefix
  program_name
  quiet
  recursive_test_files
  script_files
  scripts
  share_dir
  sign
  test_files
  verbose
  debug
  xs_files
);

sub config {
  my $self = shift;
  my $c = ref($self) ? $self->{config} : 'Module::Build::Config';
  return $c->all_config unless @_;

  my $key = shift;
  return $c->get($key) unless @_;

  my $val = shift;
  return $c->set($key => $val);
}

sub mb_parents {
    # Code borrowed from Class::ISA.
    my @in_stack = (shift);
    my %seen = ($in_stack[0] => 1);

    my ($current, @out);
    while (@in_stack) {
        next unless defined($current = shift @in_stack)
          && $current->isa('Module::Build::Base');
        push @out, $current;
        next if $current eq 'Module::Build::Base';
        no strict 'refs';
        unshift @in_stack,
          map {
              my $c = $_; # copy, to avoid being destructive
              substr($c,0,2) = "main::" if substr($c,0,2) eq '::';
              # Canonize the :: -> main::, ::foo -> main::foo thing.
              # Should I ever canonize the Foo'Bar = Foo::Bar thing?
              $seen{$c}++ ? () : $c;
          } @{"$current\::ISA"};

        # I.e., if this class has any parents (at least, ones I've never seen
        # before), push them, in order, onto the stack of classes I need to
        # explore.
    }
    shift @out;
    return @out;
}

sub extra_linker_flags   { shift->_list_accessor('extra_linker_flags',   @_) }
sub extra_compiler_flags { shift->_list_accessor('extra_compiler_flags', @_) }

sub _list_accessor {
  (my $self, local $_) = (shift, shift);
  my $p = $self->{properties};
  $p->{$_} = [@_] if @_;
  $p->{$_} = [] unless exists $p->{$_};
  return ref($p->{$_}) ? $p->{$_} : [$p->{$_}];
}

# XXX Problem - if Module::Build is loaded from a different directory,
# it'll look for (and perhaps destroy/create) a _build directory.
sub subclass {
  my ($pack, %opts) = @_;

  my $build_dir = '_build'; # XXX The _build directory is ostensibly settable by the user.  Shouldn't hard-code here.
  $pack->delete_filetree($build_dir) if -e $build_dir;

  die "Must provide 'code' or 'class' option to subclass()\n"
    unless $opts{code} or $opts{class};

  $opts{code}  ||= '';
  $opts{class} ||= 'MyModuleBuilder';

  my $filename = File::Spec->catfile($build_dir, 'lib', split '::', $opts{class}) . '.pm';
  my $filedir  = File::Basename::dirname($filename);
  $pack->log_verbose("Creating custom builder $filename in $filedir\n");

  File::Path::mkpath($filedir);
  die "Can't create directory $filedir: $!" unless -d $filedir;

  my $fh = IO::File->new("> $filename") or die "Can't create $filename: $!";
  print $fh <<EOF;
package $opts{class};
use $pack;
\@ISA = qw($pack);
$opts{code}
1;
EOF
  close $fh;

  unshift @INC, File::Spec->catdir(File::Spec->rel2abs($build_dir), 'lib');
  eval "use $opts{class}";
  die $@ if $@;

  return $opts{class};
}

sub _guess_module_name {
  my $self = shift;
  my $p = $self->{properties};
  return if $p->{module_name};
  if ( $p->{dist_version_from} && -e $p->{dist_version_from} ) {
    my $mi = Module::Build::ModuleInfo->new_from_file($self->dist_version_from);
    $p->{module_name} = $mi->name;
  }
  else {
    my $mod_path = my $mod_name = $p->{dist_name};
    $mod_name =~ s{-}{::}g;
    $mod_path =~ s{-}{/}g;
    $mod_path .= ".pm";

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

    # XXX Should we let Getopt::Long handle M::B's options? That would
    # be easy-ish to add to @specs right here, but wouldn't handle options
    # passed without "--" as M::B currently allows. We might be able to
    # get around this by setting the "prefix_pattern" Configure option.
    my @specs;
    my $args = {};
    # Construct the specifications for GetOptions.
    while (my ($k, $v) = each %$specs) {
        # Throw an error if specs conflict with our own.
        die "Option specification '$k' conflicts with a " . ref $self
          . " option of the same name"
          if $self->valid_property($k);
        push @specs, $k . (defined $v->{type} ? $v->{type} : '');
        push @specs, $v->{store} if exists $v->{store};
        $args->{$k} = $v->{default} if exists $v->{default};
    }

    local @ARGV = @argv; # No other way to dupe Getopt::Long

    # Get the options values and return them.
    # XXX Add option to allow users to set options?
    if ( @specs ) {
      Getopt::Long::Configure('pass_through');
      Getopt::Long::GetOptions($args, @specs);
    }

    return $args, @ARGV;
}

sub unparse_args {
  my ($self, $args) = @_;
  my @out;
  while (my ($k, $v) = each %$args) {
    push @out, (UNIVERSAL::isa($v, 'HASH')  ? map {+"--$k", "$_=$v->{$_}"} keys %$v :
		UNIVERSAL::isa($v, 'ARRAY') ? map {+"--$k", $_} @$v :
		("--$k", $v));
  }
  return @out;
}

sub args {
    my $self = shift;
    return wantarray ? %{ $self->{args} } : $self->{args} unless @_;
    my $key = shift;
    $self->{args}{$key} = shift if @_;
    return $self->{args}{$key};
}

# allows select parameters (with underscores) to be spoken with dashes
# when used as command-line options
sub _translate_option {
  my $self = shift;
  my $opt  = shift;

  (my $tr_opt = $opt) =~ tr/-/_/;

  return $tr_opt if grep $tr_opt =~ /^(?:no_?)?$_$/, qw(
    create_license
    create_makefile_pl
    create_readme
    extra_compiler_flags
    extra_linker_flags
    html_css
    install_base
    install_path
    meta_add
    meta_merge
    test_files
    use_rcfile
    use_tap_harness
    tap_harness_args
    cpan_client
  ); # normalize only selected option names

  return $opt;
}

sub _read_arg {
  my ($self, $args, $key, $val) = @_;

  $key = $self->_translate_option($key);

  if ( exists $args->{$key} ) {
    $args->{$key} = [ $args->{$key} ] unless ref $args->{$key};
    push @{$args->{$key}}, $val;
  } else {
    $args->{$key} = $val;
  }
}

# decide whether or not an option requires/has an operand
sub _optional_arg {
  my $self = shift;
  my $opt  = shift;
  my $argv = shift;

  $opt = $self->_translate_option($opt);

  my @bool_opts = qw(
    build_bat
    create_license
    create_readme
    pollute
    quiet
    uninst
    use_rcfile
    verbose
    debug
    sign
    use_tap_harness
  );

  # inverted boolean options; eg --noverbose or --no-verbose
  # converted to proper name & returned with false value (verbose, 0)
  if ( grep $opt =~ /^no[-_]?$_$/, @bool_opts ) {
    $opt =~ s/^no-?//;
    return ($opt, 0);
  }

  # non-boolean option; return option unchanged along with its argument
  return ($opt, shift(@$argv)) unless grep $_ eq $opt, @bool_opts;

  # we're punting a bit here, if an option appears followed by a digit
  # we take the digit as the argument for the option. If there is
  # nothing that looks like a digit, we pretend the option is a flag
  # that is being set and has no argument.
  my $arg = 1;
  $arg = shift(@$argv) if @$argv && $argv->[0] =~ /^\d+$/;

  return ($opt, $arg);
}

sub read_args {
  my $self = shift;

  (my $args, @_) = $self->cull_options(@_);
  my %args = %$args;

  my $opt_re = qr/[\w\-]+/;

  my ($action, @argv);
  while (@_) {
    local $_ = shift;
    if ( /^(?:--)?($opt_re)=(.*)$/ ) {
      $self->_read_arg(\%args, $1, $2);
    } elsif ( /^--($opt_re)$/ ) {
      my($opt, $arg) = $self->_optional_arg($1, \@_);
      $self->_read_arg(\%args, $opt, $arg);
    } elsif ( /^($opt_re)$/ and !defined($action)) {
      $action = $1;
    } else {
      push @argv, $_;
    }
  }
  $args{ARGV} = \@argv;

  for ('extra_compiler_flags', 'extra_linker_flags') {
    $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
  }

  # Convert to arrays
  for ('include_dirs') {
    $args{$_} = [ $args{$_} ] if exists $args{$_} && !ref $args{$_}
  }

  # Hashify these parameters
  for ($self->hash_properties, 'config') {
    next unless exists $args{$_};
    my %hash;
    $args{$_} ||= [];
    $args{$_} = [ $args{$_} ] unless ref $args{$_};
    foreach my $arg ( @{$args{$_}} ) {
      $arg =~ /(\w+)=(.*)/
	or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";
      $hash{$1} = $2;
    }
    $args{$_} = \%hash;
  }

  # De-tilde-ify any path parameters
  for my $key (qw(prefix install_base destdir)) {
    next if !defined $args{$key};
    $args{$key} = $self->_detildefy($args{$key});
  }

  for my $key (qw(install_path)) {
    next if !defined $args{$key};

    for my $subkey (keys %{$args{$key}}) {
      next if !defined $args{$key}{$subkey};
      my $subkey_ext = $self->_detildefy($args{$key}{$subkey});
      if ( $subkey eq 'html' ) { # translate for compatibility
	$args{$key}{binhtml} = $subkey_ext;
	$args{$key}{libhtml} = $subkey_ext;
      } else {
	$args{$key}{$subkey} = $subkey_ext;
      }
    }
  }

  if ($args{makefile_env_macros}) {
    require Module::Build::Compat;
    %args = (%args, Module::Build::Compat->makefile_to_build_macros);
  }

  return \%args, $action;
}

# Default: do nothing.  Overridden for Unix & Windows.
sub _detildefy {}


# merge Module::Build argument lists that have already been parsed
# by read_args(). Takes two references to option hashes and merges
# the contents, giving priority to the first.
sub _merge_arglist {
  my( $self, $opts1, $opts2 ) = @_;

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

    $title .= " - $abstract" if $abstract;

    my @opts = (
                '--flush',
                "--title=$title",
                "--podpath=$podpath",
                "--infile=$infile",
                "--outfile=$outfile",
                '--podroot=' . $self->blib,
                "--htmlroot=$htmlroot",
               );

    if ( eval{Pod::Html->VERSION(1.03)} ) {
      push( @opts, ('--header', '--backlink=Back to Top') );
      push( @opts, "--css=$path2root/" . $self->html_css) if $self->html_css;
    }

    $self->log_verbose("HTMLifying $infile -> $outfile\n");
    $self->log_verbose("pod2html @opts\n");
    eval { Pod::Html::pod2html(@opts); 1 }
      or $self->log_warn("pod2html @opts failed: $@");
  }

}

# Adapted from ExtUtils::MM_Unix
sub man1page_name {
  my $self = shift;
  return File::Basename::basename( shift );
}

# Adapted from ExtUtils::MM_Unix and Pod::Man
# Depending on M::B's dependency policy, it might make more sense to refactor
# Pod::Man::begin_pod() to extract a name() methods, and use them...
#    -spurkis
sub man3page_name {
  my $self = shift;
  my ($vol, $dirs, $file) = File::Spec->splitpath( shift );
  my @dirs = File::Spec->splitdir( File::Spec->canonpath($dirs) );

  # Remove known exts from the base name
  $file =~ s/\.p(?:od|m|l)\z//i;

  return join( $self->manpage_separator, @dirs, $file );
}

sub manpage_separator {
  return '::';
}

# For systems that don't have 'diff' executable, should use Algorithm::Diff
sub ACTION_diff {
  my $self = shift;
  $self->depends_on('build');
  my $local_lib = File::Spec->rel2abs('lib');
  my @myINC = grep {$_ ne $local_lib} @INC;

  # The actual install destination might not be in @INC, so check there too.
  push @myINC, map $self->install_destination($_), qw(lib arch);

  my @flags = @{$self->{args}{ARGV}};
  @flags = $self->split_like_shell($self->{args}{flags} || '') unless @flags;

  my $installmap = $self->install_map;
  delete $installmap->{read};
  delete $installmap->{write};

  my $text_suffix = file_qr('\.(pm|pod)$');

  while (my $localdir = each %$installmap) {
    my @localparts = File::Spec->splitdir($localdir);
    my $files = $self->rscan_dir($localdir, sub {-f});

    foreach my $file (@$files) {
      my @parts = File::Spec->splitdir($file);
      @parts = @parts[@localparts .. $#parts]; # Get rid of blib/lib or similar

      my $installed = Module::Build::ModuleInfo->find_module_by_name(
                        join('::', @parts), \@myINC );
      if (not $installed) {
	print "Only in lib: $file\n";
	next;
      }

      my $status = File::Compare::compare($installed, $file);
      next if $status == 0;  # Files are the same
      die "Can't compare $installed and $file: $!" if $status == -1;

      if ($file =~ $text_suffix) {
	$self->do_system('diff', @flags, $installed, $file);
      } else {
	print "Binary files $file and $installed differ\n";
      }
    }
  }
}

sub ACTION_pure_install {
  shift()->depends_on('install');
}

sub ACTION_install {
  my ($self) = @_;
  require ExtUtils::Install;
  $self->depends_on('build');
  ExtUtils::Install::install($self->install_map, $self->verbose, 0, $self->{args}{uninst}||0);
}

sub ACTION_fakeinstall {
  my ($self) = @_;
  require ExtUtils::Install;
  my $eui_version = ExtUtils::Install->VERSION;
  if ( $eui_version < 1.32 ) {
    $self->log_warn(
      "The 'fakeinstall' action requires Extutils::Install 1.32 or later.\n"
      . "(You only have version $eui_version)."
    );
    return;
  }
  $self->depends_on('build');
  ExtUtils::Install::install($self->install_map, !$self->quiet, 1, $self->{args}{uninst}||0);
}

sub ACTION_versioninstall {
  my ($self) = @_;

  die "You must have only.pm 0.25 or greater installed for this operation: $@\n"
    unless eval { require only; 'only'->VERSION(0.25); 1 };

  $self->depends_on('build');

  my %onlyargs = map {exists($self->{args}{$_}) ? ($_ => $self->{args}{$_}) : ()}
    qw(version versionlib);
  only::install::install(%onlyargs);
}

sub ACTION_installdeps {
  my ($self) = @_;

  # XXX include feature prerequisites as optional prereqs?

  my $info = $self->_enum_prereqs;
  if (! $info ) {
    $self->log_info( "No prerequisites detected\n" );
    return;
  }

  my $failures = $self->prereq_failures($info);
  if ( ! $failures ) {
    $self->log_info( "All prerequisites satisfied\n" );

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

      $prime{$package}{version} = $result->{version}
	  if defined( $result->{version} );
    }
  }

  # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
  # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
  for (grep defined $_->{version}, values %prime) {
    $_->{version} = $self->normalize_version( $_->{version} );
  }

  return \%prime;
}

# separate out some of the conflict resolution logic from
# $self->find_dist_packages(), above, into a helper function.
#
sub _resolve_module_versions {
  my $self = shift;

  my $packages = shift;

  my( $file, $version );
  my $err = '';
    foreach my $p ( @$packages ) {
      if ( defined( $p->{version} ) ) {
	if ( defined( $version ) ) {
 	  if ( $self->compare_versions( $version, '!=', $p->{version} ) ) {
	    $err .= "  $p->{file} ($p->{version})\n";
	  } else {
	    # same version declared multiple times, ignore
	  }
	} else {
	  $file    = $p->{file};
	  $version = $p->{version};
	}
      }
      $file ||= $p->{file} if defined( $p->{file} );
    }

  if ( $err ) {
    $err = "  $file ($version)\n" . $err;
  }

  my %result = (
    file    => $file,
    version => $version,
    err     => $err
  );

  return \%result;
}

sub make_tarball {
  my ($self, $dir, $file) = @_;
  $file ||= $dir;

  $self->log_info("Creating $file.tar.gz\n");

  if ($self->{args}{tar}) {
    my $tar_flags = $self->verbose ? 'cvf' : 'cf';
    $self->do_system($self->split_like_shell($self->{args}{tar}), $tar_flags, "$file.tar", $dir);
    $self->do_system($self->split_like_shell($self->{args}{gzip}), "$file.tar") if $self->{args}{gzip};
  } else {
    eval { require Archive::Tar && Archive::Tar->VERSION(1.09); 1 }
      or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n".
             "or specify a binary tar program with the '--tar' option.\n".
             "See the documentation for the 'dist' action.\n";

    my $files = $self->rscan_dir($dir);

    # Archive::Tar versions >= 1.09 use the following to enable a compatibility
    # hack so that the resulting archive is compatible with older clients.
    # If no file path is 100 chars or longer, we disable the prefix field
    # for maximum compatibility.  If there are any long file paths then we
    # need the prefix field after all.
    $Archive::Tar::DO_NOT_USE_PREFIX =
      (grep { length($_) >= 100 } @$files) ? 0 : 1;

    my $tar   = Archive::Tar->new;
    $tar->add_files(@$files);
    for my $f ($tar->get_files) {
      $f->mode($f->mode & ~022); # chmod go-w
    }
    $tar->write("$file.tar.gz", 1);
  }
}

sub install_path {
  my $self = shift;
  my( $type, $value ) = ( @_, '<empty>' );

  Carp::croak( 'Type argument missing' )
    unless defined( $type );

  my $map = $self->{properties}{install_path};
  return $map unless @_;

  # delete existing value if $value is literal undef()
  unless ( defined( $value ) ) {
    delete( $map->{$type} );
    return undef;
  }

  # return existing value if no new $value is given
  if ( $value eq '<empty>' ) {
    return undef unless exists $map->{$type};
    return $map->{$type};
  }

  # set value if $value is a valid relative path
  return $map->{$type} = $value;
}

sub install_sets {
  # Usage: install_sets('site'), install_sets('site', 'lib'),
  #   or install_sets('site', 'lib' => $value);
  my ($self, $dirs, $key, $value) = @_;
  $dirs = $self->installdirs unless defined $dirs;
  # update property before merging with defaults
  if ( @_ == 4 && defined $dirs && defined $key) {
    # $value can be undef; will mask default

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

  foreach (@_) {
    next unless -e $_;
    $self->log_verbose("Deleting $_\n");
    File::Path::rmtree($_, 0, 0);
    die "Couldn't remove '$_': $!\n" if -e $_;
    $deleted++;
  }
  return $deleted;
}

sub autosplit_file {
  my ($self, $file, $to) = @_;
  require AutoSplit;
  my $dir = File::Spec->catdir($to, 'lib', 'auto');
  AutoSplit::autosplit($file, $dir);
}

sub cbuilder {
  # Returns a CBuilder object

  my $self = shift;
  my $s = $self->{stash};
  return $s->{_cbuilder} if $s->{_cbuilder};

  require ExtUtils::CBuilder;
  return $s->{_cbuilder} = ExtUtils::CBuilder->new(
    config => $self->config,
    ($self->quiet ? (quiet => 1 ) : ()),
  );
}

sub have_c_compiler {
  my ($self) = @_;

  my $p = $self->{properties};
  return $p->{_have_c_compiler} if defined $p->{_have_c_compiler};

  $self->log_verbose("Checking if compiler tools configured... ");
  my $b = eval { $self->cbuilder };
  my $have = $b && eval { $b->have_compiler };
  $self->log_verbose($have ? "ok.\n" : "failed.\n");
  return $p->{_have_c_compiler} = $have;
}

sub compile_c {
  my ($self, $file, %args) = @_;

  if ( ! $self->have_c_compiler ) {
    die "Error: no compiler detected to compile '$file'.  Aborting\n";
  }

  my $b = $self->cbuilder;
  my $obj_file = $b->object_file($file);
  $self->add_to_cleanup($obj_file);
  return $obj_file if $self->up_to_date($file, $obj_file);

  $b->compile(source => $file,
	      defines => $args{defines},
	      object_file => $obj_file,
	      include_dirs => $self->include_dirs,
	      extra_compiler_flags => $self->extra_compiler_flags,
	     );

  return $obj_file;
}

sub link_c {
  my ($self, $spec) = @_;
  my $p = $self->{properties}; # For convenience

  $self->add_to_cleanup($spec->{lib_file});

  my $objects = $p->{objects} || [];

  return $spec->{lib_file}
    if $self->up_to_date([$spec->{obj_file}, @$objects],
			 $spec->{lib_file});

  my $module_name = $spec->{module_name} || $self->module_name;

  $self->cbuilder->link(
    module_name => $module_name,
    objects     => [$spec->{obj_file}, @$objects],
    lib_file    => $spec->{lib_file},
    extra_linker_flags => $p->{extra_linker_flags} );

  return $spec->{lib_file};
}

sub compile_xs {
  my ($self, $file, %args) = @_;

  $self->log_verbose("$file -> $args{outfile}\n");

  if (eval {require ExtUtils::ParseXS; 1}) {

    ExtUtils::ParseXS::process_file(
				    filename => $file,
				    prototypes => 0,
				    output => $args{outfile},
				   );
  } else {
    # Ok, I give up.  Just use backticks.

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

    my @typemaps;
    push @typemaps, Module::Build::ModuleInfo->find_module_by_name(
        'ExtUtils::typemap', \@INC
    );
    my $lib_typemap = Module::Build::ModuleInfo->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");
    my $fh = IO::File->new("> $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 UNIVERSAL::isa($string, '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