X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FBelongsTo.pm;h=0a0f0dbd2206e297f0364eff6674646ded156f66;hb=7293955e14a24ad5abecc41e0ec485ccdfb3d2f0;hp=b871266500d85be05a6afdf18a8991d1d47ce66c;hpb=fd4df97578076cdb1a82385b21995ed28637e096;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm index b871266..0a0f0db 100644 --- a/lib/DBIx/Class/Relationship/BelongsTo.pm +++ b/lib/DBIx/Class/Relationship/BelongsTo.pm @@ -6,73 +6,99 @@ package # hide from PAUSE use strict; use warnings; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); +use namespace::clean; + +our %_pod_inherit_config = + ( + class_map => { 'DBIx::Class::Relationship::BelongsTo' => 'DBIx::Class::Relationship' } + ); sub belongs_to { my ($class, $rel, $f_class, $cond, $attrs) = @_; + + # assume a foreign key constraint unless defined otherwise + $attrs->{is_foreign_key_constraint} = 1 + if not exists $attrs->{is_foreign_key_constraint}; + $attrs->{undef_on_null_fk} = 1 + if not exists $attrs->{undef_on_null_fk}; + # no join condition or just a column name if (!ref $cond) { - $class->ensure_class_loaded($f_class); - my %f_primaries = map { $_ => 1 } eval { $f_class->primary_columns }; - $class->throw_exception( - "Can't infer join condition for ${rel} on ${class}; ". - "unable to load ${f_class}: $@" - ) if $@; - my ($pri, $too_many) = keys %f_primaries; - $class->throw_exception( - "Can't infer join condition for ${rel} on ${class}; ". - "${f_class} has no primary keys" - ) unless defined $pri; - $class->throw_exception( - "Can't infer join condition for ${rel} on ${class}; ". - "${f_class} has multiple primary keys" - ) if $too_many; + my ($f_key, $guess); + if (defined $cond and length $cond) { + $f_key = $cond; + $guess = "caller specified foreign key '$f_key'"; + } + else { + $f_key = $rel; + $guess = "using given relationship name '$rel' as foreign key column name"; + } - my $fk = defined $cond ? $cond : $rel; $class->throw_exception( - "Can't infer join condition for ${rel} on ${class}; ". - "$fk is not a column of $class" - ) unless $class->has_column($fk); - - my $acc_type = $class->has_column($rel) ? 'filter' : 'single'; - $class->add_relationship($rel, $f_class, - { "foreign.${pri}" => "self.${fk}" }, - { accessor => $acc_type, %{$attrs || {}} } - ); + "No such column '$f_key' declared yet on ${class} ($guess)" + ) unless $class->result_source->has_column($f_key); + + $class->ensure_class_loaded($f_class); + my $f_rsrc = dbic_internal_try { + $f_class->result_source; + } + dbic_internal_catch { + $class->throw_exception( + "Foreign class '$f_class' does not seem to be a Result class " + . "(or it simply did not load entirely due to a circular relation chain): $_" + ); + }; + + my $pri = $f_rsrc->_single_pri_col_or_die; + + $cond = { "foreign.${pri}" => "self.${f_key}" }; + } # explicit join condition - elsif (ref $cond eq 'HASH') { - my $cond_rel; - for (keys %$cond) { - if (m/\./) { # Explicit join condition - $cond_rel = $cond; - last; + else { + if (ref $cond eq 'HASH') { # ARRAY is also valid + my $cond_rel; + # FIXME This loop is ridiculously incomplete and dangerous + # staving off changes until implmentation of the swindon consensus + for (keys %$cond) { + if (m/\./) { # Explicit join condition + $cond_rel = $cond; + last; + } + $cond_rel->{"foreign.$_"} = "self.".$cond->{$_}; } - $cond_rel->{"foreign.$_"} = "self.".$cond->{$_}; + $cond = $cond_rel; } - my $acc_type = (keys %$cond_rel == 1 and $class->has_column($rel)) - ? 'filter' - : 'single'; - $class->add_relationship($rel, $f_class, - $cond_rel, - { accessor => $acc_type, %{$attrs || {}} } - ); - } - else { - $class->throw_exception( - 'third argument for belongs_to must be undef, a column name, '. - 'or a join condition' - ); } - return 1; -} -=head1 AUTHORS + my $acc_type = ( + ref $cond eq 'HASH' + and + keys %$cond == 1 + and + (keys %$cond)[0] =~ /^foreign\./ + and + $class->result_source->has_column($rel) + ) ? 'filter' : 'single'; -Alexander Hartmaier + my $fk_columns = ($acc_type eq 'single' and ref $cond eq 'HASH') + ? { map { $_ =~ /^self\.(.+)/ ? ( $1 => 1 ) : () } (values %$cond ) } + : undef + ; -Matt S. Trout + $class->add_relationship($rel, $f_class, + $cond, + { + is_depends_on => 1, + accessor => $acc_type, + $fk_columns ? ( fk_columns => $fk_columns ) : (), + %{$attrs || {}} + } + ); -=cut + return 1; +} 1;