view release on metacpan or  search on metacpan

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

        Abstract::Meta::Attribute::Method::delete_object($this) if $has_transistent;
    });
    $self->set_cleanup_method(1);
}


=item install_destructor

Install destructor method

=cut

sub install_destructor {
    my ($self) = @_;
    return if $self->has_destory_method;
    add_method($self->associated_class, 'DESTROY' , sub {
        my $this = shift;
        $this->cleanup;
        $this;
    });
    $self->set_destroy_method(1);
}



=item install_constructor

Install constructor

=cut

sub install_constructor {
    my ($self) = @_;
    add_method($self->associated_class, 'new' ,
        $self->storage_type eq 'Array' ?
        sub {
            my $class = shift;
            my $this = bless [], $class;
            unshift @_, $this;
            &apply_contructor_parameters;
        }: sub {
            my $class = shift;
            my $this = bless {}, $class;
            unshift @_, $this;
            &apply_contructor_parameters;
        });
}


=item apply_contructor_parameters

Applies constructor parameters.

=cut

{
    sub apply_contructor_parameters {
        my ($self, @args) = @_;
        my $mutator;
        my $class = ref($self);
        eval {
            for (my $i = 0; $i < $#args; $i += 2) {
                    $mutator = "set_" . $args[$i];
                    $self->$mutator($args[$i + 1]);
            }
        };
        
        if ($@) {
            confess "unknown attribute " . ref($self) ."::" . $mutator
                unless $self->can($mutator);
            confess $@    
        }
        
        my $meta = $self->meta;
        return $self if $self eq $meta;
    
        for my $attribute ($meta->constructor_attributes) {
            if(! $attribute->get_value($self)) {
                my $can = $self->can($attribute->mutator) or next;
                $can->($self);
            }
        }
    
        my $initialise = $self->can($meta->initialise_method);
        $initialise->($self) if $initialise;
        $self;
    }
}

=item meta

=cut

sub meta { shift(); }


=item attributes

Returns attributes for meta class

=cut

sub attributes { shift()->{'@.attributes'} || {};}


=item set_attributes

Mutator sets attributes for the meta class

=cut

sub set_attributes { $_[0]->{'@.attributes'} = $_[1]; }



=item has_cleanup_method

Returns true if cleanup method was generated

=cut