view release on metacpan or  search on metacpan

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

            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);
    ::is_deeply([20, 'item_accessor', $y_attr, 1], [$y_value, $y_scope, $y_attribute, $y_index], 'should trigger on change for array by item accessor');

    $on_change->z({ a => '1'});
    ::is_deeply([{ a => '1'}, 'mutator', $z_attr], [$z_value, $z_scope, $z_attribute], 'should trigger on change for hash');

    $on_change->z_value( b => '10');
    ::is_deeply([10, 'item_accessor', $z_attr, 'b'], [$z_value, $z_scope, $z_attribute, $z_key], 'should trigger on change for hash');
    ::is_deeply({ a => '1', b => 10}, {$on_change->z}, 'should have modyfied hash');
    
    $on_change->set_a('100');
    ::ok(! $on_change->a, 'should not change a attribute');
}



{
    package Transistent;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    has '$.x' => (required => 1);
    has '$.t' => (transistent => 3);
    has '%.th' => (transistent => 1, item_accessor => 'item_t');
    has '@.ta' => (transistent => 1);
    
    my $obj = Transistent->new(x => 1, t => 2, th => {a => 1, b => 2}, ta => [1,2]);
    ::ok(@$obj == 1, 'should have only x stored in object');
    ::is($obj->t, 2, 'should have value for t');
    
    ::is($obj->item_t('a'), '1', 'should have 1');
    ::is($obj->item_t('b'), '2', 'should have 2');
    
    $obj->cleanup;
    ::is($obj->t, undef, 'should not have value for t after cleanup method was called');

}   



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

    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'; storage_type 'Array';
    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, [1, [1,2]], 'should have storage key');
}

{
    package Validate;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    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');
}