view release on metacpan or  search on metacpan

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

  if ( -f $self->metafile ) {
    my $meta = eval { $self->read_metafile( $self->metafile ) };
    $config_requires = $meta && $meta->{prereqs}{configure}{requires}{'Module::Build'};
  }
  $config_requires ||= 0;

  my %q = map {$_, $self->$_()} qw(config_dir base_dir);

  $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;

  $q{magic_numfile} = $self->config_file('magicnum');

  my @myINC = $self->_added_to_INC;
  for (@myINC, values %q) {
    $_ = File::Spec->canonpath( $_ ) unless $self->is_vmsish;
    s/([\\\'])/\\$1/g;
  }

  my $quoted_INC = join ",\n", map "     '$_'", @myINC;
  my $shebang = $self->_startperl;
  my $magic_number = $self->magic_number;

  print $fh <<EOF;
$shebang

use strict;
use Cwd;
use File::Basename;
use File::Spec;

sub magic_number_matches {
  return 0 unless -e '$q{magic_numfile}';
  my \$FH;
  open \$FH, '<','$q{magic_numfile}' or return 0;
  my \$filenum = <\$FH>;
  close \$FH;
  return \$filenum == $magic_number;
}

my \$progname;
my \$orig_dir;
BEGIN {
  \$^W = 1;  # Use warnings
  \$progname = basename(\$0);
  \$orig_dir = Cwd::cwd();
  my \$base_dir = '$q{base_dir}';
  if (!magic_number_matches()) {
    unless (chdir(\$base_dir)) {
      die ("Couldn't chdir(\$base_dir), aborting\\n");
    }
    unless (magic_number_matches()) {
      die ("Configuration seems to be out of date, please re-run 'perl Build.PL' again.\\n");
    }
  }
  unshift \@INC,
    (
$quoted_INC
    );
}

close(*DATA) unless eof(*DATA); # ensure no open handles to this script

use $build_package;
Module::Build->VERSION(q{$config_requires});

# Some platforms have problems setting \$^X in shebang contexts, fix it up here
\$^X = Module::Build->find_perl_interpreter;

if (-e 'Build.PL' and not $build_package->up_to_date('Build.PL', \$progname)) {
   warn "Warning: Build.PL has been altered.  You may need to run 'perl Build.PL' again.\\n";
}

# This should have just enough arguments to be able to bootstrap the rest.
my \$build = $build_package->resume (
  properties => {
    config_dir => '$q{config_dir}',
    orig_dir => \$orig_dir,
  },
);

\$build->dispatch;
EOF
}

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

  my ($meta_obj, $mymeta);
  my @metafiles = ( $self->metafile2, $self->metafile,  );
  my @mymetafiles = ( $self->mymetafile2, $self->mymetafile, );

  # cleanup old MYMETA
  for my $f ( @mymetafiles ) {
    if ( $self->delete_filetree($f) ) {
      $self->log_verbose("Removed previous '$f'\n");
    }
  }

  # Try loading META.json or META.yml
  if ( $self->try_require("CPAN::Meta", "2.142060") ) {
    for my $file ( @metafiles ) {
      next unless -f $file;
      $meta_obj = eval { CPAN::Meta->load_file($file, { lazy_validation => 0 }) };
      last if $meta_obj;
    }
  }

  # maybe get a copy in spec v2 format (regardless of original source)

  my $mymeta_obj;
  if ($meta_obj) {
    # if we have metadata, just update it
    my %updated = (
      %{ $meta_obj->as_struct({ version => 2.0 }) },
      prereqs => $self->_normalize_prereqs,
      dynamic_config => 0,
      generated_by => "Module::Build version $Module::Build::VERSION",
    );
    $mymeta_obj = CPAN::Meta->new( \%updated, { lazy_validation => 0 } );
  }
  else {

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

  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 ) = @_;

  $opts1 ||= {};
  $opts2 ||= {};
  my %new_opts = %$opts1;
  while (my ($key, $val) = each %$opts2) {
    if ( exists( $opts1->{$key} ) ) {
      if ( ref( $val ) eq 'HASH' ) {
        while (my ($k, $v) = each %$val) {
          $new_opts{$key}{$k} = $v unless exists( $opts1->{$key}{$k} );
        }
      }
    } else {
      $new_opts{$key} = $val
    }
  }

  return %new_opts;
}

# Look for a home directory on various systems.
sub _home_dir {
  my @home_dirs;
  push( @home_dirs, $ENV{HOME} ) if $ENV{HOME};

  push( @home_dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
      if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};

  my @other_home_envs = qw( USERPROFILE APPDATA WINDIR SYS$LOGIN );
  push( @home_dirs, map $ENV{$_}, grep $ENV{$_}, @other_home_envs );

  my @real_home_dirs = grep -d, @home_dirs;

  return wantarray ? @real_home_dirs : shift( @real_home_dirs );
}

sub _find_user_config {
  my $self = shift;
  my $file = shift;
  foreach my $dir ( $self->_home_dir ) {
    my $path = File::Spec->catfile( $dir, $file );
    return $path if -e $path;
  }
  return undef;
}

# read ~/.modulebuildrc returning global options '*' and
# options specific to the currently executing $action.
sub read_modulebuildrc {
  my( $self, $action ) = @_;

  return () unless $self->use_rcfile;

  my $modulebuildrc;
  if ( exists($ENV{MODULEBUILDRC}) && $ENV{MODULEBUILDRC} eq 'NONE' ) {
    return ();
  } elsif ( exists($ENV{MODULEBUILDRC}) && -e $ENV{MODULEBUILDRC} ) {
    $modulebuildrc = $ENV{MODULEBUILDRC};
  } elsif ( exists($ENV{MODULEBUILDRC}) ) {
    $self->log_warn("WARNING: Can't find resource file " .
                    "'$ENV{MODULEBUILDRC}' defined in environment.\n" .
                    "No options loaded\n");
    return ();
  } else {
    $modulebuildrc = $self->_find_user_config( '.modulebuildrc' );
    return () unless $modulebuildrc;
  }

  open(my $fh, '<', $modulebuildrc )
      or die "Can't open $modulebuildrc: $!";

  my %options; my $buffer = '';
  while (defined( my $line = <$fh> )) {
    chomp( $line );
    $line =~ s/#.*$//;
    next unless length( $line );

    if ( $line =~ /^\S/ ) {
      if ( $buffer ) {
        my( $action, $options ) = split( /\s+/, $buffer, 2 );
        $options{$action} .= $options . ' ';
        $buffer = '';
      }
      $buffer = $line;
    } else {
      $buffer .= $line;
    }
  }