File Coverage

blib/lib/Worlogog/Restart.pm

Criterion	Covered	Total	%
statement	59	61	96.7
branch	13	14	92.8
condition	1	3	33.3
subroutine	15	15	100.0
pod	5	5	100.0
total	93	98	94.9

package Worlogog::Restart;

use warnings;
use strict;

our $VERSION = '0.01';

use Sub::Exporter -setup => {
	exports => [
		qw(
			case
			bind
			invoke
			find
			compute
		)
	],
};

use Carp qw(croak);
use Scope::OnExit::Wrap qw(on_scope_exit);
use Return::MultiLevel qw(with_return);

our @restarts;

sub bind (&$) {
	my ($body, $handlers) = @_;
	my $limit = @restarts;
	my $guard = on_scope_exit { splice @restarts, $limit };
	push @restarts, \%$handlers;
	$body->()
}

sub case (&$) {
	my ($body, $handlers) = @_;
	my $limit = @restarts;
	my $guard = on_scope_exit { splice @restarts, $limit };
	my $wantlist = wantarray;
	my @v = with_return {
		my ($return) = @_;
		push @restarts, {
			map {
				my $v = $handlers->{$_};
				$_ => sub { $return->($v, @_) }
			} keys %$handlers
		};
		unless (defined $wantlist) {
			$body->();
			return;
		}
		undef, $wantlist ? $body->() : scalar $body->()
	};
	if (my $f = shift @v) {
		return $f->(@v);
	}
	$wantlist ? @v : $v[0]
}

sub _find {
	my ($k) = @_;
	for my $rs (reverse @restarts) {
		my $v = $rs->{$k};
		return $v if $v;
	}
	undef
}

sub invoke {
	my $proto = shift;
	my $code = ref $proto ? $proto->code : _find($proto) || croak qq{No restart named "$proto" is active};
	$code->(@_)
}

sub find {
	my ($name) = @_;
	my $code = _find($name) or return undef;
	require Worlogog::Restart::Restart;
	Worlogog::Restart::Restart->new(
		name => $name,
		code => $code,
	)
}

sub compute {
	my @r;
	for my $rs (reverse @restarts) {
		for my $k (sort keys %$rs) {
			my $v = $rs->{$k};
			require Worlogog::Restart::Restart;
			push @r, Worlogog::Restart::Restart->new(
				name => $k,
				code => $v,
			);
		}
	}
	@r
}

'ok'

__END__