File Coverage

File:	blib/lib/Class/DBI/Relationship/HasA.pm
Coverage:	90.5%

line	stmt	branch	cond	sub	time	code
1						package Class::DBI::Relationship::HasA;
2
3	24 24 24			24	1108 163 594	use strict;
4	24 24 24			24	563 147 609	use warnings;
5
6	24 24 24			24	638 163 537	use base 'Class::DBI::Relationship';
7
8						sub remap_arguments {
9	24			24	219	my $proto = shift;
10	24				184	my $class = shift;
11	24	100			370	$class->_invalid_object_method('has_a()') if ref $class;
12	23	50			583	my $column = $class->find_column(+shift)
13						or return $class->_croak("has_a needs a valid column");
14	23	100			1289	my $a_class = shift
15						or $class->_croak("$class $column needs an associated class");
16	22				238	my %meths = @_;
17	22				461	return ($class, $column, $a_class, \%meths);
18						}
19
20						sub triggers {
21	22			22	158	my $self = shift;
22	22				292	$self->class->_require_class($self->foreign_class);
23	22				433	my $column = $self->accessor;
24						return (
25	22				1369	select => $self->_inflator,
26						"after_set_$column" => $self->_inflator,
27						deflate_for_create => $self->_deflator(1),
28						deflate_for_update => $self->_deflator,
29						);
30						}
31
32						sub _inflator {
33	44			44	1853	my $self = shift;
34	44				363	my $col = $self->accessor;
35						return sub {
36	206			206	28096	my $self = shift;
37	206	100			2818	defined(my $value = $self->_attrs($col)) or return;
38	106				8866	my $meta = $self->meta_info(has_a => $col);
39	106 106				7235 9370	my ($a_class, %meths) = ($meta->foreign_class, %{ $meta->args });
40
41	106	100	100		7996	return if ref $value and $value->isa($a_class);
42	87				438	my $inflator;
43
44						my $get_new_value = sub {
45	89				847	my ($inflator, $value, $want_class, $obj) = @_;
46	89	100			2331	my $new_value =
47						(ref $inflator eq 'CODE')
48						? $inflator->($value, $obj)
49						: $want_class->$inflator($value);
50	89				1787	return $new_value;
51	87				658	};
52
53						# If we have a custom inflate ...
54	87	100			1040	if (exists $meths{'inflate'}) {
55	12				145	$value = $get_new_value->($meths{'inflate'}, $value, $a_class, $self);
56	12	100	67		533	return $self->_attribute_store($col, $value)
57						if ref $value
58						and $value->isa($a_class);
59	3	50			56	$self->_croak("Inflate method didn't inflate right") if ref $value;
60						}
61
62	78	100			639	return $self->_croak("Can't inflate $col to $a_class using '$value': "
63						. ref($value)
64						. " is not a $a_class")
65						if ref $value;
66
67	77	50			3787	$inflator = $a_class->isa('Class::DBI') ? "_simple_bless" : "new";
68	77				685	$value = $get_new_value->($inflator, $value, $a_class);
69
70	77	50	33		3453	return $self->_attribute_store($col, $value)
71						if ref $value
72						and $value->isa($a_class);
73
74						# use ref as $obj may be overloaded and appear 'false'
75	0	0			0	return $self->_croak(
76						"Can't inflate $col to $a_class " . "via $inflator using '$value'")
77						unless ref $value;
78	44				2185	};
79						}
80
81						sub _deflator {
82	44			44	672	my ($self, $always) = @_;
83	44				398	my $col = $self->accessor;
84						return sub {
85	74			74	5795	my $self = shift;
86	74	100			1112	return unless $self->_attribute_exists($col);
87	73	100	100		4708	$self->_attribute_store($col => $self->_deflated_column($col))
88						if ($always or $self->{__Changed}->{$col});
89	44				3370	};
90						}
91
92						sub _set_up_class_data {
93	22			22	179	my $self = shift;
94	22				404	$self->class->_extend_class_data(__hasa_rels => $self->accessor =>
95	22				376	[ $self->foreign_class, %{ $self->args } ]);
96	22				1330	$self->SUPER::_set_up_class_data;
97						}
98
99						1;