view release on metacpan or  search on metacpan

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

sub _test_globs {
  my ($self, $build) = @_;

  return map { File::Spec->catfile($_, '*.t') }
         @{$build->rscan_dir('t', sub { -d $File::Find::name })};
}

sub subclass_dir {
  my ($self, $build) = @_;

  return (Module::Build::ModuleInfo->find_module_dir_by_name(ref $build)
	  || File::Spec->catdir($build->config_dir, 'lib'));
}

sub unixify_dir {
  my ($self, $path) = @_;
  return join '/', File::Spec->splitdir($path);
}

sub makefile_to_build_args {
  my $class = shift;
  my @out;
  foreach my $arg (@_) {
    next if $arg eq '';

    my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
		       die "Malformed argument '$arg'");

    # Do tilde-expansion if it looks like a tilde prefixed path
    ( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;

    if (exists $makefile_to_build{$key}) {
      my $trans = $makefile_to_build{$key};
      push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
    } elsif (exists $Config{lc($key)}) {
      push @out, $class->_argvify( config => lc($key) . "=$val" );
    } else {
      # Assume M::B can handle it in lowercase form
      push @out, $class->_argvify("\L$key" => $val);
    }
  }
  return @out;
}

sub _argvify {
  my ($self, @pairs) = @_;
  my @out;
  while (@pairs) {
    my ($k, $v) = splice @pairs, 0, 2;
    push @out, ("--$k", $v);
  }
  return @out;
}

sub makefile_to_build_macros {
  my @out;
  my %config; # must accumulate and return as a hashref
  while (my ($macro, $trans) = each %macro_to_build) {
    # On some platforms (e.g. Cygwin with 'make'), the mere presence
    # of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
    # Therefore we check length() too.
    next unless exists $ENV{$macro} && length $ENV{$macro};
    my $val = $ENV{$macro};
    my @args = ref($trans) ? $trans->($val) : ($trans => $val);
    while (@args) {
      my ($k, $v) = splice(@args, 0, 2);
      if ( $k eq 'config' ) {
        if ( $v =~ /^([^=]+)=(.*)$/ ) {
          $config{$1} = $2;
        }
        else {
          warn "Couldn't parse config '$v'\n";
        }
      }
      else {
        push @out, ($k => $v);
      }
    }
  }
  push @out, (config => \%config) if %config;
  return @out;
}

sub run_build_pl {
  my ($pack, %in) = @_;
  $in{script} ||= 'Build.PL';
  my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
  print "# running $in{script} @args\n";
  Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
}

sub fake_makefile {
  my ($self, %args) = @_;
  unless (exists $args{build_class}) {
    warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
    $args{build_class} = 'Module::Build';
  }
  my $class = $args{build_class};

  my $perl = $class->find_perl_interpreter;

  # VMS MMS/MMK need to use MCR to run the Perl image.
  $perl = 'MCR ' . $perl if $self->_is_vms_mms;

  my $noop = ($class->is_windowsish ? 'rem>nul'  :
	      $self->_is_vms_mms    ? 'Continue' :
	      'true');

  my $filetype = $class->is_vmsish ? '.COM' : '';

  my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
  my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
  $unlink =~ s/\$/\$\$/g unless $class->is_vmsish;

  my $maketext = ($^O eq 'os2' ? "SHELL = sh\n\n" : '');

  $maketext .= <<"EOF";
all : force_do_it
	$perl $Build
realclean : force_do_it
	$perl $Build realclean
	$unlink