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