File Coverage

blib/lib/Sub/Talisman/Struct.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	6	6	100.0
condition	4	5	80.0
subroutine	12	12	100.0
pod	1	1	100.0
total	73	74	98.6

package Sub::Talisman::Struct;

use 5.012;
use strict;
use warnings;

BEGIN {
	$Sub::Talisman::Struct::AUTHORITY = 'cpan:TOBYINK';
	$Sub::Talisman::Struct::VERSION   = '0.006';
}

use Sub::Talisman ();
use MooX::Struct 0.016 ();
use Carp qw( confess );
use Exporter::Tiny qw( mkopt );
use namespace::clean;

our @ISA = qw( Sub::Talisman );

sub import
{
	my $class  = shift;
	my $caller = caller;

	foreach my $arg (@{ mkopt \@_ })
	{
		my ($atr, $str) = @$arg;
		$class->setup_for($caller => {
			attribute => $atr,
			struct    => $str,
		});
	}
}

my %PROCESSORS;
my %STRUCTS;
sub setup_for
{
	my ($class, $caller, $opts) = @_;
	$class->SUPER::setup_for($caller, $opts);
	my $proc   = $PROCESSORS{$caller} //= 'MooX::Struct::Processor'->new;
	my $struct = $proc->make_sub(
		$opts->{attribute},
		$opts->{struct} || [],
	);
	$STRUCTS{"$caller\::$opts->{attribute}"} = $struct;
}

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

	my %new;
	my @p = @{ $params || [] };
	my @f = $STRUCTS{$attr}->()->FIELDS;
	confess "Too many parameters for attribute $attr" if @p > @f;
	for my $i ( 0 .. $#p )
	{
		$new{ $f[$i] } = $p[$i];
	}
	my $obj = eval { $STRUCTS{$attr}->()->new(%new) };
	return $obj if $obj;
	chomp(my $msg = $@);
	$msg =~ s{ at \(.+?\) line \d+\.?}{};
	confess $msg;
}

1;

__END__