lib/DBIx/Class/CDBICompat/HasA.pm

   1 package # hide from PAUSE
   2     DBIx::Class::CDBICompat::HasA;
   3
   4 use strict;
   5 use warnings;
   6
   7 sub has_a {
   8   my ($self, $col, $f_class, %args) = @_;
   9   $self->throw_exception( "No such column ${col}" ) unless $self->has_column($col);
  10   eval "require $f_class";
  11   if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
  12     if (!ref $args{'inflate'}) {
  13       my $meth = $args{'inflate'};
  14       $args{'inflate'} = sub { $f_class->$meth(shift); };
  15     }
  16     if (!ref $args{'deflate'}) {
  17       my $meth = $args{'deflate'};
  18       $args{'deflate'} = sub { shift->$meth; };
  19     }
  20     $self->inflate_column($col, \%args);
  21     return 1;
  22   }
  23
  24   $self->belongs_to($col, $f_class);
  25   return 1;
  26 }
  27
  28 sub search {
  29   my $self = shift;
  30   my $attrs = {};
  31   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
  32     $attrs = { %{ pop(@_) } };
  33   }
  34   my $where = (@_ ? ((@_ == 1) ? ((ref $_[0] eq "HASH") ? { %{+shift} } : shift)
  35                                : {@_})
  36                   : undef());
  37   if (ref $where eq 'HASH') {
  38     foreach my $key (keys %$where) { # has_a deflation hack
  39       $where->{$key} = ''.$where->{$key}
  40         if eval { $where->{$key}->isa('DBIx::Class') };
  41     }
  42   }
  43   $self->next::method($where, $attrs);
  44 }
  45
  46 1;