1package # hide from PAUSE 2 DBIx::Class::Relationship::HasOne; 3 4use strict; 5use warnings; 6use Carp::Clan qw/^DBIx::Class/; 7 8our %_pod_inherit_config = 9 ( 10 class_map => { 'DBIx::Class::Relationship::HasOne' => 'DBIx::Class::Relationship' } 11 ); 12 13sub might_have { 14 shift->_has_one('LEFT' => @_); 15} 16 17sub has_one { 18 shift->_has_one(undef() => @_); 19} 20 21sub _has_one { 22 my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_; 23 unless (ref $cond) { 24 $class->ensure_class_loaded($f_class); 25 26 my $pri = $class->_get_primary_key; 27 28 $class->throw_exception( 29 "might_have/has_one needs a primary key to infer a join; ". 30 "${class} has none" 31 ) if !defined $pri && (!defined $cond || !length $cond); 32 33 my $f_class_loaded = eval { $f_class->columns }; 34 my ($f_key,$too_many,$guess); 35 if (defined $cond && length $cond) { 36 $f_key = $cond; 37 $guess = "caller specified foreign key '$f_key'"; 38 } elsif ($f_class_loaded && $f_class->has_column($rel)) { 39 $f_key = $rel; 40 $guess = "using given relationship '$rel' for foreign key"; 41 } else { 42 $f_key = $class->_get_primary_key($f_class); 43 $guess = "using primary key of foreign class for foreign key"; 44 } 45 $class->throw_exception( 46 "No such column ${f_key} on foreign class ${f_class} ($guess)" 47 ) if $f_class_loaded && !$f_class->has_column($f_key); 48 $cond = { "foreign.${f_key}" => "self.${pri}" }; 49 } 50 $class->_validate_cond($cond); 51 $class->add_relationship($rel, $f_class, 52 $cond, 53 { accessor => 'single', 54 cascade_update => 1, cascade_delete => 1, 55 ($join_type ? ('join_type' => $join_type) : ()), 56 %{$attrs || {}} }); 57 1; 58} 59 60sub _get_primary_key { 61 my ( $class, $target_class ) = @_; 62 $target_class ||= $class; 63 my ($pri, $too_many) = eval { $target_class->_pri_cols }; 64 $class->throw_exception( 65 "Can't infer join condition on ${target_class}: $@" 66 ) if $@; 67 68 $class->throw_exception( 69 "might_have/has_one can only infer join for a single primary key; ". 70 "${class} has more" 71 ) if $too_many; 72 return $pri; 73} 74 75sub _validate_cond { 76 my ($class, $cond ) = @_; 77 78 return if $ENV{DBIC_DONT_VALIDATE_RELS}; 79 return unless 'HASH' eq ref $cond; 80 foreach my $foreign_id ( keys %$cond ) { 81 my $self_id = $cond->{$foreign_id}; 82 83 # we can ignore a bad $self_id because add_relationship handles this 84 # warning 85 return unless $self_id =~ /^self\.(.*)$/; 86 my $key = $1; 87 my $column_info = $class->column_info($key); 88 if ( $column_info->{is_nullable} ) { 89 carp(qq'"might_have/has_one" must not be on columns with is_nullable set to true ($class/$key). This might indicate an incorrect use of those relationship helpers instead of belongs_to.'); 90 } 91 } 92} 93 941; 95