Persistence::Relationship - Object relationship mapping

 Persistence::Fetchable
    |
    +----Persistence::Relationship

package Persistence::Relationship;

use strict;
use warnings;

use vars qw($VERSION);
use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION);

use Abstract::Meta::Class ':all';
use Persistence::Fetchable ':all';
use base qw(Exporter Persistence::Fetchable);
use Carp 'confess';

use constant NONE      => 0;
use constant ALL       => 1;
use constant ON_INSERT => 2;
use constant ON_UPDATE => 3;
use constant ON_DELETE => 4;


$VERSION = 0.03;

@EXPORT_OK = qw(LAZY EAGER NONE ALL ON_INSERT ON_UPDATE ON_DELETE);
%EXPORT_TAGS = (all => \@EXPORT_OK);

has '$.name' => (required => 1);

has '$.attribute' => (required => 1);

has '$.attribute_name';

has '$.fetch_method' => (default => LAZY);

has '$.cascade' => (default => NONE);

has '$.orm' => (associated_class => 'Persistence::ORM', the_other_end => 'lobs');

sub add_relationship {
    my ($class, $package, $name, %args) = (@_);
    my $orm  = Persistence::ORM::mapping_meta($package);
    my $attribute_class = $orm->mop_attribute_adapter;
    my $attribute = $args{attribute};
    $attribute = $args{attribute} =  $attribute_class->new(attribute => $attribute, column_name => $name)
        unless $attribute->isa('Persistence::Attribute');
    my $relation = $class->new(%args, name => $name);
    $relation->set_attribute_name($attribute->name);
    $attribute->associated_class
        or confess "associated class must be defined for attribute: " . $attribute->name;
    $orm->add_relationships($relation);
    $relation->install_fetch_interceptor($attribute)
        if ($relation->fetch_method eq LAZY);
    $relation;
}

sub relationships {
    my ($class, $package) = @_;
    my $orm  = Persistence::ORM::mapping_meta($package);
    my $relationships = $orm->relationships;
    $relationships;
}

sub insertable_to_many_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next if ref($relation) eq 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_INSERT);
        push @result, $relation;
    }
    @result;
}

sub insertable_to_one_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next unless ref($relation) eq 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_INSERT);
        push @result, $relation;
    }
    @result;
}

sub updatable_to_many_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next if ref($relation) eq 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_UPDATE);
        push @result, $relation;
    }
    @result;
}

sub updatable_to_one_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next if ref($relation) ne 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_UPDATE);
        push @result, $relation;
    }
    @result;
}

sub deleteable_to_many_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next if ref($relation) eq 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_DELETE);
        push @result, $relation;
    }
    @result;
}

sub deleteable_to_one_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    my @result;
    foreach my $attribute_name (keys %$relations) {
        my $relation = $relations->{$attribute_name};
        next if ref($relation) ne 'Persistence::Relationship::ToOne';
        my $cascade = $relation->cascade;
        next if($cascade ne ALL && $cascade ne ON_DELETE);
        push @result, $relation;
    }
    @result;
}

sub eager_fetch_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    $class->eager_fetch_filter($relations);
}

sub lazy_fetch_relations {
    my ($class, $obj_class) = @_;
    my $relations = $class->relationships($obj_class) or return;
    $class->lazy_fetch_filter($relations);
}

sub install_fetch_interceptor {
    my ($self) = @_;
    my $attribute = $self->attribute;
    $attribute->install_fetch_interceptor($self->lazy_fetch_handler($self->attribute));
}

sub values {
    my ($self, $object) = @_;
    my $values = $self->value($object);
    ref($values) eq 'HASH' ? [values %$values] : $values;
}

sub value {
    my ($self, $object) = @_;
    my $attribute = $self->attribute;
    my $accessor = $attribute->accessor;
    $object->$accessor;
}



1;

__END__

1;