view release on metacpan or  search on metacpan

lib/Context/Singleton/Frame.pm  view on Meta::CPAN

use v5.10;
use strict;
use warnings;

package Context::Singleton::Frame;

our $VERSION = v1.0.5;

use List::Util;
use Scalar::Util;

use Context::Singleton::Frame::DB;
use Context::Singleton::Exception::Invalid;
use Context::Singleton::Exception::Deduced;
use Context::Singleton::Exception::Nondeducible;
use Context::Singleton::Frame::Promise;
use Context::Singleton::Frame::Promise::Builder;
use Context::Singleton::Frame::Promise::Rule;

use overload (
	'""' => sub { ref ($_[0]) . '[' . $_[0]->{depth} . ']' },
	fallback => 1,
);

sub new {
	my ($class, %proclaim) = @_;
	my $self = {
		promises    => {},
		depth       => 0,
		db          => $class->default_db_instance,
	};

	if (ref $class) {
		$self->{root}   = $class->{root};
		$self->{parent} = $class;
		$self->{db}     = $class->{db};
		$self->{depth}  = $class->{depth} + 1;

		$class = ref $class;
	}

	unless ($self->{root}) {
		$self->{root} = $self;
		Scalar::Util::weaken $self->{root};
	}

	$self = bless $self, $class;

	$self->proclaim (%proclaim);

	return $self;
}

sub depth {
	$_[0]->{depth};
}

sub parent {
	$_[0]->{parent};
}

sub default_db_class {
	'Context::Singleton::Frame::DB';
}

sub default_db_instance {
	$_[0]->default_db_class->instance;
}

sub db {
	$_[0]->{db};
}

sub debug {
	my ($self, @message) = @_;

	my $sub = (caller(1))[3];
	$sub =~ s/^.*://;

	use feature 'say';
	say "# [${\ $self->depth}] $sub ${\ join ' ', @message }";
}

sub _build_builder_promise_for {
	my ($self, $builder) = @_;

	my $promise = $self->_class_builder_promise->new (
		depth   => $self->depth,
		builder => $builder,
	);

	my %optional = $builder->default;
	my %required = map +($_ => 1), $builder->required;
	delete @required{ keys %optional };

	$promise->add_dependencies (
		map $self->_search_promise_for ($_), keys %required
	);

	$promise->set_deducible (0) unless keys %required;

	$promise->listen ($self->_search_promise_for ($_))
		for keys %optional;