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 exists $self->_columns->{$col};
   9   die "inflate_column needs attr hashref" unless ref $attrs eq 'HASH';
  10   $self->_columns->{$col}{_inflate_info} = $attrs;
  11   $self->mk_group_accessors('inflated_column' => $col);
  12   return 1;
  13 }
  14
  15 sub _inflate_column_value {
  16   my ($self, $col, $value) = @_;
  17   return $value unless exists $self->_columns->{$col}{_inflate_info}{inflate};
  18   my $inflate = $self->_columns->{$col}{_inflate_info}{inflate};
  19   return $inflate->($value, $self);
  20 }
  21
  22 sub _deflate_column_value {
  23   my ($self, $col, $value) = @_;
  24   return $value unless ref $value; # If it's not an object, don't touch it
  25   return $value unless exists $self->_columns->{$col}{_inflate_info}{deflate};
  26   my $deflate = $self->_columns->{$col}{_inflate_info}{deflate};
  27   return $deflate->($value, $self);
  28 }
  29
  30 sub get_inflated_column {
  31   my ($self, $col) = @_;
  32   $self->throw("$col is not an inflated column") unless
  33     exists $self->_columns->{$col}{_inflate_info};
  34   #warn $rel;
  35   #warn join(', ', %{$self->{_column_data}});
  36   return $self->{_inflated_column}{$col}
  37     if exists $self->{_inflated_column}{$col};
  38   #my ($pri) = (keys %{$self->_relationships->{$rel}{class}->_primaries})[0];
  39   return $self->{_inflated_column}{$col} =
  40            $self->_inflate_column_value($col, $self->get_column($col));
  41 }
  42
  43 sub set_inflated_column {
  44   my ($self, $col, @rest) = @_;
  45   my $ret = $self->store_inflated_column($col, @rest);
  46   $self->{_dirty_columns}{$col} = 1;
  47   return $ret;
  48 }
  49
  50 sub store_inflated_column {
  51   my ($self, $col, $obj) = @_;
  52   unless (ref $obj) {
  53     delete $self->{_inflated_column}{$col};
  54     return $self->store_column($col, $obj);
  55   }
  56   $self->{_inflated_column}{$col} = $obj;
  57   #warn "Storing $obj: ".($obj->_ident_values)[0];
  58   $self->store_column($col, $self->_deflate_column_value($col, $obj));
  59   return $obj;
  60 }
  61
  62 sub new {
  63   my ($class, $attrs, @rest) = @_;
  64   $attrs ||= {};
  65   my %deflated;
  66   foreach my $key (keys %$attrs) {
  67     if (exists $class->_columns->{$key}{_inflate_info}) {
  68       $deflated{$key} = $class->_deflate_column_value($key,
  69                                                         delete $attrs->{$key});
  70     }
  71   }
  72   return $class->NEXT::ACTUAL::new({ %$attrs, %deflated }, @rest);
  73 }
  74
  75 sub _cond_value {
  76   my ($self, $attrs, $key, $value) = @_;
  77   if (exists $self->_columns->{$key}) {
  78     $value = $self->_deflate_column_value($key, $value);
  79   }
  80   return $self->NEXT::ACTUAL::_cond_value($attrs, $key, $value);
  81 }
  82
  83 1;