view release on metacpan or  search on metacpan

lib/DBIx/EAV/Entity.pm  view on Meta::CPAN

    }
}

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 /;
    my $related_type = $self->eav->type_by_id($rel->{"${their_side}_entity_type_id"});

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

    foreach my $entity (@$data) {

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

        $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';

lib/DBIx/EAV/Entity.pm  view on Meta::CPAN

=back

Available only for has_many and many_to_many relationships, this method binds
entities via the C<$rel_name> relationship. C<$related_data> must be a
L<entity|DBIx::EAV::Entity> instance (of the proper type for the relationship)
or a hashref of data to be inserted (again, suitable for the related type), or a
arrayref of those. Passing L<Entity|DBIx::EAV::Entity> objects which are not
L</in_storage> results in a fatal error.

    # add tracks to a cd
    $cd->add_related('tracks', [
        { title => 'Track1', duration => ... },
        { title => 'Track2', duration => ... },
        { title => 'Track3', duration => ... },
    ]);

    # also accepts existing entities
    my @tracks = $eav->resultset('Track')->populate( ... );
    $cd->add_related('tracks', \@tracks);


=head2 remove_related

=over 4

=item Arguments: L<$rel_name|DBIx::EAV::EntityType/relationship>, L<$related_entities|DBIx::EAV::Entity>

=back

Unbinds C<$related_entities> from the relationship C<$rel_name>. Note that it
doesn't delete the related entities.

    my @tags = $eav->resultset('Tag')->find( name => [qw/ Foo Bar Baz /]);
    $article->remove_related('tags', \@tags);

=head2 discard_changes

Reverts all modified attributes to the its original value. Note that the internal
memory of modified attributes is reset after a call to L</save>.

=head2 delete

=over

=item Arguments: none

=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>

=back

Throws an exception if the object is not in the database according to
L</in_storage>.

The object is still perfectly usable, but L</in_storage> will
now return 0 and the object will be reinserted (same attrs, new id) if you
call L</save>.

If you delete an object in a class with a C<has_many> or C<has_one>
relationship, an attempt is made to delete all the related objects as well.
To turn this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::EAV/Relationships>.

Since a entity is represented by data not only in the entities table, but also
in value tables and relationship links table, those related rows must be deleted
before the main row.

First a C<DELETE> is executed for the relationship links table where this entity
is the right-side entity, unbinding from "parent" relationships. Then a
C<DELETE> query is executed for each value table, unless this entity has no
attributes of that data type.

Those extra C<DELETE> operations are unneccessary if you are using database-level
C<ON DELETE CASCADE>. See L<DBIx::EAV/DATABASE-LEVEL CASCADE DELETE>.

See also L<DBIx::EAV::ResulutSet/delete>.

=head1 LICENSE

Copyright (C) Carlos Fernando Avila Gratz.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>

=cut