1 package DBIx::Class::CDBICompat::HasMany;
7 my ($class, $rel, $f_class, $f_key, $args) = @_;
11 if (ref $f_class eq 'ARRAY') {
12 ($f_class, $self_key) = @$f_class;
15 if (!$self_key || $self_key eq 'id') {
16 my ($pri, $too_many) = keys %{ $class->_primaries };
17 die "has_many only works with a single primary key; ${class} has more"
22 eval "require $f_class";
24 if (ref $f_key eq 'HASH') { $args = $f_key; undef $f_key; };
26 #unless ($f_key) { Not selective enough. Removed pending fix.
27 # ($f_rel) = grep { $_->{class} && $_->{class} eq $class }
28 # $f_class->_relationships;
32 #warn join(', ', %{ $f_class->_columns });
33 $class =~ /([^\:]+)$/;
35 $f_key = lc $1 if $f_class->_columns->{lc $1};
38 die "Unable to resolve foreign key for has_many from ${class} to ${f_class}"
40 die "No such column ${f_key} on foreign class ${f_class}"
41 unless $f_class->_columns->{$f_key};
42 $class->add_relationship($rel, $f_class,
43 { "foreign.${f_key}" => "self.${self_key}" },
44 { _type => 'has_many', %{$args || {}} } );
47 *{"${class}::${rel}"} = sub { shift->search_related($rel, @_); };
48 *{"${class}::add_to_${rel}"} = sub { shift->create_related($rel, @_); };
54 my ($self, @rest) = @_;
55 return $self->NEXT::ACTUAL::delete(@rest) unless ref $self;
56 # I'm just ignoring this for class deletes because hell, the db should
57 # be handling this anyway. Assuming we have joins we probably actually
58 # *could* do them, but I'd rather not.
60 my $ret = $self->NEXT::ACTUAL::delete(@rest);
62 my %rels = %{ $self->_relationships };
63 my @hm = grep { $rels{$_}{attrs}{_type}
64 && $rels{$_}{attrs}{_type} eq 'has_many' } keys %rels;
65 foreach my $has_many (@hm) {
66 unless ($rels{$has_many}->{attrs}{no_cascade_delete}) {
67 $_->delete for $self->search_related($has_many)