lib/DBIx/Class/Relationship/HasOne.pm

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