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->store_inflated_column($col, @rest);
  50   $self->{_dirty_columns}{$col} = 1;
  51   return $ret;
  52 }
  53
  54 sub store_inflated_column {
  55   my ($self, $col, $obj) = @_;
  56   unless (ref $obj) {
  57     delete $self->{_inflated_column}{$col};
  58     return $self->store_column($col, $obj);
  59   }
  60
  61   my $deflated = $self->_deflated_column($col, $obj);
  62            # Do this now so we don't store if it's invalid
  63
  64   $self->{_inflated_column}{$col} = $obj;
  65   #warn "Storing $obj: ".($obj->_ident_values)[0];
  66   $self->store_column($col, $deflated);
  67   return $obj;
  68 }
  69
  70 sub new {
  71   my ($class, $attrs, @rest) = @_;
  72   $attrs ||= {};
  73   foreach my $key (keys %$attrs) {
  74     if (ref $attrs->{$key}
  75           && exists $class->column_info($key)->{_inflate_info}) {
  76       $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
  77     }
  78   }
  79   return $class->next::method($attrs, @rest);
  80 }
  81
  82 1;