1package Class::DBI::Relationship::HasA;
2
3use strict;
4use warnings;
5
6use base 'Class::DBI::Relationship';
7
8sub remap_arguments {
9	my ($proto, $class, $want_col, $a_class, %meths) = @_;
10	$class->_invalid_object_method("has_a") if ref $class;
11	my $column = $class->find_column($want_col)
12		or return $class->_croak("Column $want_col does not exist in $class");
13	$class->_croak("$class $column needs an associated class") unless $a_class;
14	return ($class, $column, $a_class, \%meths);
15}
16
17sub triggers {
18	my $self = shift;
19	$self->class->_require_class($self->foreign_class);
20	my $column = $self->accessor;
21	return (
22		select => $self->_inflator,
23
24		# after_create        => $self->_inflator, # see t/6
25		"after_set_$column" => $self->_inflator,
26		deflate_for_create  => $self->_deflator(1),
27		deflate_for_update  => $self->_deflator,
28	);
29}
30
31sub _inflator {
32	my $rel = shift;
33	my $col = $rel->accessor;
34	return sub {
35		my $self = shift;
36		defined(my $value = $self->_attrs($col)) or return;
37		my $meta = $self->meta_info($rel->name => $col);
38		my ($a_class, %meths) = ($meta->foreign_class, %{ $meta->args });
39
40		return if ref $value and $value->isa($a_class);
41		my $inflator;
42
43		my $get_new_value = sub {
44			my ($inflator, $value, $want_class, $obj) = @_;
45			my $new_value =
46				(ref $inflator eq 'CODE')
47				? $inflator->($value, $obj)
48				: $want_class->$inflator($value);
49			return $new_value;
50		};
51
52		# If we have a custom inflate ...
53		if (exists $meths{'inflate'}) {
54			$value = $get_new_value->($meths{'inflate'}, $value, $a_class, $self);
55			return $self->_attribute_store($col, $value)
56				if ref $value
57				and $value->isa($a_class);
58			$self->_croak("Inflate method didn't inflate right") if ref $value;
59		}
60
61		return $self->_croak("Can't inflate $col to $a_class using '$value': "
62				. ref($value)
63				. " is not a $a_class")
64			if ref $value;
65
66		$inflator = $a_class->isa('Class::DBI') ? "_simple_bless" : "new";
67		$value = $get_new_value->($inflator, $value, $a_class);
68
69		return $self->_attribute_store($col, $value)
70			if ref $value
71			and $value->isa($a_class);
72
73		# use ref as $obj may be overloaded and appear 'false'
74		return $self->_croak(
75			"Can't inflate $col to $a_class " . "via $inflator using '$value'")
76			unless ref $value;
77	};
78}
79
80sub _deflator {
81	my ($self, $always) = @_;
82	my $col = $self->accessor;
83	return sub {
84		my $self = shift;
85		return unless $self->_attribute_exists($col);
86		$self->_attribute_store($col => $self->_deflated_column($col))
87			if ($always or $self->{__Changed}->{$col});
88	};
89}
90
91sub _set_up_class_data {
92	my $self = shift;
93	$self->class->_extend_class_data(__hasa_rels => $self->accessor =>
94			[ $self->foreign_class, %{ $self->args } ]);
95	$self->SUPER::_set_up_class_data;
96}
97
981;
99