File Coverage

blib/lib/MooX/VariantAttribute/Role.pm

Criterion	Covered	Total	%
statement	75	78	96.1
branch	44	48	91.6
condition	9	12	75.0
subroutine	11	11	100.0
pod			n/a
total	139	149	93.2

package MooX::VariantAttribute::Role;

use Moo::Role;
use Carp qw/croak/;
use Scalar::Util qw/blessed refaddr reftype/;
use Combine::Keys qw/combine_keys/;

has variant_last_value => (
    is      => 'rw',
    lazy    => 1,
    default => sub { {} },
);

sub _given_when {
    my ($self) = shift;
    my ( $set, $given, $when, $attr ) = @_;

    return if $self->_variant_last_value($attr, 'set', $set);

    my $find = $self->_find_from_given(@_);

    $self->variant_last_value->{$attr}->{find} = $find;

    my @when = @{ $when };
    while (scalar @when >= 2) {
        my $check = shift @when;
        my $found = shift @when;
        if ( _struct_the_same($check, $find) ) {
            if ( $found->{alias} ) {
                if (blessed $set) {
                    for my $alias ( keys %{ $found->{alias} } ) {
                        next if $set->can($alias);
                        my $actual = $found->{alias}->{$alias};
                        {
                            no strict 'refs';
                            *{"${find}::${alias}"} = sub { goto &{"${find}::${actual}"} };
                        }
                    }
                } else {
                    map { $set->{$_} = $set->{$found->{alias}->{$_}} } keys %{ $found->{alias} };
                }
            }

            if ( my $run = $found->{run} ) {
                my @new = ref $run eq 'CODE'
                    ? $found->{run}->( $self, $find, $set, )
                    : $self->$run($find, $set);
                $set = scalar @new > 1 ? \@new : shift @new;
            }

            $self->variant_last_value->{$attr}->{set} = $set;
            return $self->$attr($set);
        }
    }

    croak sprintf 'Could not find - %s - in when spec for attribute - %s',
      $set, $attr;
}

sub _variant_last_value {
    my ($self, $attr, $value, $set) = @_;

    my $stored = $self->variant_last_value->{$attr}->{$value} or return undef;
    return _ref_the_same($stored, $set);
}

sub _ref_the_same {
    my ($stored, $passed) = @_;

    if ( ref $passed and ref $stored ) {
        return refaddr($stored) == refaddr($passed) ? 1 : undef;
    }

    return ($stored =~ m/^$passed$/) ? 1 : undef;
}

sub _struct_the_same {
    my ($stored, $passed) = @_;

    my $stored_ref = reftype($stored) // reftype(\$stored);
    my $passed_ref = reftype($passed) // reftype(\$passed);
    $stored_ref eq $passed_ref or return undef;

    if ( $stored_ref eq 'SCALAR') {
          return ($stored =~ m/^$passed$/) ? 1 : undef;
    } elsif ($stored_ref eq 'HASH') {
        for (combine_keys($stored, $passed)) {
            $stored->{$_} and $passed->{$_} or return undef;
            _struct_the_same($stored->{$_}, $passed->{$_}) or return undef;
        }
        return 1;
    } elsif ($stored_ref eq 'ARRAY') {
        my @count = (scalar @{$stored}, scalar @{$passed});
        $count[0] == $count[1] or return undef;
        for ( 0 .. $count[1] - 1 ) {
            _struct_the_same($stored->[$_], $passed->[$_]) or return undef;
        }
        return 1;
    }

    return 1;
}

sub _find_from_given {
    my ( $self, $set, $given, $when ) = @_;

    my $ref_given = ref $given;
    if ( $ref_given eq 'Type::Tiny' ) {
        $set = $given->($set);
        return $given->display_name eq 'Object' ? ref $set : $set;
    }
    elsif ( $ref_given eq 'CODE' ) {
        return $given->( $self, $set );
    }

    return $set;
}

1;

__END__