All expected evals converted to try, except where no test is done,
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / BelongsTo.pm
1 package # hide from PAUSE
2     DBIx::Class::Relationship::BelongsTo;
3
4 # Documentation for these methods can be found in
5 # DBIx::Class::Relationship
6
7 use strict;
8 use warnings;
9 use Try::Tiny;
10
11 our %_pod_inherit_config = 
12   (
13    class_map => { 'DBIx::Class::Relationship::BelongsTo' => 'DBIx::Class::Relationship' }
14   );
15
16 sub belongs_to {
17   my ($class, $rel, $f_class, $cond, $attrs) = @_;
18
19   # assume a foreign key contraint unless defined otherwise
20   $attrs->{is_foreign_key_constraint} = 1 
21     if not exists $attrs->{is_foreign_key_constraint};
22   $attrs->{undef_on_null_fk} = 1
23     if not exists $attrs->{undef_on_null_fk};
24
25   # no join condition or just a column name
26   if (!ref $cond) {
27     $class->ensure_class_loaded($f_class);
28     my %f_primaries = map { $_ => 1 } try { $f_class->_pri_cols }
29       catch {
30         $class->throw_exception( "Can't infer join condition for ${rel} on ${class}: $_");
31       };
32
33     my ($pri, $too_many) = keys %f_primaries;
34     $class->throw_exception(
35       "Can't infer join condition for ${rel} on ${class}; ".
36       "${f_class} has multiple primary keys"
37     ) if $too_many;
38
39     my $fk = defined $cond ? $cond : $rel;
40     $class->throw_exception(
41       "Can't infer join condition for ${rel} on ${class}; ".
42       "$fk is not a column of $class"
43     ) unless $class->has_column($fk);
44
45     my $acc_type = $class->has_column($rel) ? 'filter' : 'single';
46     $class->add_relationship($rel, $f_class,
47       { "foreign.${pri}" => "self.${fk}" },
48       { accessor => $acc_type, %{$attrs || {}} }
49     );
50   }
51   # explicit join condition
52   elsif (ref $cond) {
53     if (ref $cond eq 'HASH') { # ARRAY is also valid
54       my $cond_rel;
55       for (keys %$cond) {
56         if (m/\./) { # Explicit join condition
57           $cond_rel = $cond;
58           last;
59         }
60         $cond_rel->{"foreign.$_"} = "self.".$cond->{$_};
61       }
62       $cond = $cond_rel;
63     }
64     my $acc_type = ((ref $cond eq 'HASH')
65                        && keys %$cond == 1
66                        && $class->has_column($rel))
67                      ? 'filter'
68                      : 'single';
69     $class->add_relationship($rel, $f_class,
70       $cond,
71       { accessor => $acc_type, %{$attrs || {}} }
72     );
73   }
74   else {
75     $class->throw_exception(
76       'third argument for belongs_to must be undef, a column name, '.
77       'or a join condition'
78     );
79   }
80   return 1;
81 }
82
83 # Attempt to remove the POD so it (maybe) falls off the indexer
84
85 #=head1 AUTHORS
86 #
87 #Alexander Hartmaier <Alexander.Hartmaier@t-systems.at>
88 #
89 #Matt S. Trout <mst@shadowcatsystems.co.uk>
90 #
91 #=cut
92
93 1;