view release on metacpan or  search on metacpan

t/meta/attribute.t  view on Meta::CPAN

}

my $hash = Dummy::Hash->new(xs => {key1 => 1, key2 => 2});
isa_ok($hash, 'Dummy::Hash', 'should have a Dummy::Hash instance');
is($hash->x('key1'), 1, 'should have key1 value');
is($hash->x('key2'), 2, 'should have key2 value');


{
  package Dummy::Array;
  use Abstract::Meta::Class ':all';
  has '@.xs' => (item_accessor => 'x');
}

my $array = Dummy::Array->new(xs => [3, 2, 1]);
isa_ok($array, 'Dummy::Array', 'should have a Dummy::Array instance');
my $array_ref = $array->xs; # scalar context
is_deeply($array_ref, [3, 2, 1], 'should have xs attribute');
my @array = $array->xs; #list contect
is(@array, 3, 'should have 3 items');
is($array->x(0), 3, 'should have [0] value');
is($array->x(1), 2, 'should have [1] value');

is($array->count_xs, 3, 'should count');
is($array->push_xs(0,7), 5, 'should extent array by push');
is($array->x(4), 7, 'should have the last extended item');
is($array->pop_xs, 7, 'should pop item');
is($array->unshift_xs(5, 6), 6, 'should extent array by unshift');
is($array->x(0), 5, 'should have the first extended item');
is($array->shift_xs, 5, 'should shit item');
  

{
    package Dummy::Default;
    use Abstract::Meta::Class ':all';
    has '$.z' => (default => 0);
    has '$.x' => (default => 'x');
    has '%.h' => (default => {a => 1});
    has '@.a' => (default => [1, 2, 3], required => 1);
    has '&.c' => (required => 1);
    has '$.d' => (default => sub { 'stuff' } , required => 1);
}

my $default = Dummy::Default->new(c => sub {123});
isa_ok($default, 'Dummy::Default');
is($default->x, 'x', 'should have default for the x attribute');
is_deeply({$default->h}, {a => 1}, 'should have default for the h attribute');
is_deeply([$default->a], [1, 2, 3], 'should have default for the a attribute');
is($default->d, 'stuff', 'should have default for the x attribute');
is($default->z, 0, 'should have 0 as default value');
is($default->c->(), '123', 'should have code value');


{
    package Dummy::OnChange;
    use Abstract::Meta::Class ':all';

    has '$.a' => (
        on_change => sub {
            my ($self, $attribute, $scope, $value_ref) = @_;
            # validate
            # does not change anything if return false
            return !! 0;
        },
    );

    my $x_value;
    my $x_attribute;
    my $x_scope;

    my $x_attr = has '$.x' => (
        on_change => sub {
            my ($self, $attribute, $scope, $value_ref) = @_;
            $x_value = $$value_ref;
            $x_attribute = $attribute;
            $x_scope = $scope;
            $self;
        },
    );

    my $y_value;
    my $y_attribute;
    my $y_scope;
    my $y_index;
    my $y_attr = has '@.y' => (
        on_change => sub {
            my ($self, $attribute, $scope, $value_ref, $index) = @_;
            $y_value = $$value_ref;
            $y_attribute = $attribute;
            $y_scope = $scope;
            $y_index = $index;
            $self;
        },
        item_accessor => 'y_item'
    );

    my $z_value;
    my $z_attribute;
    my $z_scope;
    my $z_key;
    my $z_attr = has '%.z' => (
        on_change => sub {
            my ($self, $attribute, $scope, $value, $key) = @_;
            $z_value = $$value;
            $z_attribute = $attribute;
            $z_scope = $scope;
            $z_key = $key;
            $self;
        },
        item_accessor => 'z_value'
    );
    
    my $on_change = Dummy::OnChange->new;
    ::isa_ok($on_change, 'Dummy::OnChange', 'should have a Dummy::OnChange instance');
    $on_change->x(100);
    ::is_deeply([100, 'mutator', $x_attr], [$x_value, $x_scope, $x_attribute], 'should trigger on change for scalar');

    $on_change->y(['1', '2', '3']);
    ::is_deeply([['1', '2', '3'], 'mutator', $y_attr], [$y_value, $y_scope, $y_attribute], 'should trigger on change for array');

    $on_change->y_item(1, 20);

t/meta/attribute.t  view on Meta::CPAN

}   



{
    package DynamicInterceptor;
    use Abstract::Meta::Class ':all';

    my %access_log;
    has '%.attrs' => (
        on_read => sub {
            my ($self, $attribute, $scope, $key) = @_;
            my $values = $attribute->get_value($self);
            $access_log{$scope}++;
            
            if ($scope eq 'accessor') {
                return $values;
            } else {
                return $values->{$key};
            }
        },
        item_accessor => 'attr'
    );
    
    my $attr = DynamicInterceptor->meta->attribute('attrs'); 
    my $code_ref = $attr->on_read;
    my $obj = DynamicInterceptor->new(attrs => {a => 1, b => 2});
    
    my $a = $obj->attr('a');
 
    my %hook_access_log;
    my $ncode_ref = sub {
        my ($self, $attribute, $scope, $key) = @_;
        $hook_access_log{$scope}++;
        #do some stuff
        $code_ref->($self, $attribute, $scope, $key);
    };
    
    
    $attr->set_on_read($ncode_ref);
    
    my $b = $obj->attr('b');
    ::is_deeply(\%access_log, {item_accessor => 2, accessor => 2}, 'should have updated access log');
    ::is_deeply(\%hook_access_log, {item_accessor => 1, accessor => 1}, 'should have updated hook_access_log');
}


{
    package StorageKey;
    use Abstract::Meta::Class ':all';
    has '$.x' => (required => 1, storage_key => 'x');
    has '@.y' => (required => 1, storage_key => 'y');
    
    my $obj = StorageKey->new(x => 1, y => [1,2]);
    ::is_deeply($obj, {x => 1, y =>[1,2]}, 'should have storage key');
}

{
    package Validate;
    use Abstract::Meta::Class ':all';
    my $attr = has '$.x' => (on_validate => sub {
        
    });
    $attr->set_on_validate(
        sub {
            my ($self, $attribute, $scope, $value) = @_;
            die 'invalid value' if($$value ne 1);
        }
    );
    eval {
        Validate->new(x => 2);
    };
    ::like($@, qr{invalid value}, 'should validate');
    ::isa_ok(Validate->new(x => 1), 'Validate');
}