X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FHasOne.pm;h=00bffdb85a54e00c8601998a74374e9e41ddc147;hb=70c288086248e5a4008490df22a56632341f2473;hp=4efbec012449cad72500055b94cd0e9ffc14baef;hpb=c0e7b4e55952cd193b6f1866d0c27ece182397eb;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm index 4efbec0..00bffdb 100644 --- a/lib/DBIx/Class/Relationship/HasOne.pm +++ b/lib/DBIx/Class/Relationship/HasOne.pm @@ -3,6 +3,14 @@ package # hide from PAUSE use strict; use warnings; +use DBIx::Class::Carp; +use Try::Tiny; +use namespace::clean; + +our %_pod_inherit_config = + ( + class_map => { 'DBIx::Class::Relationship::HasOne' => 'DBIx::Class::Relationship' } + ); sub might_have { shift->_has_one('LEFT' => @_); @@ -14,17 +22,18 @@ sub has_one { sub _has_one { my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_; - eval "require $f_class"; - if ($@) { - $class->throw_exception($@) unless $@ =~ /Can't locate/; - } - unless (ref $cond) { - my ($pri, $too_many) = $class->primary_columns; - $class->throw_exception( "might_have/has_one can only infer join for a single primary key; ${class} has more" ) - if $too_many; - my $f_class_loaded = eval { $f_class->columns }; - my ($f_key,$guess); + $class->ensure_class_loaded($f_class); + + my $pri = $class->_get_primary_key; + + $class->throw_exception( + "might_have/has_one needs a primary key to infer a join; ". + "${class} has none" + ) if !defined $pri && (!defined $cond || !length $cond); + + my $f_class_loaded = try { $f_class->columns }; + my ($f_key,$too_many,$guess); if (defined $cond && length $cond) { $f_key = $cond; $guess = "caller specified foreign key '$f_key'"; @@ -32,15 +41,15 @@ sub _has_one { $f_key = $rel; $guess = "using given relationship '$rel' for foreign key"; } else { - ($f_key, $too_many) = $f_class->primary_columns; - $class->throw_exception( "might_have/has_one can only infer join for a single primary key; ${f_class} has more" ) - if $too_many; + $f_key = $class->_get_primary_key($f_class); $guess = "using primary key of foreign class for foreign key"; } - $class->throw_exception("No such column ${f_key} on foreign class ${f_class} ($guess)") - if $f_class_loaded && !$f_class->has_column($f_key); + $class->throw_exception( + "No such column ${f_key} on foreign class ${f_class} ($guess)" + ) if $f_class_loaded && !$f_class->has_column($f_key); $cond = { "foreign.${f_key}" => "self.${pri}" }; } + $class->_validate_has_one_condition($cond); $class->add_relationship($rel, $f_class, $cond, { accessor => 'single', @@ -50,4 +59,40 @@ sub _has_one { 1; } +sub _get_primary_key { + my ( $class, $target_class ) = @_; + $target_class ||= $class; + my ($pri, $too_many) = try { $target_class->_pri_cols } + catch { + $class->throw_exception("Can't infer join condition on ${target_class}: $_"); + }; + + $class->throw_exception( + "might_have/has_one can only infer join for a single primary key; ". + "${class} has more" + ) if $too_many; + return $pri; +} + +sub _validate_has_one_condition { + my ($class, $cond ) = @_; + + return if $ENV{DBIC_DONT_VALIDATE_RELS}; + return unless 'HASH' eq ref $cond; + foreach my $foreign_id ( keys %$cond ) { + my $self_id = $cond->{$foreign_id}; + + # we can ignore a bad $self_id because add_relationship handles this + # warning + return unless $self_id =~ /^self\.(.*)$/; + my $key = $1; + $class->throw_exception("Defining rel on ${class} that includes ${key} but no such column defined here yet") + unless $class->has_column($key); + my $column_info = $class->column_info($key); + if ( $column_info->{is_nullable} ) { + 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.'); + } + } +} + 1;