Abstract-Meta-Class

 view release on metacpan or  search on metacpan

lib/Abstract/Meta/Attribute/Method.pm  view on Meta::CPAN

=item deassociate_scalar_as_the_other_end

=cut

sub deassociate_scalar_as_the_other_end {
    my ($attr, $self, $the_other_end_obj) = @_;
    $the_other_end_obj or return;
    my $accessor = $attr->accessor;
    $the_other_end_obj->$accessor(undef);
    undef;
}


=item deassociate_hash_as_the_other_end

=cut

sub deassociate_hash_as_the_other_end {
    my ($attr, $self, $the_other_end_obj) = @_;
    my $accessor = $attr->accessor;

lib/Abstract/Meta/Attribute/Method.pm  view on Meta::CPAN

        delete $value->{$self->$index_by} if exists($value->{$self->$index_by});
    } else {
        my @keys = keys %$value;
        foreach my $k (@keys) {
            if ($value->{$k} eq $self) {
                delete $value->{$k};
                return;
            }
        }
    }
    undef;
}


=item deassociate_array_as_the_other_end

=cut

sub deassociate_array_as_the_other_end {
    my ($attr, $self, $the_other_end_obj) = @_;
    my $accessor = $attr->accessor;
    my $value = $the_other_end_obj->$accessor;
    for my $i (0 .. $#{$value}) {
        if ($value->[$i] eq $self) {
            splice @$value, $i--, 1;
        }
    }
    undef;
}


=item generate_scalar_mutator_method

=cut

sub generate_scalar_mutator_method {
    shift()->generate_mutator_method;
}

lib/Abstract/Meta/Attribute/Method.pm  view on Meta::CPAN

=item generate_scalar_reset_method

=cut

sub generate_scalar_reset_method {
    my $attr = shift;
    my $mutator = $attr->mutator;
    my $index_by = $attr->index_by;
    sub {
        my ($self, ) = @_;
        $self->$mutator(undef);
    };
}


=item generate_scalar_has_method

=cut

sub generate_scalar_has_method {
    my $attr = shift;

lib/Abstract/Meta/Attribute/Method.pm  view on Meta::CPAN

=cut

#TODO add on_remove trigger

sub generate_hash_remove_method {
    my $attr = shift;
    my $accessor = $attr->accessor;
    my $item_accessor = $attr->item_accessor;
    my $the_other_end = $attr->the_other_end;
    my $meta =  Abstract::Meta::Class::meta_class($attr->associated_class);
    my $reflective_attribute = $the_other_end && $meta ? $meta->attribute($the_other_end) : undef;
    my $index_by = $attr->index_by;
    sub {
        my ($self, @values) = @_;
        my $hash_ref = $self->$accessor();
        foreach my $value (@values) {
            next unless ref($value);
            my $key = ($index_by && ref($value) ? $value->$index_by : $value . "");
            $attr->deassociate($self);
            $reflective_attribute->set_value($hash_ref->{$key}, undef)
                if $reflective_attribute;
            delete $hash_ref->{$key};
        }
        $self;
    };
}



=item generate_array_item_accessor_method

lib/Abstract/Meta/Attribute/Method.pm  view on Meta::CPAN

=cut

#TODO add on_remove trigger

sub generate_array_remove_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    my $accessor = $attr->accessor;
    my $the_other_end = $attr->the_other_end;
    my $meta =  Abstract::Meta::Class::meta_class($attr->associated_class);
    my $reflective_attribute = $the_other_end && $meta ? $meta->attribute($the_other_end) : undef;
    sub {
        my ($self, @values) = @_;
        my $array_ref = $self->$accesor();
        foreach my $value(@values) {
            for my $i (0 .. $#{$array_ref}) {
                if ($array_ref->[$i] && $array_ref->[$i] eq $value) {
                    $reflective_attribute->set_value($value, undef)
                        if $reflective_attribute;
                    splice @$array_ref, $i--, 1;
                }
            }
        }
        $self;
    };
}

lib/Abstract/Meta/Class.pm  view on Meta::CPAN

    has '$.attr5';
    has '$.attr6' => (default => sub { 'stuff' } , required => 1);


    my $dummy = Dummy->new(
        attr4 => sub {},
    );
    
    use Data::Dumper;
    warn Dumper $dummy;
    # bless [0, {a =>1,b => 3}, [1,2,3],sub{},undef,sub {}], 'Dummy'

=head2 simple validation and default values

    package Dummy;

    use Abstract::Meta::Class ':all';

    has '$.attr1' => (default => 0);
    has '&.att3' => (required => 1);

lib/Abstract/Meta/Class.pm  view on Meta::CPAN

    add_method($self->associated_class, 'cleanup' , sub {
        my $this = shift;
        my $has_transistent;
        my $attributes ||= $self ? $self->all_attributes : [];
        for my $attribute (@$attributes) {
            $attribute or next;
            $has_transistent = 1 if($attribute->transistent);
            if($attribute->the_other_end) {
                $attribute->deassociate($this);
                my $accessor = "set_" . $attribute->accessor;
                $this->$accessor(undef);
            }
        }
        Abstract::Meta::Attribute::Method::delete_object($this) if $has_transistent;
    });
    $self->set_cleanup_method(1);
}


=item install_destructor

lib/Abstract/Meta/Class.pm  view on Meta::CPAN

=item attribute

Returns attribute object

=cut

sub attribute {
    my ($self, $name) = @_;
    my $attributes = $self->all_attributes;
    my @result = (grep {$_->accessor eq $name} @$attributes);
    @result ? $result[0] : undef;
}





=item super_classes

=cut

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

        my $master2 = MasterA->new(name    => 'foo2');
        $details[-1]->set_master($master2);
        my @detail1 = $master->details;
        
        ::is_deeply(\@detail1, [@details[0 .. 1]], 'should have 2 details elements');
        ::is($master2->detail(0), $details[-1], "should have details");
        
        
        
        $master->cleanup;
        ::is($_->master, undef, 'should be deassociiated') for @details[0 .. 1];
        
        my $details = $master->details;
        ::is_deeply($details, [], 'should not have details association');
    }


    {    
        my @details  = (
            DetailA->new(id => 1),
            DetailA->new(id => 2),

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

    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;

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

        my $master2 = MasterA->new(name    => 'foo2');
        $details[-1]->set_master($master2);
        my @detail1 = $master->details;
        
        ::is_deeply(\@detail1, [@details[0 .. 1]], 'should have 2 details elements');
        ::is($master2->detail(0), $details[-1], "should have details");
        
        
        
        $master->cleanup;
        ::is($_->master, undef, 'should be deassociiated') for @details[0 .. 1];
        
        my $details = $master->details;
        ::is_deeply($details, [], 'should not have details association');
    }


    {    
        my @details  = (
            DetailA->new(id => 1),
            DetailA->new(id => 2),

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

    has '@.ta' => (transistent => 1);
    
    my $obj = Transistent->new(x => 1, t => 2, th => {a => 1, b => 2}, ta => [1,2]);
    ::is_deeply([keys %$obj], ['$.x'], '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';

    my %access_log;