Commit | Line | Data |
b8e1e21f |
1 | package DBIx::Class::CDBICompat::HasMany; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | sub has_many { |
7 | my ($class, $rel, $f_class, $f_key, $args) = @_; |
95a70f01 |
8 | |
9 | my $self_key; |
10 | |
11 | if (ref $f_class eq 'ARRAY') { |
12 | ($f_class, $self_key) = @$f_class; |
13 | } |
14 | |
15 | if (!$self_key || $self_key eq 'id') { |
16 | my ($pri, $too_many) = keys %{ $class->_primaries }; |
78bab9ca |
17 | $class->throw( "has_many only works with a single primary key; ${class} has more" ) |
95a70f01 |
18 | if $too_many; |
19 | $self_key = $pri; |
20 | } |
21 | |
b8e1e21f |
22 | eval "require $f_class"; |
95a70f01 |
23 | |
b8e1e21f |
24 | if (ref $f_key eq 'HASH') { $args = $f_key; undef $f_key; }; |
95a70f01 |
25 | |
604d9f38 |
26 | #unless ($f_key) { Not selective enough. Removed pending fix. |
27 | # ($f_rel) = grep { $_->{class} && $_->{class} eq $class } |
28 | # $f_class->_relationships; |
29 | #} |
95a70f01 |
30 | |
9bc6db13 |
31 | unless ($f_key) { |
32 | #warn join(', ', %{ $f_class->_columns }); |
33 | $class =~ /([^\:]+)$/; |
34 | #warn $1; |
35 | $f_key = lc $1 if $f_class->_columns->{lc $1}; |
36 | } |
95a70f01 |
37 | |
78bab9ca |
38 | $class->throw( "Unable to resolve foreign key for has_many from ${class} to ${f_class}" ) |
b8e1e21f |
39 | unless $f_key; |
78bab9ca |
40 | $class->throw( "No such column ${f_key} on foreign class ${f_class}" ) |
b8e1e21f |
41 | unless $f_class->_columns->{$f_key}; |
4a07648a |
42 | $args ||= {}; |
b28cc0ba |
43 | my $cascade = not (ref $args eq 'HASH' && delete $args->{no_cascade_delete}); |
b8e1e21f |
44 | $class->add_relationship($rel, $f_class, |
95a70f01 |
45 | { "foreign.${f_key}" => "self.${self_key}" }, |
4a07648a |
46 | { accessor => 'multi', |
47 | ($cascade ? ('cascade_delete' => 1) : ()), |
48 | %$args } ); |
b8e1e21f |
49 | return 1; |
50 | } |
51 | |
b8e1e21f |
52 | 1; |