1package Class::DBI::Relationship::MightHave;
2
3use strict;
4use warnings;
5
6use base 'Class::DBI::Relationship';
7
8sub remap_arguments {
9	my ($proto, $class, $method, $f_class, @methods) = @_;
10	$class->_require_class($f_class);
11	return ($class, $method, $f_class, { import => \@methods });
12}
13
14sub triggers {
15	my $self = shift;
16
17	my $method = $self->accessor;
18
19	return (
20		before_update => sub {
21			if (my $for_obj = shift->$method()) { $for_obj->update }
22		},
23
24		before_delete => sub {
25			if (my $for_obj = shift->$method()) { $for_obj->delete }
26		},
27	);
28}
29
30sub methods {
31	my $self = shift;
32	my ($class, $method) = ($self->class, $self->accessor);
33	return (
34		$method => $self->_object_accessor,
35		map { $_ => $self->_imported_accessor($_) } @{ $self->args->{import} }
36	);
37}
38
39sub _object_accessor {
40	my $rel = shift;
41	my ($class, $method) = ($rel->class, $rel->accessor);
42	return sub {
43		my $self = shift;
44		my $meta = $class->meta_info($rel->name => $method);
45		my ($f_class, @extra) =
46			($meta->foreign_class, @{ $meta->args->{import} });
47		return
48			if defined($self->{"_${method}_object"})
49			&& $self->{"_${method}_object"}
50			->isa('Class::DBI::Object::Has::Been::Deleted');
51		$self->{"_${method}_object"} ||= $f_class->retrieve($self->id);
52	};
53}
54
55sub _imported_accessor {
56	my ($rel, $name) = @_;
57	my ($class, $method) = ($rel->class, $rel->accessor);
58	return sub {
59		my $self = shift;
60		my $meta = $class->meta_info($rel->name => $method);
61		my ($f_class, @extra) =
62			($meta->foreign_class, @{ $meta->args->{import} });
63		my $for_obj = $self->$method() || do {
64			return unless @_;    # just fetching
65			my $val = shift;
66			$f_class->insert(
67				{ $f_class->primary_column => $self->id, $name => $val });
68			$self->$method();
69		};
70		$for_obj->$name(@_);
71	};
72}
73
741;
75