Acme-Sort-Sleep

 view release on metacpan or  search on metacpan

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

  } 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} =
    {
     core   => {
       lib     => $c->get('installprivlib'),
       arch    => $c->get('installarchlib'),
       bin     => $c->get('installbin'),
       script  => $c->get('installscript'),
       bindoc  => $bindoc,
       libdoc  => $libdoc,
       binhtml => $binhtml,
       libhtml => $libhtml,
     },
     site   => {
       lib     => $c->get('installsitelib'),
       arch    => $c->get('installsitearch'),
       bin     => $c->get('installsitebin')      || $c->get('installbin'),
       script  => $c->get('installsitescript')   ||
         $c->get('installsitebin') || $c->get('installscript'),
       bindoc  => $c->get('installsiteman1dir')  || $bindoc,
       libdoc  => $c->get('installsiteman3dir')  || $libdoc,
       binhtml => $c->get('installsitehtml1dir') || $binhtml,
       libhtml => $c->get('installsitehtml3dir') || $libhtml,
     },
     vendor => {
       lib     => $c->get('installvendorlib'),
       arch    => $c->get('installvendorarch'),
       bin     => $c->get('installvendorbin')      || $c->get('installbin'),
       script  => $c->get('installvendorscript')   ||
         $c->get('installvendorbin') || $c->get('installscript'),
       bindoc  => $c->get('installvendorman1dir')  || $bindoc,
       libdoc  => $c->get('installvendorman3dir')  || $libdoc,
       binhtml => $c->get('installvendorhtml1dir') || $binhtml,
       libhtml => $c->get('installvendorhtml3dir') || $libhtml,
     },
    };

  $p->{original_prefix} =
    {
     core   => $c->get('installprefixexp') || $c->get('installprefix') ||
               $c->get('prefixexp')        || $c->get('prefix') || '',
     site   => $c->get('siteprefixexp'),
     vendor => $c->get('usevendorprefix') ? $c->get('vendorprefixexp') : '',
    };
  $p->{original_prefix}{site} ||= $p->{original_prefix}{core};

  # Note: you might be tempted to use $Config{installstyle} here
  # instead of hard-coding lib/perl5, but that's been considered and
  # (at least for now) rejected.  `perldoc Config` has some wisdom
  # about it.
  $p->{install_base_relpaths} =
    {
     lib     => ['lib', 'perl5'],
     arch    => ['lib', 'perl5', $arch],
     bin     => ['bin'],
     script  => ['bin'],
     bindoc  => ['man', 'man1'],
     libdoc  => ['man', 'man3'],
     binhtml => ['html'],
     libhtml => ['html'],
    };

  $p->{prefix_relpaths} =
    {
     core => {
       lib        => [@libstyle],
       arch       => [@libstyle, $version, $arch],
       bin        => ['bin'],
       script     => ['bin'],
       bindoc     => ['man', 'man1'],
       libdoc     => ['man', 'man3'],
       binhtml    => ['html'],
       libhtml    => ['html'],
     },
     vendor => {
       lib        => [@libstyle],
       arch       => [@libstyle, $version, $arch],
       bin        => ['bin'],
       script     => ['bin'],
       bindoc     => ['man', 'man1'],
       libdoc     => ['man', 'man3'],
       binhtml    => ['html'],
       libhtml    => ['html'],
     },
     site => {
       lib        => [@libstyle, 'site_perl'],
       arch       => [@libstyle, 'site_perl', $version, $arch],
       bin        => ['bin'],
       script     => ['bin'],
       bindoc     => ['man', 'man1'],
       libdoc     => ['man', 'man3'],
       binhtml    => ['html'],
       libhtml    => ['html'],
     },
    };
    return $p
}

sub _find_nested_builds {
  my $self = shift;
  my $r = $self->recurse_into or return;

  my ($file, @r);
  if (!ref($r) && $r eq 'auto') {
    local *DH;

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

__PACKAGE__->add_property(blib => 'blib');
__PACKAGE__->add_property(build_class => 'Module::Build');
__PACKAGE__->add_property(build_elements => [qw(PL support pm xs share_dir pod script)]);
__PACKAGE__->add_property(build_script => 'Build');
__PACKAGE__->add_property(build_bat => 0);
__PACKAGE__->add_property(bundle_inc => []);
__PACKAGE__->add_property(bundle_inc_preload => []);
__PACKAGE__->add_property(config_dir => '_build');
__PACKAGE__->add_property(dynamic_config => 1);
__PACKAGE__->add_property(include_dirs => []);
__PACKAGE__->add_property(license => 'unknown');
__PACKAGE__->add_property(metafile => 'META.yml');
__PACKAGE__->add_property(mymetafile => 'MYMETA.yml');
__PACKAGE__->add_property(metafile2 => 'META.json');
__PACKAGE__->add_property(mymetafile2 => 'MYMETA.json');
__PACKAGE__->add_property(recurse_into => []);
__PACKAGE__->add_property(use_rcfile => 1);
__PACKAGE__->add_property(create_packlist => 1);
__PACKAGE__->add_property(allow_mb_mismatch => 0);
__PACKAGE__->add_property(config => undef);
__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(pureperl_only => 0);
__PACKAGE__->add_property(allow_pureperl => 0);
__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;
  },
);

{
  __PACKAGE__->add_property(html_css => '');
}

{
  my @prereq_action_types = qw(requires build_requires test_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
  cover
  create_license
  create_makefile_pl
  create_readme
  debugger
  destdir
  dist_abstract
  dist_author
  dist_name
  dist_suffix
  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
  release_status
  script_files
  scripts
  share_dir
  sign
  test_files
  verbose
  debug
  xs_files
  extra_manify_args
);

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

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

    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 {
    $mymeta_obj = $self->_get_meta_object(quiet => 0, dynamic => 0, fatal => 1, auto => 0);
  }

  my @created = $self->_write_meta_files( $mymeta_obj, 'MYMETA' );

  $self->log_warn("Could not create MYMETA files\n")
    unless @created;

  return 1;
}

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

  $self->write_config;
  $self->create_mymeta;

  # Create Build
  my ($build_script, $dist_name, $dist_version)
    = map $self->$_(), qw(build_script dist_name dist_version);

  if ( $self->delete_filetree($build_script) ) {
    $self->log_verbose("Removed previous script '$build_script'\n");
  }

  $self->log_info("Creating new '$build_script' script for ",
                  "'$dist_name' version '$dist_version'\n");
  open(my $fh, '>', $build_script) or die "Can't create '$build_script': $!";
  $self->print_build_script($fh);
  close $fh;

  $self->make_executable($build_script);

  return 1;
}

sub check_manifest {
  my $self = shift;
  return unless -e 'MANIFEST';

  # Stolen nearly verbatim from MakeMaker.  But ExtUtils::Manifest
  # could easily be re-written into a modern Perl dialect.

  require ExtUtils::Manifest;  # ExtUtils::Manifest is not warnings clean.
  local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);

  $self->log_verbose("Checking whether your kit is complete...\n");

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


    FILE: foreach my $file ( @{ $self->rscan_dir( $dir ) } ) {
      foreach my $regexp ( @{ $args{exclude} } ) {
        next FILE if $file =~ $regexp;
      }
      $file = $self->localize_file_path($file);
      $files{$file} = File::Spec->abs2rel($file, $dir) if $self->contains_pod( $file )
    }
  }
  return \%files;
}

sub contains_pod {
  my ($self, $file) = @_;
  return '' unless -T $file;  # Only look at text files

  open(my $fh, '<', $file ) or die "Can't open $file: $!";
  while (my $line = <$fh>) {
    return 1 if $line =~ /^\=(?:head|pod|item)/;
  }

  return '';
}

sub ACTION_html {
  my $self = shift;

  return unless $self->_mb_feature('HTML_support');

  $self->depends_on('code');

  foreach my $type ( qw(bin lib) ) {
    next unless ( $self->invoked_action eq 'html' || $self->_is_default_installable("${type}html"));
    $self->htmlify_pods( $type );
  }
}

# 1) If it's an ActiveState perl install, we need to run
#    ActivePerl::DocTools->UpdateTOC;
# 2) Links to other modules are not being generated
sub htmlify_pods {
  my $self = shift;
  my $type = shift;
  my $htmldir = shift || File::Spec->catdir($self->blib, "${type}html");

  $self->add_to_cleanup('pod2htm*');

  my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
                                exclude => [ $self->file_qr('\.(?:bat|com|html)$') ] );
  return unless %$pods;  # nothing to do

  unless ( -d $htmldir ) {
    File::Path::mkpath($htmldir, 0, oct(755))
      or die "Couldn't mkdir $htmldir: $!";
  }

  my @rootdirs = ($type eq 'bin') ? qw(bin) :
      $self->installdirs eq 'core' ? qw(lib) : qw(site lib);
  my $podroot = $ENV{PERL_CORE}
              ? File::Basename::dirname($ENV{PERL_CORE})
              : $self->original_prefix('core');

  my $htmlroot = $self->install_sets('core')->{libhtml};
  my $podpath;
  unless (defined $self->args('html_links') and !$self->args('html_links')) {
    my @podpath = ( (map { File::Spec->abs2rel($_ ,$podroot) } grep { -d  }
                     ( $self->install_sets('core', 'lib'), # lib
                       $self->install_sets('core', 'bin'), # bin
                       $self->install_sets('site', 'lib'), # site/lib
                     ) ), File::Spec->rel2abs($self->blib) );

    $podpath = $ENV{PERL_CORE}
      ? File::Spec->catdir($podroot, 'lib')
        : join(":", map { tr,:\\,|/,; $_ } @podpath);
  }

  my $blibdir = join('/', File::Spec->splitdir(
    (File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),''
  );

  my ($with_ActiveState, $htmltool);

  if ( $with_ActiveState = $self->_is_ActivePerl
    && eval { require ActivePerl::DocTools::Pod; 1 }
  ) {
    my $tool_v = ActiveState::DocTools::Pod->VERSION;
    $htmltool = "ActiveState::DocTools::Pod";
    $htmltool .= " $tool_v" if $tool_v && length $tool_v;
  }
  else {
      require Module::Build::PodParser;
      require Pod::Html;
    $htmltool = "Pod::Html " .  Pod::Html->VERSION;
  }
  $self->log_verbose("Converting Pod to HTML with $htmltool\n");

  my $errors = 0;

  POD:
  foreach my $pod ( sort keys %$pods ) {

    my ($name, $path) = File::Basename::fileparse($pods->{$pod},
      $self->file_qr('\.(?:pm|plx?|pod)$')
    );
    my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
    pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;

    my $fulldir = File::Spec->catdir($htmldir, @rootdirs, @dirs);
    my $tmpfile = File::Spec->catfile($fulldir, "${name}.tmp");
    my $outfile = File::Spec->catfile($fulldir, "${name}.html");
    my $infile  = File::Spec->abs2rel($pod);

    next if $self->up_to_date($infile, $outfile);

    unless ( -d $fulldir ){
      File::Path::mkpath($fulldir, 0, oct(755))
        or die "Couldn't mkdir $fulldir: $!";
    }

    $self->log_verbose("HTMLifying $infile -> $outfile\n");
    if ( $with_ActiveState ) {

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

    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
    $self->{properties}{install_sets}{$dirs}{$key} = $value;
  }
  my $map = { $self->_merge_arglist(
    $self->{properties}{install_sets},
    $self->_default_install_paths->{install_sets}
  )};
  if ( defined $dirs && defined $key ) {
    return $map->{$dirs}{$key};
  }
  elsif ( defined $dirs ) {
    return $map->{$dirs};
  }
  else {
    croak "Can't determine installdirs for install_sets()";
  }
}

sub original_prefix {
  # Usage: original_prefix(), original_prefix('lib'),
  #   or original_prefix('lib' => $value);
  my ($self, $key, $value) = @_;
  # update property before merging with defaults
  if ( @_ == 3 && defined $key) {
    # $value can be undef; will mask default
    $self->{properties}{original_prefix}{$key} = $value;
  }
  my $map = { $self->_merge_arglist(
    $self->{properties}{original_prefix},
    $self->_default_install_paths->{original_prefix}
  )};
  return $map unless defined $key;
  return $map->{$key}
}

sub install_base_relpaths {
  # Usage: install_base_relpaths(), install_base_relpaths('lib'),
  #   or install_base_relpaths('lib' => $value);
  my $self = shift;
  if ( @_ > 1 ) { # change values before merge
    $self->_set_relpaths($self->{properties}{install_base_relpaths}, @_);
  }
  my $map = { $self->_merge_arglist(
    $self->{properties}{install_base_relpaths},
    $self->_default_install_paths->{install_base_relpaths}
  )};
  return $map unless @_;
  my $relpath = $map->{$_[0]};
  return defined $relpath ? File::Spec->catdir( @$relpath ) : undef;
}

# Defaults to use in case the config install paths cannot be prefixified.
sub prefix_relpaths {
  # Usage: prefix_relpaths('site'), prefix_relpaths('site', 'lib'),
  #   or prefix_relpaths('site', 'lib' => $value);
  my $self = shift;
  my $installdirs = shift || $self->installdirs
    or croak "Can't determine installdirs for prefix_relpaths()";
  if ( @_ > 1 ) { # change values before merge
    $self->{properties}{prefix_relpaths}{$installdirs} ||= {};
    $self->_set_relpaths($self->{properties}{prefix_relpaths}{$installdirs}, @_);
  }
  my $map = {$self->_merge_arglist(
    $self->{properties}{prefix_relpaths}{$installdirs},
    $self->_default_install_paths->{prefix_relpaths}{$installdirs}
  )};
  return $map unless @_;
  my $relpath = $map->{$_[0]};
  return defined $relpath ? File::Spec->catdir( @$relpath ) : undef;
}

sub _set_relpaths {
  my $self = shift;
  my( $map, $type, $value ) = @_;

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

  # set undef if $value is literal undef()
  if ( ! defined( $value ) ) {
    $map->{$type} = undef;
    return;
  }
  # set value if $value is a valid relative path
  else {
    Carp::croak( "Value must be a relative path" )
      if File::Spec::Unix->file_name_is_absolute($value);

    my @value = split( /\//, $value );
    $map->{$type} = \@value;
  }
}

# Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX
sub prefix_relative {
  my ($self, $type) = @_;
  my $installdirs = $self->installdirs;

  my $relpath = $self->install_sets($installdirs)->{$type};

  return $self->_prefixify($relpath,
                           $self->original_prefix($installdirs),
                           $type,
                          );
}

# Translated from ExtUtils::MM_Unix::prefixify()
sub _prefixify {
  my($self, $path, $sprefix, $type) = @_;

  my $rprefix = $self->prefix;
  $rprefix .= '/' if $sprefix =~ m|/$|;

  $self->log_verbose("  prefixify $path from $sprefix to $rprefix\n")
    if defined( $path ) && length( $path );

  if( !defined( $path ) || ( length( $path ) == 0 ) ) {
    $self->log_verbose("  no path to prefixify, falling back to default.\n");
    return $self->_prefixify_default( $type, $rprefix );
  } elsif( !File::Spec->file_name_is_absolute($path) ) {
    $self->log_verbose("    path is relative, not prefixifying.\n");
  } elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) {
    $self->log_verbose("    cannot prefixify, falling back to default.\n");
    return $self->_prefixify_default( $type, $rprefix );
  }

  $self->log_verbose("    now $path in $rprefix\n");

  return $path;
}

sub _prefixify_default {
  my $self = shift;
  my $type = shift;
  my $rprefix = shift;

  my $default = $self->prefix_relpaths($self->installdirs, $type);
  if( !$default ) {
    $self->log_verbose("    no default install location for type '$type', using prefix '$rprefix'.\n");
    return $rprefix;
  } else {
    return $default;
  }
}

sub install_destination {
  my ($self, $type) = @_;

  return $self->install_path($type) if $self->install_path($type);

  if ( $self->install_base ) {
    my $relpath = $self->install_base_relpaths($type);
    return $relpath ? File::Spec->catdir($self->install_base, $relpath) : undef;
  }

  if ( $self->prefix ) {
    my $relpath = $self->prefix_relative($type);
    return $relpath ? File::Spec->catdir($self->prefix, $relpath) : undef;
  }

  return $self->install_sets($self->installdirs)->{$type};
}



( run in 1.838 second using v1.01-cache-2.11-cpan-39bf76dae61 )