File Coverage

blib/lib/ExtUtils/Builder/Plan.pm

Criterion	Covered	Total	%
statement	43	64	67.1
branch	11	24	45.8
condition	4	8	50.0
subroutine	11	14	78.5
pod	6	7	85.7
total	75	117	64.1

package ExtUtils::Builder::Plan;
$ExtUtils::Builder::Plan::VERSION = '0.020';
use strict;
use warnings;

use Carp ();
use Scalar::Util ();

sub new {
	my ($class, %args) = @_;
	return bless {
		nodes => $args{nodes} // {}
	}, $class;
}

sub node {
	my ($self, $name) = @_;
	return $self->{nodes}{$name};
}

sub nodes {
	my $self = shift;
	return @{$self->{nodes}}{ $self->node_names };
}

sub node_names {
	my $self = shift;
	return sort keys %{ $self->{nodes} };
}

sub _node_sorter {
	my ($self, $name, $callback, $seen, $loop) = @_;
	Carp::croak("$name has a circular dependency, aborting!\n") if exists $loop->{$name};
	return if $seen->{$name}++;
	if (my $node = $self->{nodes}{$name}) {
		local $loop->{$name} = 1;
		$self->_node_sorter($_, $callback, $seen, $loop) for $node->dependencies;
		$callback->($name, $node);
	} elsif (not -e $name) {
		Carp::confess("Node $name doesn't exist")
	}
	return;
}

sub run {
	my ($self, $targets, %options) = @_;

	my @targets = ref($targets) ? @{$targets} : $targets;
	my (%seen, %loop);
	my $run_node = sub {
		my ($name, $node) = @_;
		return if $self->_up_to_date($node);
		$node->execute(%options);
	};
	$self->_node_sorter($_, $run_node, \%seen, \%loop) for @targets;
	return;
}

sub _up_to_date {
	my ($self, $node) = @_;
	return 0 if $node->type eq 'phony' or not -e $node->target;
	my $mtime = -M _;
	for my $dep_name (sort $node->dependencies) {
		if (my $dep = $self->{nodes}{$dep_name}) {
			return 0 unless $dep->newer_than($mtime);
		} else {
			return 0 unless -e $dep_name && $mtime <= -M _;
		}
	}
	return 1;
}

sub merge {
	my ($self, $other) = @_;
	Carp::croak('Right side of merge is not a Plan') if not $other->isa(__PACKAGE__);
	my $double = join ', ', grep { $other->{nodes}{$_} } keys %{ $self->{nodes} };
	Carp::croak("Found key(s) $double on both sides of merge") if $double;
	my %nodes = (%{ $self->{nodes} }, %{ $other->{nodes} });
	return ref($self)->new(nodes => [ values %nodes ]);
}

sub phonies {
	my ($self) = @_;
	return sort map { $_->target } grep { $_->phony } values %{ $self->{nodes} };
}

1;

# ABSTRACT: An ExtUtils::Builder Plan

__END__