view release on metacpan or  search on metacpan

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

  $req ||= {};
  $breq ||= {};

  # validate formats
  for my $p ( $req, $breq ) {
    for my $k (keys %$p) {
      next if $k eq 'perl';
      die "Prereq '$p->{$k}' for '$k' is not supported by Module::Build::Compat\n"
        unless _simple_prereq($p->{$k});
    }
  }
  # merge
  my $merge = { %$req };
  for my $k ( keys %$breq ) {
    my $v1 = $merge->{$k} || 0;
    my $v2 = $breq->{$k};
    $merge->{$k} = $v1 > $v2 ? $v1 : $v2;
  }
  return %$merge;
}


sub create_makefile_pl {
  my ($package, $type, $build, %args) = @_;

  die "Don't know how to build Makefile.PL of type '$type'"
    unless $type =~ /^(small|passthrough|traditional)$/;

  if ($type eq 'passthrough') {
    $build->log_warn(<<"HERE");

IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and
may be removed in a future version of Module::Build in favor of the
'configure_requires' property.  See Module::Build::Compat
documentation for details.

HERE
  }

  my $fh;
  if ($args{fh}) {
    $fh = $args{fh};
  } else {
    $args{file} ||= 'Makefile.PL';
    local $build->{properties}{quiet} = 1;
    $build->delete_filetree($args{file});
    $fh = IO::File->new("> $args{file}") or die "Can't write $args{file}: $!";
  }

  print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";

  # Minimum perl version should be specified as "require 5.XXXXXX" in
  # Makefile.PL
  my $requires = $build->requires;
  if ( my $minimum_perl = $requires->{perl} ) {
    my $min_ver = Module::Build::Version->new($minimum_perl)->numify;
    print {$fh} "require $min_ver;\n";
  }

  # If a *bundled* custom subclass is being used, make sure we add its
  # directory to @INC.  Also, lib.pm always needs paths in Unix format.
  my $subclass_load = '';
  if (ref($build) ne "Module::Build") {
    my $subclass_dir = $package->subclass_dir($build);

    if (File::Spec->file_name_is_absolute($subclass_dir)) {
      my $base_dir = $build->base_dir;

      if ($build->dir_contains($base_dir, $subclass_dir)) {
	$subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
	$subclass_dir = $package->unixify_dir($subclass_dir);
        $subclass_load = "use lib '$subclass_dir';";
      }
      # Otherwise, leave it the empty string

    } else {
      $subclass_dir = $package->unixify_dir($subclass_dir);
      $subclass_load = "use lib '$subclass_dir';";
    }
  }

  if ($type eq 'small') {
    printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
    use Module::Build::Compat 0.02;
    %s
    Module::Build::Compat->run_build_pl(args => \@ARGV);
    require %s;
    Module::Build::Compat->write_makefile(build_class => '%s');
EOF

  } elsif ($type eq 'passthrough') {
    printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);

    unless (eval "use Module::Build::Compat 0.02; 1" ) {
      print "This module requires Module::Build to install itself.\n";

      require ExtUtils::MakeMaker;
      my $yn = ExtUtils::MakeMaker::prompt
	('  Install Module::Build now from CPAN?', 'y');

      unless ($yn =~ /^y/i) {
	die " *** Cannot install without Module::Build.  Exiting ...\n";
      }

      require Cwd;
      require File::Spec;
      require CPAN;

      # Save this 'cause CPAN will chdir all over the place.
      my $cwd = Cwd::cwd();

      CPAN::Shell->install('Module::Build::Compat');
      CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
	or die "Couldn't install Module::Build, giving up.\n";

      chdir $cwd or die "Cannot chdir() back to $cwd: $!";
    }
    eval "use Module::Build::Compat 0.02; 1" or die $@;
    %s
    Module::Build::Compat->run_build_pl(args => \@ARGV);
    my $build_script = 'Build';
    $build_script .= '.com' if $^O eq 'VMS';
    exit(0) unless(-e $build_script); # cpantesters convention
    require %s;
    Module::Build::Compat->write_makefile(build_class => '%s');
EOF

  } elsif ($type eq 'traditional') {

    my (%MM_Args, %prereq);
    if (eval "use Tie::IxHash; 1") {
      tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
      tie %prereq,  'Tie::IxHash'; # Don't care if it fails here
    }

    my %name = ($build->module_name
		? (NAME => $build->module_name)
		: (DISTNAME => $build->dist_name));

    my %version = ($build->dist_version_from
		   ? (VERSION_FROM => $build->dist_version_from)
		   : (VERSION      => $build->dist_version)
		  );
    %MM_Args = (%name, %version);

    %prereq = _merge_prereq( $build->requires, $build->build_requires );
    %prereq = map {$_, $prereq{$_}} sort keys %prereq;

     delete $prereq{perl};
    $MM_Args{PREREQ_PM} = \%prereq;

    $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;

    $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;

    $MM_Args{PL_FILES} = $build->PL_files || {};

    if ($build->recursive_test_files) {
        $MM_Args{test} = { TESTS => join q{ }, $package->_test_globs($build) };
    }

    local $Data::Dumper::Terse = 1;
    my $args = Data::Dumper::Dumper(\%MM_Args);
    $args =~ s/\{(.*)\}/($1)/s;

    print $fh <<"EOF";
use ExtUtils::MakeMaker;
WriteMakefile
$args;
EOF
  }
}

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 {