File Coverage

blib/lib/MooX/VariantAttribute.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	13	16	81.2
condition			n/a
subroutine	11	12	91.6
pod			n/a
total	61	66	92.4

package MooX::VariantAttribute;

use strict;
use warnings;
use Carp qw/croak/;
use MooX::ReturnModifiers;
our $VERSION = '0.07';

sub import {
    my ( $package, @import ) = @_;

    my $target = caller;
    my %modifiers = return_modifiers( $target, [qw/has around with/] );

    my $variant = sub {
        my ( $name, %spec ) = @_;

        if ( my $builder = $spec{builder} ) {
            my $build_name = $builder =~ m/^1$/ ? sprintf "_build_%s", $name : $builder;
            $modifiers{around}->($build_name, sub {
                my ($orig, $self) = (shift, shift);
                return $self->_given_when($self->$orig(@_), $spec{given}, $spec{when}, $name);
            });
        }

        $modifiers{has}->( $name => _construct_attribute( $name, %spec ) );

    };

    $target->can('_given_when')
      or $modifiers{with}->('MooX::VariantAttribute::Role');

    { no strict 'refs'; *{"${target}::variant"} = $variant; }

    return 1;
}

sub _construct_attribute {
    my ( $name, %spec ) = @_;

    my $trigger = sub {
        return $_[0]->_given_when( $_[1], $spec{given}, $spec{when}, $name );
    };

    return (
        is      => 'rw',
        trigger => $trigger,
        (
            $spec{default} ? (
                default => sub {
                    return $_[0]->_given_when(
                        (
                            ref $spec{default} eq 'CODE'
                                ? $spec{default}->()
                                : $spec{default}
                        ),
                        $spec{given},
                        $spec{when},
                        $name
                    );
                }
            ) : ()
        ),
        (
            $spec{builder} ? (
                builder => ref $spec{builder} eq 'CODE' ? sub {
                    return $_[0]->_given_when(
                        $spec{builder}->(),
                        $spec{given},
                        $spec{when},
                        $name
                    );
                } : $spec{builder}
            ) : ()
        ),
        (map {(
            $spec{$_} ? ( $_ => $spec{$_} ) : ()
        )} qw/lazy predicate clearer required reader writer/),
    );
}

1;

__END__