File Coverage

lib/Class/Dot/Object.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	16	16	100.0
condition	2	3	66.6
subroutine	14	14	100.0
pod	0	1	0.0
total	80	82	97.5

# $Id$
# $Source$
# $Author$
# $HeadURL$
# $Revision$
# $Date$
package Class::Dot::Object;

use strict;
use warnings;
use version;
use 5.00600;
use dot::meta; # the metaclass psuedoclass.

our $VERSION    = qv('2.0.0_15');
our $AUTHORITY  = 'cpan:ASKSH';


use Class::Dot::Registry;
my $REGISTRY = Class::Dot::Registry->new();

my $ATTR_EXISTS         = 1;
my $ATTR_EXISTS_CACHED  = 2;
my $ATTR_NO_SUCH_ATTR;        #<< must be undef.

sub __getattr__ {
    my ($self, $attribute) = @_;
    if (! exists $self->{$attribute}) {
        my $attr_meta = $self->__meta__($attribute);
        return if not defined $attr_meta;
        $self->{$attribute} = $attr_meta->default_value();
    }
    return $self->{$attribute};
}

sub __hasattr__ {
    my ($self, $attribute) = @_;

    my $is_finalized = $REGISTRY->is_finalized($self);
    my $isa_cache    = $REGISTRY->get_isa_cache_for($self);
    if ($is_finalized && $isa_cache) {
        return defined $isa_cache->{$attribute} ? $ATTR_EXISTS_CACHED
            : $ATTR_NO_SUCH_ATTR;
    }

    my $property_meta = $self->__metaclass__->property;
    return $property_meta->traverse_isa_for_property($self, $attribute)
        ? $ATTR_EXISTS
        : $ATTR_NO_SUCH_ATTR;
}

sub __setattr__ {
    my ($self, $attribute, $value) = @_;
    return if not $self->__hasattr__($attribute);

    $self->{$attribute} = $value;

    return 1;
}

sub __is_finalized__ {
    my ($self) = @_;

    return $REGISTRY->is_finalized($self);
}

sub __finalize__ {
    my ($self) = @_;
    return 1 if $self->__is_finalized__;

    my $metaclass = $self->__metaclass__;
    my $isa_cache = $metaclass->property->traverse_isa_for_property($self);

    return $REGISTRY->finalize_class($self, $isa_cache);
}

sub __meta__ {
    my ($self, $property_name) = @_;

    my $all_meta = $self->__metaclass__->property->properties_for_class($self);

    return defined $property_name ? $all_meta->{$property_name}
        : $all_meta
}

sub __metaclass__ {
    goto &HOW;
}

sub HOW {
    my ($self) = @_;
    return $REGISTRY->get_metaclass_for($self);
}

1;

__END__