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, @f_method) = @$f_class;
15 my ($pri, $too_many) = keys %{ $class->_primaries };
16 $class->throw( "has_many only works with a single primary key; ${class} has more" )
20 eval "require $f_class";
22 if (ref $f_key eq 'HASH') { $args = $f_key; undef $f_key; };
24 #unless ($f_key) { Not selective enough. Removed pending fix.
25 # ($f_rel) = grep { $_->{class} && $_->{class} eq $class }
26 # $f_class->_relationships;
30 #warn join(', ', %{ $f_class->_columns });
31 $class =~ /([^\:]+)$/;
33 $f_key = lc $1 if $f_class->_columns->{lc $1};
36 $class->throw( "Unable to resolve foreign key for has_many from ${class} to ${f_class}" )
38 $class->throw( "No such column ${f_key} on foreign class ${f_class}" )
39 unless $f_class->_columns->{$f_key};
41 my $cascade = not (ref $args eq 'HASH' && delete $args->{no_cascade_delete});
43 $class->add_relationship($rel, $f_class,
44 { "foreign.${f_key}" => "self.${self_key}" },
45 { accessor => 'multi',
47 ($cascade ? ('cascade_delete' => 1) : ()),
51 no warnings 'redefine';
52 my $post_proc = sub { my $o = shift; $o = $o->$_ for @f_method; $o; };
53 *{"${class}::${rel}"} =
55 my $rs = shift->search_related($rel => @_);
56 $rs->{attrs}{record_filter} = $post_proc;
57 return (wantarray ? $rs->all : $rs);