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) = @_; |
8 | #die "No such column ${col}" unless $class->_columns->{$col}; |
9 | eval "require $f_class"; |
10 | my ($pri, $too_many) = keys %{ $class->_primaries }; |
11 | die "has_many only works with a single primary key; ${class} has more" |
12 | if $too_many; |
13 | if (ref $f_key eq 'HASH') { $args = $f_key; undef $f_key; }; |
14 | unless ($f_key) { |
9bc6db13 |
15 | ($f_key) = grep { $_->{class} && $_->{class} eq $class } |
b8e1e21f |
16 | $f_class->_relationships; |
17 | } |
9bc6db13 |
18 | unless ($f_key) { |
19 | #warn join(', ', %{ $f_class->_columns }); |
20 | $class =~ /([^\:]+)$/; |
21 | #warn $1; |
22 | $f_key = lc $1 if $f_class->_columns->{lc $1}; |
23 | } |
b8e1e21f |
24 | die "Unable to resolve foreign key for has_many from ${class} to ${f_class}" |
25 | unless $f_key; |
26 | die "No such column ${f_key} on foreign class ${f_class}" |
27 | unless $f_class->_columns->{$f_key}; |
28 | $class->add_relationship($rel, $f_class, |
29 | { "foreign.${f_key}" => "self.${pri}" }, |
30 | { _type => 'has_many', %{$args || {}} } ); |
31 | { |
32 | no strict 'refs'; |
33 | *{"${class}::${rel}"} = sub { shift->search_related($rel, @_); }; |
34 | *{"${class}::add_to_${rel}"} = sub { shift->create_related($rel, @_); }; |
35 | } |
36 | return 1; |
37 | } |
38 | |
39 | sub delete { |
40 | my ($self, @rest) = @_; |
41 | return $self->NEXT::ACTUAL::delete(@rest) unless ref $self; |
42 | # I'm just ignoring this for class deletes because hell, the db should |
43 | # be handling this anyway. Assuming we have joins we probably actually |
44 | # *could* do them, but I'd rather not. |
45 | |
46 | my $ret = $self->NEXT::ACTUAL::delete(@rest); |
47 | |
48 | my %rels = %{ $self->_relationships }; |
49 | my @hm = grep { $rels{$_}{attrs}{_type} |
50 | && $rels{$_}{attrs}{_type} eq 'has_many' } keys %rels; |
51 | foreach my $has_many (@hm) { |
52 | $_->delete for $self->search_related($has_many); |
53 | } |
54 | return $ret; |
55 | } |
56 | 1; |