lib/DBIx/Class/InflateColumn.pm

   1 package DBIx::Class::InflateColumn;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/DBIx::Class::Row/;
   6
   7 sub inflate_column {
   8   my ($self, $col, $attrs) = @_;
   9   die "No such column $col to inflate" unless $self->has_column($col);
  10   die "inflate_column needs attr hashref" unless ref $attrs eq 'HASH';
  11   $self->column_info($col)->{_inflate_info} = $attrs;
  12   $self->mk_group_accessors('inflated_column' => $col);
  13   return 1;
  14 }
  15
  16 sub _inflated_column {
  17   my ($self, $col, $value) = @_;
  18   return $value unless defined $value; # NULL is NULL is NULL
  19   my $info = $self->column_info($col) || die "No column info for $col";
  20   return $value unless exists $info->{_inflate_info};
  21   my $inflate = $info->{_inflate_info}{inflate};
  22   die "No inflator for $col" unless defined $inflate;
  23   return $inflate->($value, $self);
  24 }
  25
  26 sub _deflated_column {
  27   my ($self, $col, $value) = @_;
  28   return $value unless ref $value; # If it's not an object, don't touch it
  29   my $info = $self->column_info($col) || die "No column info for $col";
  30   return $value unless exists $info->{_inflate_info};
  31   my $deflate = $info->{_inflate_info}{deflate};
  32   die "No deflator for $col" unless defined $deflate;
  33   return $deflate->($value, $self);
  34 }
  35
  36 sub get_inflated_column {
  37   my ($self, $col) = @_;
  38   $self->throw("$col is not an inflated column") unless
  39     exists $self->column_info($col)->{_inflate_info};
  40
  41   return $self->{_inflated_column}{$col}
  42     if exists $self->{_inflated_column}{$col};
  43   return $self->{_inflated_column}{$col} =
  44            $self->_inflated_column($col, $self->get_column($col));
  45 }
  46
  47 sub set_inflated_column {
  48   my ($self, $col, @rest) = @_;
  49   my $ret = $self->_inflated_column_op('set', $col, @rest);
  50   return $ret;
  51 }
  52
  53 sub store_inflated_column {
  54   my ($self, $col, @rest) = @_;
  55   my $ret = $self->_inflated_column_op('store', $col, @rest);
  56   return $ret;
  57 }
  58
  59 sub _inflated_column_op {
  60   my ($self, $op, $col, $obj) = @_;
  61   my $meth = "${op}_column";
  62   unless (ref $obj) {
  63     delete $self->{_inflated_column}{$col};
  64     return $self->$meth($col, $obj);
  65   }
  66
  67   my $deflated = $self->_deflated_column($col, $obj);
  68            # Do this now so we don't store if it's invalid
  69
  70   $self->{_inflated_column}{$col} = $obj;
  71   $self->$meth($col, $deflated);
  72   return $obj;
  73 }
  74
  75 sub new {
  76   my ($class, $attrs, @rest) = @_;
  77   $attrs ||= {};
  78   foreach my $key (keys %$attrs) {
  79     if (ref $attrs->{$key}
  80           && exists $class->column_info($key)->{_inflate_info}) {
  81       $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
  82     }
  83   }
  84   return $class->next::method($attrs, @rest);
  85 }
  86
  87 1;