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