Alien-V8
view release on metacpan or search on metacpan
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
$self->{invoked_action} = $self->{action} ||= 'build';
return $self;
}
sub new_from_context {
my ($package, %args) = @_;
$package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]);
return $package->resume;
}
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} =
{
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;
opendir DH, $self->base_dir
or die "Can't scan directory " . $self->base_dir . " for nested builds: $!";
while (defined($file = readdir DH)) {
my $subdir = File::Spec->catdir( $self->base_dir, $file );
next unless -d $subdir;
push @r, $subdir if -e File::Spec->catfile( $subdir, 'Build.PL' );
}
}
$self->recurse_into(\@r);
}
sub cwd {
return Cwd::cwd();
}
sub _quote_args {
# Returns a string that can become [part of] a command line with
# proper quoting so that the subprocess sees this same list of args.
my ($self, @args) = @_;
my @quoted;
for (@args) {
if ( /^[^\s*?!\$<>;\\|'"\[\]\{\}]+$/ ) {
# Looks pretty safe
push @quoted, $_;
} else {
# XXX this will obviously have to improve - is there already a
# core module lying around that does proper quoting?
s/('+)/'"$1"'/g;
push @quoted, qq('$_');
}
}
return join " ", @quoted;
}
sub _backticks {
my ($self, @cmd) = @_;
if ($self->have_forkpipe) {
local *FH;
my $pid = open *FH, "-|";
if ($pid) {
return wantarray ? <FH> : join '', <FH>;
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
__PACKAGE__->add_property(bundle_inc => []);
__PACKAGE__->add_property(bundle_inc_preload => []);
__PACKAGE__->add_property(config_dir => '_build');
__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(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(
'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');
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35
my ($self, @files) = @_;
my $c = ref($self) ? $self->{config} : 'Module::Build::Config';
my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/;
for my $file (@files) {
my $FIXIN = IO::File->new($file) or die "Can't process '$file': $!";
local $/ = "\n";
chomp(my $line = <$FIXIN>);
next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file.
my ($cmd, $arg) = (split(' ', $line, 2), '');
next unless $cmd =~ /perl/i;
my $interpreter = $self->{properties}{perl};
$self->log_verbose("Changing sharpbang in $file to $interpreter");
my $shb = '';
$shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang;
# I'm not smart enough to know the ramifications of changing the
# embedded newlines here to \n, so I leave 'em in.
$shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
if 0; # not running under some shell
} unless $self->is_windowsish; # this won't work on win32, so don't
my $FIXOUT = IO::File->new(">$file.new")
or die "Can't create new $file: $!\n";
# Print out the new #! line (or equivalent).
local $\;
undef $/; # Was localized above
print $FIXOUT $shb, <$FIXIN>;
close $FIXIN;
close $FIXOUT;
rename($file, "$file.bak")
or die "Can't rename $file to $file.bak: $!";
rename("$file.new", $file)
or die "Can't rename $file.new to $file: $!";
$self->delete_filetree("$file.bak")
or $self->log_warn("Couldn't clean up $file.bak, leaving it there");
$self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':';
}
}
sub ACTION_testpod {
my $self = shift;
$self->depends_on('docs');
eval q{use Test::Pod 0.95; 1}
or die "The 'testpod' action requires Test::Pod version 0.95";
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
keys %{$self->_find_pods
($self->bindoc_dirs,
exclude => [ file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package # hide from PAUSE
Module::Build::PodTester; # Don't want to pollute the main namespace
Test::Pod->import( tests => scalar @files );
pod_file_ok($_) foreach @files;
}
}
sub ACTION_testpodcoverage {
my $self = shift;
$self->depends_on('docs');
eval q{use Test::Pod::Coverage 1.00; 1}
or die "The 'testpodcoverage' action requires ",
"Test::Pod::Coverage version 1.00";
# TODO this needs test coverage!
# XXX work-around a bug in Test::Pod::Coverage previous to v1.09
# Make sure we test the module in blib/
local @INC = @INC;
my $p = $self->{properties};
unshift(@INC,
# XXX any reason to include arch?
File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
#File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')
);
all_pod_coverage_ok();
}
sub ACTION_docs {
my $self = shift;
$self->depends_on('code');
$self->depends_on('manpages', 'html');
}
# Given a file type, will return true if the file type would normally
# be installed when neither install-base nor prefix has been set.
# I.e. it will be true only if the path is set from Config.pm or
# set explicitly by the user via install-path.
sub _is_default_installable {
my $self = shift;
my $type = shift;
return ( $self->install_destination($type) &&
( $self->install_path($type) ||
$self->install_sets($self->installdirs)->{$type} )
) ? 1 : 0;
}
sub ACTION_manpages {
my $self = shift;
return unless $self->_mb_feature('manpage_support');
$self->depends_on('code');
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
exclude => [ file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
next unless defined( $sub );
if ( $self->invoked_action eq 'manpages' ) {
$self->$sub();
} elsif ( $self->_is_default_installable("${type}doc") ) {
$self->$sub();
}
}
}
sub manify_bin_pods {
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
exclude => [ file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
File::Path::mkpath( $mandir, 0, oct(777) );
require Pod::Man;
foreach my $file (keys %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
my $parser = Pod::Man->new( section => 1 ); # binaries go in section 1
my $manpage = $self->man1page_name( $file ) . '.' .
$self->config( 'man1ext' );
my $outfile = File::Spec->catfile($mandir, $manpage);
next if $self->up_to_date( $file, $outfile );
$self->log_verbose("Manifying $file -> $outfile\n");
eval { $parser->parse_from_file( $file, $outfile ); 1 }
or $self->log_warn("Error creating '$outfile': $@\n");
$files->{$file} = $outfile;
}
}
sub manify_lib_pods {
my $self = shift;
my $files = $self->_find_pods($self->{properties}{libdoc_dirs});
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'libdoc' );
File::Path::mkpath( $mandir, 0, oct(777) );
require Pod::Man;
while (my ($file, $relfile) = each %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
my $parser = Pod::Man->new( section => 3 ); # libraries go in section 3
my $manpage = $self->man3page_name( $relfile ) . '.' .
$self->config( 'man3ext' );
my $outfile = File::Spec->catfile( $mandir, $manpage);
next if $self->up_to_date( $file, $outfile );
$self->log_verbose("Manifying $file -> $outfile\n");
eval { $parser->parse_from_file( $file, $outfile ); 1 }
or $self->log_warn("Error creating '$outfile': $@\n");
$files->{$file} = $outfile;
}
}
sub _find_pods {
my ($self, $dirs, %args) = @_;
my %files;
foreach my $spec (@$dirs) {
my $dir = $self->localize_dir_path($spec);
next unless -e $dir;
FILE: foreach my $file ( @{ $self->rscan_dir( $dir ) } ) {
foreach my $regexp ( @{ $args{exclude} } ) {
next FILE if $file =~ $regexp;
}
$files{$file} = File::Spec->abs2rel($file, $dir) if $self->contains_pod( $file )
}
}
return \%files;
}
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
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" );
return;
}
my @install;
while (my ($type, $prereqs) = each %$failures) {
if($type =~ m/^(?:\w+_)?requires$/) {
push(@install, keys %$prereqs);
next;
}
$self->log_info("Checking optional dependencies:\n");
while (my ($module, $status) = each %$prereqs) {
push(@install, $module) if($self->y_n("Install $module?", 'y'));
}
}
return unless @install;
my ($command, @opts) = $self->split_like_shell($self->cpan_client);
# relative command should be relative to our active Perl
# so we need to locate that command
if ( ! File::Spec->file_name_is_absolute( $command ) ) {
my @bindirs = File::Basename::dirname($self->perl);
push @bindirs, map {$self->config->{"install${_}bin"}} '','site','vendor';
for my $d ( @bindirs ) {
my $abs_cmd = $self->find_command(File::Spec->catfile( $d, $command ));
if ( defined $abs_cmd ) {
$command = $abs_cmd;
last;
}
}
}
if ( ! -x $command ) {
die "cpan_client '$command' is not executable\n";
}
$self->do_system($command, @opts, @install);
}
sub ACTION_clean {
my ($self) = @_;
$self->log_info("Cleaning up build files\n");
foreach my $item (map glob($_), $self->cleanup) {
$self->delete_filetree($item);
}
}
sub ACTION_realclean {
my ($self) = @_;
$self->depends_on('clean');
$self->log_info("Cleaning up configuration files\n");
$self->delete_filetree(
$self->config_dir, $self->mymetafile, $self->build_script
);
}
sub ACTION_ppd {
my ($self) = @_;
require Module::Build::PPMMaker;
my $ppd = Module::Build::PPMMaker->new();
my $file = $ppd->make_ppd(%{$self->{args}}, build => $self);
$self->add_to_cleanup($file);
}
sub ACTION_ppmdist {
my ($self) = @_;
$self->depends_on( 'build' );
my $ppm = $self->ppm_name;
$self->delete_filetree( $ppm );
$self->log_info( "Creating $ppm\n" );
$self->add_to_cleanup( $ppm, "$ppm.tar.gz" );
my %types = ( # translate types/dirs to those expected by ppm
lib => 'lib',
arch => 'arch',
bin => 'bin',
script => 'script',
bindoc => 'man1',
libdoc => 'man3',
binhtml => undef,
libhtml => undef,
);
foreach my $type ($self->install_types) {
next if exists( $types{$type} ) && !defined( $types{$type} );
my $dir = File::Spec->catdir( $self->blib, $type );
next unless -e $dir;
my $files = $self->rscan_dir( $dir );
foreach my $file ( @$files ) {
next unless -f $file;
my $rel_file =
File::Spec->abs2rel( File::Spec->rel2abs( $file ),
File::Spec->rel2abs( $dir ) );
my $to_file =
File::Spec->catfile( $ppm, 'blib',
exists( $types{$type} ) ? $types{$type} : $type,
$rel_file );
$self->copy_if_modified( from => $file, to => $to_file );
}
}
foreach my $type ( qw(bin lib) ) {
local $self->{properties}{html_css} = 'Active.css';
$self->htmlify_pods( $type, File::Spec->catdir($ppm, 'blib', 'html') );
}
# create a tarball;
# the directory tar'ed must be blib so we need to do a chdir first
my $target = File::Spec->catfile( File::Spec->updir, $ppm );
$self->_do_in_dir( $ppm, sub { $self->make_tarball( 'blib', $target ) } );
$self->depends_on( 'ppd' );
$self->delete_filetree( $ppm );
}
sub ACTION_pardist {
my ($self) = @_;
# Need PAR::Dist
if ( not eval { require PAR::Dist; PAR::Dist->VERSION(0.17) } ) {
$self->log_warn(
"In order to create .par distributions, you need to\n"
. "install PAR::Dist first."
);
return();
}
$self->depends_on( 'build' );
return PAR::Dist::blib_to_par(
name => $self->dist_name,
version => $self->dist_version,
);
}
( run in 0.503 second using v1.01-cache-2.11-cpan-63c85eba8c4 )