4547ab5ced3d4eb246c161a4aa5130613f420b5a
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / HasA.pm
1 package DBIx::Class::CDBICompat::HasA;
2
3 use strict;
4 use warnings;
5
6 sub has_a {
7   my ($self, $col, $f_class, %args) = @_;
8   $self->throw( "No such column ${col}" ) unless $self->has_column($col);
9   eval "require $f_class";
10   if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
11     if (!ref $args{'inflate'}) {
12       my $meth = $args{'inflate'};
13       $args{'inflate'} = sub { $f_class->$meth(shift); };
14     }
15     if (!ref $args{'deflate'}) {
16       my $meth = $args{'deflate'};
17       $args{'deflate'} = sub { shift->$meth; };
18     }
19     $self->inflate_column($col, \%args);
20     return 1;
21   }
22
23   $self->belongs_to($col, $f_class);
24   return 1;
25 }
26
27 1;