File Coverage

lib/Context/Singleton.pm

Criterion	Covered	Total	%
statement	49	50	98.0
branch	4	4	100.0
condition	6	7	85.7
subroutine	19	20	95.0
pod			n/a
total	78	81	96.3

use strict;
use warnings;
use feature 'state';

package Context::Singleton;

our $VERSION = v1.0.4;

use parent 'Exporter::Tiny';

use Sub::Install qw();
use Variable::Magic qw();

use Context::Singleton::Frame;

our @EXPORT = keys %{ _by_frame_class_accessors () };

sub _by_frame_class_accessors {
	my ($frame_class) = @_;
	$frame_class //= 'Context::Singleton::Frame';

	state %cache;

	return $cache{$frame_class} //= do {
		my $current_frame = $frame_class->new;

		my $restore_context_wizard = Variable::Magic::wizard
			free => sub { $current_frame = $current_frame->parent; 1 },
		;

		my $frame = sub (&) {
			Variable::Magic::cast my $guard => $restore_context_wizard;
			$current_frame = $current_frame->new;

			$_[0]->();
		};

		+{
			contrive      => sub { $current_frame->contrive (@_) },
			current_frame => sub { $current_frame },
			deduce        => sub { $current_frame->deduce (@_) },
			frame         => $frame,
			is_deduced    => sub { $current_frame->is_deduced (@_) },
			load_rules    => sub { $current_frame->load_rules (@_) },
			proclaim      => sub { $current_frame->proclaim (@_) },
			trigger       => sub { $current_frame->trigger (@_) },
			try_deduce    => sub { $current_frame->try_deduce (@_) },
		};
	};
}

sub _exporter_expand_sub {
	my ($class, $name, $args, $globals) = @_;

	return $name => _by_frame_class_accessors ($globals->{frame_class})->{$name};
}

sub import {
	my ($class, @params) = @_;

	my $globals = Ref::Util::is_hashref ($params[0])
		? shift @params
		: {}
		;

	$globals->{into} //= scalar caller;

	$class->SUPER::import ($globals, @params);

	_by_frame_class_accessors ($globals->{frame_class})->{load_rules}->(@{ $globals->{load_path} })
		if $globals->{load_path};

}

1;

__END__