lib/DBIx/Class/InflateColumn.pm

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