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