package Local::Class::DBI::Relationship::HasAMk;

use strict;
use warnings;

use base 'Local::Class::DBI::Relationship';

sub remap_arguments {
	my ($proto, $class, $method, $key, $f_class) = @_;
	$class->_require_class($f_class);

	my $args = { };
	$args->{'key'} = $key;

	return ($class, $method, $f_class, $args);
}

sub methods {
	my $self = shift;
	my ($class, $method) = ($self->class, $self->accessor);
	return (
		$method => $self->_object_accessor,
	);
}

sub _object_accessor {
	my $rel = shift;
	my ($class, $method) = ($rel->class, $rel->accessor);
	return sub {
		my $self = shift;
		my $meta = $class->meta_info($rel->name => $method);
		my $f_class = $meta->foreign_class;
		my $key = $meta->args->{'key'};
		my $f_key = $meta->args->{'f_key'};
		return
			if defined($self->{"_${method}_object"})
			&& $self->{"_${method}_object"}
			->isa('Local::Class::DBI::Object::Has::Been::Deleted');

		my %key;
		@key{$f_class->primary_columns} = map { $self->$_ } @{$key};

		($self->{"_${method}_object"}) = $f_class->search(%key) unless (defined $self->{"_${method}_object"});

		return $self->{"_${method}_object"};
	};
}

1;
