File Coverage

blib/lib/Switch/Again.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	14	14	100.0
condition	11	11	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	75	75	100.0

package Switch::Again;
use 5.006; use strict; use warnings; our $VERSION = '1.00';
use Struct::Match qw/struct/;
use base qw/Import::Export/;

our %EX = (
	'switch' => [qw/all/],
	'sr' => [qw/all/]
);

BEGIN {
	@STRUCT{qw/Regexp CODE/} = (
		sub { $_[1] =~ $_[0]; },
		sub { my $v = eval { $_[0]->($_[1]) }; }
	);
}

sub switch {
	my ($value, $default, @cases);
	$value = shift if (scalar @_ % 2);

	$_[0] eq 'default'
		? do { shift; $default = shift }
		: do { push @cases, { ref => $STRUCT{REF}($_[0]), case => shift, cb => shift } }
	while (@_); # I could map to a hash but...

	my $evil = sub {
		my ($val, @result) = ($_[0]);
		eval {
			@result = $STRUCT{$_->{ref}}($_->{case}, $val);
			@result = () if @result && $result[0] eq '';
			@result;
		} and do {
			@result = ref $_->{cb} eq 'CODE' ? $_->{cb}->($val, @result) : $_->{cb}
		} and last for @cases;
		@result ? wantarray ? @result : shift @result : $default && $default->($val);
	};

	$value ? $evil->($value) : $evil;
}

sub sr {
	my ($search, $replace) = @_;
	return sub {my $v589 = shift; $v589 =~ s/$search/$replace/g; $v589;};
}

1;

__END__;