File Coverage

lib/DBIx/EAV/Entity.pm

Criterion	Covered	Total	%
statement	188	203	92.6
branch	73	106	68.8
condition	37	64	57.8
subroutine	23	25	92.0
pod	11	13	84.6
total	332	411	80.7

package DBIx::EAV::Entity;

use Moo;
use strictures 2;
use Scalar::Util qw/ blessed /;
use Data::Dumper;
use Carp 'croak';

has 'eav', is => 'ro', required => 1;
has 'type', is => 'ro', required => 1, handles => [qw/ is_type /];
has 'raw', is => 'ro', default => sub { {} };
has '_modified', is => 'ro', default => sub { {} };
has '_modified_related', is => 'ro', default => sub { {} };



sub in_storage {
    my $self = shift;
    exists $self->raw->{id} && defined $self->raw->{id};
}

sub id {
    my $self = shift;
    return unless exists $self->raw->{id};
    $self->raw->{id};
}



sub get {
    my $self = shift;
    my $name = shift;
    my $type = $self->type;

    return $self->raw->{$name}
        if $type->has_attribute($name);

    if ($type->has_relationship($name)) {
        my $rel = $type->relationship($name);
        my $rs = $self->_get_related($name, @_);
        # return an Entity for has_one and belongs_to; return Cursor otherwise
        return $rs->next if
            $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});

        # *_many rel, return cursor or array of entities
        return wantarray ? $rs->all : $rs;
    }

    die sprintf "get() error: '%s' is not a valid attribute/relationship for '%s'", $name, $self->type->name;
}

sub _get_related {
    my ($self, $relname, $query, $options) = @_;
    $query //= {};
    my $rel = $self->type->relationship($relname);
    $query->{$rel->{incoming_name}} = $self;
    $self->eav->resultset($rel->{entity})->search($query, $options);
}


sub load_attributes {
    my ($self, @attrs) = @_;

    die "Can't load_attributes(): this entity has no id!"
        unless defined $self->id;

    my $eav = $self->eav;
    my $type = $self->type;

    @attrs = $type->attributes( no_static => 1, names => 1 )
        if @attrs == 0;

    # build sql query: one aliases subselect for each attribute
    my $sql_query = 'SELECT ' . join(', ', map {

        my $attr_spec = $type->attribute($_);
        my $value_table = $eav->table('value_'. $attr_spec->{data_type} );
        sprintf "(SELECT value FROM %s WHERE entity_id = %d AND attribute_id = %d) AS %s",
            $value_table->name,
            $self->id,
            $attr_spec->{id},
            $_;

    } @attrs);

    # fetch data
    my ($rv, $sth) = $eav->dbh_do($sql_query);
    my $data = $sth->fetchrow_hashref;

    die "load_attributes() failed! No data returned from database!"
        unless ref $data eq 'HASH';

    my $raw = $self->raw;
    my $total = 0;

    # adopt data
    for (keys %$data) {
        $raw->{$_} = $data->{$_};
        $total++;
    }

    # return the number os attrs loaded
    $total;
}

sub update {
    my $self = shift;
    $self->set(@_)->save;
}

sub set {
    my $self = shift;
    my $numargs = scalar(@_);

    die 'Call set(\%data) or set($attr, $value)'
        if 1 > $numargs || $numargs > 2;

    if ($numargs == 2) {
        $self->_set(@_);
    }
    elsif ($numargs == 1) {
        die "You must pass a hashref set()" unless ref $_[0] eq 'HASH';
        while (my ($k, $v) = each %{$_[0]}) {
            $self->_set($k, $v);
        }
    }

    $self;
}

sub _set {
    my ($self, $attr_name, $value) = @_;
    my $type = $self->type;

    if ($type->has_relationship($attr_name)) {
        return $self->_set_related($attr_name, $value);
    }

    my $attr = $self->type->attribute($attr_name);

    die "Sorry, you can't set the 'id' attribute."
        if $attr_name eq 'id';

    # same value
    return if defined $value &&
              exists $self->raw->{$attr_name} &&
              defined $self->raw->{$attr_name} &&
              $value eq $self->raw->{$attr_name};

    # remember original value
    $self->_modified->{$attr_name} = $self->raw->{$attr_name}
        unless exists $self->_modified->{$attr_name};


    # set
    # TODO use type-specific deflator
    $self->raw->{$attr_name} = $value;
}

sub _set_related {
    my ($self, $relname, $data) = @_;
    my $type = $self->type;
    my $rel = $type->relationship($relname);

    die "You can only pass related data in the form of a hashref, blessed Entity object, or an arrayref of it."
        unless ref $data eq 'HASH' || ref $data eq 'ARRAY' || (blessed $data && $data->isa('DBIx::EAV::Entity'));

    die "You can't pass an arrayref for the '$rel->{name}' relationship."
        if ref $data eq 'ARRAY' && ( $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity}) );

    $self->raw->{$relname} = $data;
    $self->_modified_related->{$relname} = 1;
}


sub save {
    my $self = shift;
    my $type = $self->type;
    my $entities_table = $self->eav->table('entities');
    my $is_new_entity = not $self->in_storage;
    my $raw = $self->raw;

    # modified static attrs
    my %modified_static_attributes = map { $_ => $self->raw->{$_} }
                                     grep { $type->has_static_attribute($_) }
                                     keys %{$self->_modified};

    # insert if its new entity
    if ($is_new_entity) {

        # TODO insert default values

        my $id = $entities_table->insert({
            %modified_static_attributes,
            entity_type_id => $type->id,
        });

        die "Invalid ID returned ($id) while inserting new entity."
            unless $id > 0;

        my $static_attributes = $entities_table->select_one({ id => $id });

        die "Error: could not fetch the entity row I've just inserted!"
            unless $static_attributes->{id} == $id;

        $raw->{$_} = $static_attributes->{$_}
            for keys %$static_attributes;

        # undirty those attrs
        delete $self->_modified->{$_} for keys %modified_static_attributes;
        %modified_static_attributes = ();
    }

    # upsert attributes
    my $modified_count = 0;

    while (my ($attr_name, $old_value) = each %{$self->_modified}) {

        $modified_count++;
        my $value = $raw->{$attr_name};
        my $attr_spec = $self->type->attribute($attr_name);

        # save static attrs later
        if ($attr_spec->{is_static}) {
            $modified_static_attributes{$attr_name} = $value;
            next;
        }

        my $values_table = $self->eav->table('value_'.$attr_spec->{data_type});

        my %attr_criteria = (
            entity_id    => $self->id,
            attribute_id => $attr_spec->{id}
        );

        # undefined value, delete attribute row
        if (not defined $value) {
            $values_table->delete(\%attr_criteria);
        }

        # update or insert value
        elsif (defined $old_value) {
            $values_table->update({ value => $value }, \%attr_criteria);
        }
        else {
            $values_table->insert({
                %attr_criteria,
                value => $value
            });
        }
    }

    # upset related
    foreach my $relname (keys %{$self->_modified_related}) {
        $self->_save_related($relname, $self->raw->{$relname});
    }


    # update static attributes
    if ($modified_count > 0) {

        $entities_table->update(\%modified_static_attributes, { id => $self->id })
            if keys(%modified_static_attributes) > 0;
    }

    # undirty
    %{$self->_modified} = ();

    $self;
}

sub _save_related {
    my ($self, $relname, $data, $options) = @_;
    $options //= {};

    my $rel = $self->type->relationship($relname);
    my $related_type = $self->eav->type($rel->{entity});
    my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;

    # delete any old links
    my $relationship_table = $self->eav->table('entity_relationships');
    $relationship_table->delete({
        relationship_id => $rel->{id},
        $our_side."_entity_id" => $self->id
    }) unless $options->{keep_current_links};

    # link new objects
    foreach my $entity (ref $data eq 'ARRAY' ? @$data : ($data)) {

        # if is a blessed object, check its a entity from the correct type
        if (blessed $entity) {

            die "Can't save data for relationship '$relname': unknown data type: ". ref $entity
                unless $entity->isa('DBIx::EAV::Entity');

            die sprintf("relationship '%s' requires '%s' objects, not '%s'", $relname, $related_type->name, $entity->type->name)
                unless $entity->type->id == $related_type->id;

            die "Can't save data for relationship '$relname': related entity is not in_storage."
                unless $entity->in_storage;

            # remove any links to it
            $relationship_table->delete({
                relationship_id => $rel->{id},
                $their_side."_entity_id" => $entity->id

            }) unless $rel->{is_many_to_many};

        }
        elsif (ref $entity eq 'HASH') {

            # insert new entity
            $entity = $self->eav->resultset($related_type->name)->insert($entity);
        }
        else {
            die "Can't save data for relationship '$relname': unknown data type: ". ref $entity;
        }

        # create link
        $relationship_table->insert({
            relationship_id => $rel->{id},
            $our_side."_entity_id"  => $self->id,
            $their_side."_entity_id" => $entity->id
        }) or die "Error creating link for relationship '$relname'";
    }
}

sub add_related {
    my ($self, $relname, $data) = @_;
    my $rel = $self->type->relationship($relname);
    die "Can't call add_related() for relationship '$rel->{name}'"
        if $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});

    $self->_save_related($relname, $data, { keep_current_links => 1 });
}


sub remove_related {
    my ($self, $relname, $data) = @_;
    my $rel = $self->type->relationship($relname);

    die "Can't call add_related() for relationship '$rel->{name}'"
        if $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});

    my $relationships_table = $self->eav->table('entity_relationships');
    my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;

    $data = [$data] unless ref $data eq 'ARRAY';

    foreach my $entity (@$data) {

        die "remove_related() error: give me an instance of '$rel->{entity}' or an arrayref of it."
            unless blessed $entity && $entity->isa('DBIx::EAV::Entity') && $entity->type->name eq $rel->{entity};

        $relationships_table->delete({
            relationship_id          => $rel->{id},
            $our_side  ."_entity_id" => $self->id,
            $their_side."_entity_id" => $entity->id
        });
    }
}


sub discard_changes {
    my $self = shift;

    while (my ($k, $v) = each %{$self->_modified}) {
        $self->raw->{$k} = $v;
        delete $self->raw->{$k};
    }

    $self;
}


sub delete {
    my $self = shift;
    die "Can't delete coz I'm not in storage!"
        unless $self->in_storage;

    my $eav  = $self->eav;
    my $type = $self->type;

    # cascade delete child entities
    foreach my $rel ($type->relationships) {

        next if $rel->{is_right_entity}
                || $rel->{is_many_to_many}
                || (exists $rel->{cascade_delete} && $rel->{cascade_delete} == 0);

        my $rs = $self->_get_related($rel->{name});
        while (my $related_entity = $rs->next) {
            $related_entity->delete;
        }
    }

    unless ($eav->schema->database_cascade_delete) {

        # delete relationship links
        $eav->table('entity_relationships')->delete([
            { left_entity_id  => $self->id },
            { right_entity_id => $self->id }
        ]);

        # delete attributes
        my %data_types = map { $_->{data_type} => 1 }
        $type->attributes( no_static => 1 );

        foreach my $data_type (keys %data_types) {
            $eav->table('value_'.$data_type)->delete({ entity_id => $self->id });
        }
    }

    # delete entity
    my $entities_table = $self->eav->table('entities');
    my $rv = $entities_table->delete({ id => $self->id });
    delete $self->raw->{id}; # not in_storage
    $rv;
}


##               ##
## Class Methods ##
##               ##

sub is_custom_class {
    my $class = shift;
    croak "is_custom_class() is a Class method." if ref $class;
    $class ne __PACKAGE__;
}

sub type_definition {
    my $class = shift;

    croak "type_definition() is a Class method." if ref $class;
    croak "type_definition() must be called on DBIx::EAV::Entity subclasses."
        unless $class->is_custom_class;

    no strict 'refs';
    unless (defined *{"${class}::__TYPE_DEFINITION__"}) {

        my %definition;
        # detect parent entity
        my $parent_class = ${"${class}::ISA"}[0];
        ($definition{extends}) = $parent_class =~ /::(\w+)$/
            if $parent_class ne __PACKAGE__;

        *{"${class}::__TYPE_DEFINITION__"} = \%definition;
    }


    \%{"${class}::__TYPE_DEFINITION__"};
}

# install class methods for type definition
foreach my $stuff (qw/ attribute has_many has_one many_to_many /) {
    no strict 'refs';
    *{$stuff} = sub {
        my ($class, $spec) = @_;

        croak "$stuff() is a Class method." if ref $class;
        croak "$stuff() must be called on DBIx::EAV::Entity subclasses."
            unless $class->is_custom_class;

        my $key = $stuff eq 'attribute' ? 'attributes' : $stuff;
        push @{ $class->type_definition->{$key} }, $spec;
    };
}



1;


__END__