lib/DBIx/Class/CDBICompat/HasMany.pm

   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
   9   my @f_method;
  10
  11   if (ref $f_class eq 'ARRAY') {
  12     ($f_class, @f_method) = @$f_class;
  13   }
  14
  15   if (ref $f_key eq 'HASH' && !$args) { $args = $f_key; undef $f_key; };
  16
  17   $args ||= {};
  18   if (delete $args->{no_cascade_delete}) {
  19     $args->{cascade_delete} = 0;
  20   }
  21
  22   $class->next::method($rel, $f_class, $f_key, $args);
  23
  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
  37 }
  38
  39 1;