Abstract-Meta-Class

 view release on metacpan or  search on metacpan

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

    if ($index_by) {
        $value->$item_accessor($self->$index_by, $self);
    } else {
        $value->$item_accessor($self . "", $self);
    }
}


=item associate_array_as_the_other_end

=cut

sub associate_array_as_the_other_end {
    my ($attr, $self, $value) = @_;
    my $the_other_end = $attr->the_other_end;
    my $associated_class = $attr->associated_class;    
    my $the_other_end_attribute = $associated_class->meta->attribute($the_other_end);
    my $other_end_accessor = $the_other_end_attribute->accessor;
    my $setter = "push_${other_end_accessor}";
    $value->$setter($self);
}


=item deassociate

Deassociates assoication values

=cut

sub deassociate {
    my ($attr, $self) = @_;
    my $transistent = $attr->transistent;    
    my $storage_key = $attr->storage_key;
    my $array_storage_type = $attr->storage_type eq 'Array';
    my $value = ($transistent ? get_attribute($self, $storage_key) : ($array_storage_type ? $self->[$storage_key] : $self->{$storage_key})) or return;
    my $the_other_end = $attr->the_other_end;
    return if ! $the_other_end || has_pending_association($value);
    start_association_process($self);
    my $associated_class = $attr->associated_class;
    my $the_other_end_attribute = $associated_class->meta->attribute($the_other_end);
    my $deassociation_call = 'deassociate_' . lc($the_other_end_attribute->perl_type) . '_as_the_other_end';
    if(ref($value) eq 'ARRAY') {
        $the_other_end_attribute->$deassociation_call($self, $_) for @$value;
    } elsif(ref($value) eq 'HASH') {
        $the_other_end_attribute->$deassociation_call($self, $value->{$_}) for(keys %$value);
    } else {
        $the_other_end_attribute->$deassociation_call($self, $value);
    }
    end_association_process($self);
}


=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;
    my $value = $the_other_end_obj->$accessor;
    my $index_by = $attr->index_by;
    if ($index_by) {
        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;
}


=item generate_code_mutator_method

=cut

sub generate_code_mutator_method {
    shift()->generate_mutator_method;
}


=item generate_array_accessor_method

=cut

sub generate_array_accessor_method {
    my $attr = shift; 
    my $mutator = $attr->mutator;
    my $storage_key = $attr->storage_key;
    my $transistent = $attr->transistent;
    my $on_read = $attr->on_read;
    my $array_storage_type = $attr->storage_type eq 'Array';
    $array_storage_type ?
    sub {
        my ($self, @args) = @_;
        $self->$mutator(@args) if scalar(@args) >= 1;
        my $result = $on_read ? $on_read->($self, $attr, 'accessor')
        : ($transistent ? get_attribute($self, $storage_key) : ($self->[$storage_key] ||= []));
        wantarray ? @$result : $result;
    }    
    :
    sub {
        my ($self, @args) = @_;
        $self->$mutator(@args) if scalar(@args) >= 1;
        my $result = $on_read ? $on_read->($self, $attr, 'accessor')
        : ($transistent ? get_attribute($self, $storage_key) : ($self->{$storage_key} ||= []));
        wantarray ? @$result : $result;
    };
}


=item generate_array_mutator_method

=cut

sub generate_array_mutator_method {
    shift()->generate_mutator_method;
}

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

=item generate_hash_item_accessor_method

=cut

sub generate_hash_item_accessor_method {
    my $attr = shift;
    my $accesor =  $attr->accessor;
    my $on_change = $attr->on_change;
    my $on_read = $attr->on_read;
    sub {
        my $self = shift;
        my ($key, $value) = (@_);
        my $hash_ref = $self->$accesor();
        if(defined $value) {
            $on_change->($self, $attr, 'item_accessor', \$value, $key) or return $hash_ref->{$key}
              if ($on_change);
            $hash_ref->{$key} = $value;
        }
        $on_read ? $on_read->($self, $attr, 'item_accessor', $key) : $hash_ref->{$key};
    };
}


=item generate_hash_add_method

=cut

sub generate_hash_add_method {
    my $attr = shift;
    my $accessor = $attr->accessor;
    my $item_accessor = $attr->item_accessor;
    my $on_change = $attr->on_change;
    my $on_read = $attr->on_read;
    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 ? $value->$index_by : $value . "") or confess "unknown key hash at add_$accessor";
            $attr->validate_associated_class($self, $value);
            $on_change->($self, $attr, 'item_accessor', \$value, $key) or return $hash_ref->{$key}
              if ($on_change);
            $hash_ref->{$key} = $value;
        }
        $self;
    };
}


=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;
    sub {
        my ($self, ) = @_;
        !! $attr->get_value($self);
    };
}


=item generate_hash_reset_method

=cut

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



=item generate_hash_has_method

=cut

sub generate_hash_has_method {
    my $attr = shift;
    sub {
        my ($self, ) = @_;
        my $value = $attr->get_value($self);
        !! ($value && keys %$value);
    };
}



=item generate_array_reset_method

=cut

sub generate_array_reset_method {
    my $attr = shift;
    my $mutator = $attr->mutator;
    my $index_by = $attr->index_by;
    sub {
        my ($self, ) = @_;
        $self->$mutator([]);
    };
}


=item generate_array_has_method

=cut

sub generate_array_has_method {
    my $attr = shift;
    sub {
        my ($self, ) = @_;
        my $value = $attr->get_value($self);
        !! ($value && @$value);
    };
}


=item generate_hash_remove_method

=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

=cut

sub generate_array_item_accessor_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    my $on_change = $attr->on_change;
    my $on_read = $attr->on_read;
    sub {
        my $self = shift;
        my ($index, $value) = (@_);
        my $hash_ref = $self->$accesor();
        if (defined $value) {
            $on_change->($self, $attr, 'item_accessor', \$value, $index) or return $hash_ref->[$index]
              if ($on_change);
            $hash_ref->[$index] = $value;
        }
        $on_read ? $on_read->($self, $attr, 'item_accessor', $index) : $hash_ref->[$index];
    };
}


=item generate_array_push_method

=cut

sub generate_array_push_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    sub {
        my $self = shift;
        my $array_ref = $self->$accesor();
        push @$array_ref, @_;
    };
}


=item generate_array_pop_method

=cut

sub generate_array_pop_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    sub {
        my $self = shift;
        my $array_ref = $self->$accesor();
        pop @$array_ref;
    };
}

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

sub generate_array_unshift_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    sub {
        my $self = shift;
        my $array_ref = $self->$accesor();
        unshift @$array_ref, @_;
    };
}


=item generate_array_count_method

=cut

sub generate_array_count_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    sub {
        my $self = shift;
        my $array_ref = $self->$accesor();
        scalar @$array_ref;
    };
}


=item generate_array_add_method

=cut

sub generate_array_add_method {
    my $attr = shift;
    my $accesor = $attr->accessor;
    my $accessor = $attr->accessor;
    my $the_other_end = $attr->the_other_end;
    my $associated_class = $attr->associated_class;
    sub {
        my ($self, @values) = @_;
        my $array_ref = $self->$accesor();
        foreach my $value (@values) {
            $attr->validate_associated_class($self, $value, $accessor, $associated_class, $the_other_end);
            push @$array_ref, $value;
        }
        $self;
    };
}


=item generate_array_remove_method

=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;
    };
}


=item generate

Returns code reference.

=cut

sub generate {
    my ($self, $method_name) = @_;
    my $call = "generate_" . lc($self->perl_type) . "_${method_name}_method";
    $self->$call;
}


=item set_value

Sets value for attribute

=cut

sub set_value {
    my ($attr, $self, $value) = @_;
    my $array_storage_type = $attr->storage_type eq 'Array';
    my $storage_key = $attr->storage_key;
    my $transistent = $attr->transistent;
    if($transistent) {
        set_attribute($self, $storage_key, $value);
    } elsif($array_storage_type) {
        $self->[$storage_key] = $value;
    } else {
        $self->{$storage_key} = $value;
    }
}


=item get_value

Returns value for attribute

=cut

sub get_value {
    my ($attr, $self) = @_;
    my $storage_key = $attr->storage_key;
    my $transistent = $attr->transistent;
    my $array_storage_type = $attr->storage_type eq 'Array';
    if ($transistent) {
        return get_attribute($self, $storage_key);
    } elsif($array_storage_type) {
        $self->[$storage_key];
    } else {