File Coverage

blib/lib/CPAN/Requirements/Dynamic.pm

Criterion	Covered	Total	%
statement	51	57	89.4
branch	14	18	77.7
condition	6	15	40.0
subroutine	11	12	91.6
pod	3	3	100.0
total	85	105	80.9

package CPAN::Requirements::Dynamic;
$CPAN::Requirements::Dynamic::VERSION = '0.002';
use strict;
use warnings;

use Carp 'croak';
use Parse::CPAN::Meta;

sub _version_satisfies {
	my ($version, $range) = @_;
	require CPAN::Meta::Requirements::Range;
	return CPAN::Meta::Requirements::Range->with_string_requirement($range)->accepts($version);
}

my %default_commands = (
	can_run => sub {
		my ($self, $command) = @_;
		require IPC::Cmd;
		return IPC::Cmd::can_run($command);
	},
	config_defined => sub {
		my ($self, $entry) = @_;
		return $self->{config}->get($entry) eq 'define';
	},
	has_env => sub {
		my ($self, $entry) = @_;
		return !!$ENV{$entry};
	},
	has_perl => sub {
		my ($self, $range) = @_;
		return _version_satisfies($], $range);
	},
	is_extended => sub {
		return !!$ENV{EXTENDED_TESTING};
	},
	is_os => sub {
		my ($self, @wanted) = @_;
		return !!grep { $_ eq $^O } @wanted
	},
	is_os_type => sub {
		my ($self, $wanted) = @_;
		require Perl::OSType;
		return Perl::OSType::is_os_type($wanted);
	},
	is_smoker => sub {
		return !!$ENV{AUTOMATED_TESTING};
	},
	want_xs => sub {
		my ($self) = @_;
		return !!0 if $self->{pureperl_only};
		require ExtUtils::HasCompiler;
		return ExtUtils::HasCompiler::can_compile_extension(config => $self->{config});
	},
);

sub new {
	my ($class, %args) = @_;
	return bless {
		config        => $args{config}   || do { require ExtUtils::Config; ExtUtils::Config->new },
		prereqs       => $args{prereqs}  || do { require CPAN::Meta::Prereqs; CPAN::Meta::Prereqs->new },
		commands      => $args{commands} || \%default_commands,
		pureperl_only => $args{pureperl_only},
	}, $class;
}

sub _get_command {
	my ($self, $name) = @_;
	if ($name eq 'or') {
		return sub {
			my ($self, @each) = @_;
			for my $elem (@each) {
				return !!1 if $self->_run_condition($elem);
			}
			return !!0;
		};
	} elsif ($name eq 'and') {
		return sub {
			my ($self, @each) = @_;
			for my $elem (@each) {
				return !!0 if not $self->_run_condition($elem);
			}
			return !!1;
		};
	} else {
		return $self->{commands}{$name} || croak "No such command $name";
	}
}

sub _run_condition {
	my ($self, $condition) = @_;

	my $negate = !!0;
	my ($function, @arguments) = @{ $condition };
	while ($function eq 'not') {
		$function = shift @arguments;
		$negate = !$negate;
	}

	my $method = $self->_get_command($function);
	my $primary = $self->$method(@arguments);
	return $negate ? !$primary : $primary;
}

sub evaluate {
	my ($self, $argument) = @_;
	my $version = $argument->{version};
	croak "Dynamic prereqs spec version $version is not supported" if int $version > 1;
	my @prereqs;

	for my $entry (@{ $argument->{expressions} }) {
		if ($self->_run_condition($entry->{condition})) {
			if ($entry->{error}) {
				die "$entry->{error}\n";
			} elsif (my $prereqs = $entry->{prereqs}) {
				my $phase = $entry->{phase} || 'runtime';
				my $relation = $entry->{relation} || 'requires';
				my $prereqs = { $phase => { $relation => $entry->{prereqs} } };
				push @prereqs, CPAN::Meta::Prereqs->new($prereqs);
			}
		}
	}

	return $self->{prereqs}->with_merged_prereqs(\@prereqs);
}

sub evaluate_file {
	my ($self, $filename) = @_;
	my $structure = Parse::CPAN::Meta->load_file($filename);
	return $self->evaluate($structure);
}

1;

# ABSTRACT: Dynamic prerequisites in meta files

__END__