File Coverage

blib/lib/Class/DBI/Relationship/HasA.pm

Criterion	Covered	Total	%
statement	28	51	54.9
branch	3	30	10.0
condition	0	12	0.0
subroutine	8	10	80.0
pod	2	2	100.0
total	41	105	39.0

package Class::DBI::Relationship::HasA;

use strict;
use warnings;

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

sub remap_arguments {
	my ($proto, $class, $want_col, $a_class, %meths) = @_;
	$class->_invalid_object_method("has_a") if ref $class;
	my $column = $class->find_column($want_col)
		or return $class->_croak("Column $want_col does not exist in $class");
	$class->_croak("$class $column needs an associated class") unless $a_class;
	return ($class, $column, $a_class, \%meths);
}

sub triggers {
	my $self = shift;
	$self->class->_require_class($self->foreign_class);
	my $column = $self->accessor;
	return (
		select => $self->_inflator,

		# after_create        => $self->_inflator, # see t/6
		"after_set_$column" => $self->_inflator,
		deflate_for_create  => $self->_deflator(1),
		deflate_for_update  => $self->_deflator,
	);
}

sub _inflator {
	my $rel = shift;
	my $col = $rel->accessor;
	return sub {
		my $self = shift;
		defined(my $value = $self->_attrs($col)) or return;
		my $meta = $self->meta_info($rel->name => $col);
		my ($a_class, %meths) = ($meta->foreign_class, %{ $meta->args });

		return if ref $value and $value->isa($a_class);
		my $inflator;

		my $get_new_value = sub {
			my ($inflator, $value, $want_class, $obj) = @_;
			my $new_value =
				(ref $inflator eq 'CODE')
				? $inflator->($value, $obj)
				: $want_class->$inflator($value);
			return $new_value;
		};

		# If we have a custom inflate ...
		if (exists $meths{'inflate'}) {
			$value = $get_new_value->($meths{'inflate'}, $value, $a_class, $self);
			return $self->_attribute_store($col, $value)
				if ref $value
				and $value->isa($a_class);
			$self->_croak("Inflate method didn't inflate right") if ref $value;
		}

		return $self->_croak("Can't inflate $col to $a_class using '$value': "
				. ref($value)
				. " is not a $a_class")
			if ref $value;

		$inflator = $a_class->isa('Class::DBI') ? "_simple_bless" : "new";
		$value = $get_new_value->($inflator, $value, $a_class);

		return $self->_attribute_store($col, $value)
			if ref $value
			and $value->isa($a_class);

		# use ref as $obj may be overloaded and appear 'false'
		return $self->_croak(
			"Can't inflate $col to $a_class " . "via $inflator using '$value'")
			unless ref $value;
	};
}

sub _deflator {
	my ($self, $always) = @_;
	my $col = $self->accessor;
	return sub {
		my $self = shift;
		return unless $self->_attribute_exists($col);
		$self->_attribute_store($col => $self->_deflated_column($col))
			if ($always or $self->{__Changed}->{$col});
	};
}

sub _set_up_class_data {
	my $self = shift;
	$self->class->_extend_class_data(__hasa_rels => $self->accessor =>
			[ $self->foreign_class, %{ $self->args } ]);
	$self->SUPER::_set_up_class_data;
}

1;