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 | |
33ce49d6 |
9 | my @f_method; |
95a70f01 |
10 | |
11 | if (ref $f_class eq 'ARRAY') { |
33ce49d6 |
12 | ($f_class, @f_method) = @$f_class; |
95a70f01 |
13 | } |
14 | |
07037f89 |
15 | if (ref $f_key eq 'HASH' && !$args) { $args = $f_key; undef $f_key; }; |
95a70f01 |
16 | |
07037f89 |
17 | $args ||= {}; |
18 | if (delete $args->{no_cascade_delete}) { |
19 | $args->{cascade_delete} = 0; |
9bc6db13 |
20 | } |
95a70f01 |
21 | |
147dd158 |
22 | $class->next::method($rel, $f_class, $f_key, $args); |
33ce49d6 |
23 | |
33ce49d6 |
24 | if (@f_method) { |
25 | no strict 'refs'; |
26 | no warnings 'redefine'; |
27 | my $post_proc = sub { my $o = shift; $o = $o->$_ for @f_method; $o; }; |
28 | *{"${class}::${rel}"} = |
29 | sub { |
30 | my $rs = shift->search_related($rel => @_); |
31 | $rs->{attrs}{record_filter} = $post_proc; |
32 | return (wantarray ? $rs->all : $rs); |
33 | }; |
34 | return 1; |
35 | } |
36 | |
b8e1e21f |
37 | } |
38 | |
b8e1e21f |
39 | 1; |