File Coverage

blib/lib/Factory/Sub.pm

Criterion	Covered	Total	%
statement	51	54	94.4
branch	13	14	92.8
condition	1	2	50.0
subroutine	13	13	100.0
pod	2	4	50.0
total	80	87	91.9

package Factory::Sub;
use 5.006; use strict; use warnings;
use Import::Into; use Carp qw/croak/; use Coerce::Types::Standard qw//;
our $VERSION = '0.03';

use overload
	"&{}" => sub {my $self = shift; sub { $self->call(@_) }},
	fallback => 1;

sub import {
	my ($pkg, @import) = @_;
	if (@import) {
		my $target = caller;
		Coerce::Types::Standard->import::into($target, @import)
	}
}

sub new {
	bless { factory => [ ] }, $_[0];
}

sub add {
	my ($self, @args) = @_;
	push @{ $self->{factory} }, \@args;
}

sub call {
	my ($self, @params) = @_;
	FACTORY:
	for my $factory ( @{ $self->{factory} } ) {
		if ( scalar @{$factory} - 1 == scalar @params) {
			my @factory_params = @{clone(\@params)};
			for (my $i = 0; $i < scalar @factory_params; $i++) {
				eval { $factory_params[$i] = $factory->[$i]->(
					ref $factory->[$i] eq 'Type::Tiny'
						&& scalar @{$factory->[$i]->{coercion}->{type_coercion_map}}
							? $factory->[$i]->coerce($factory_params[$i])
							: $factory_params[$i]
				) } or next FACTORY;
			}
			return $factory->[-1]->(@factory_params);
		}
	}
	croak "No matching factory sub for given params " . join " ", @params;
}

sub clone {
	my ($clone) = @_;
	my $ref = ref $clone;
	if ($ref eq 'ARRAY') { return [ map { clone($_) } @{$clone} ]; }
	elsif ($ref eq 'HASH') { return { map +( $_ => clone($clone->{$_}) ), keys %{$clone} }; }
	elsif ($ref eq 'SCALAR') { my $r = clone($$clone); return \$r; }
	return $clone;
}

1;

__END__;