Fixed DBICTest Schema class names, added class_resolver system to make them work
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / InflateColumn.pm
CommitLineData
0e5c2582 1package DBIx::Class::InflateColumn;
2
3use strict;
4use warnings;
5
6sub 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
4a07648a 15sub _inflated_column {
0e5c2582 16 my ($self, $col, $value) = @_;
9f300b1b 17 return $value unless defined $value; # NULL is NULL is NULL
4a07648a 18 return $value unless exists $self->_columns->{$col}{_inflate_info};
0e5c2582 19 return $value unless exists $self->_columns->{$col}{_inflate_info}{inflate};
20 my $inflate = $self->_columns->{$col}{_inflate_info}{inflate};
21 return $inflate->($value, $self);
22}
23
4a07648a 24sub _deflated_column {
0e5c2582 25 my ($self, $col, $value) = @_;
26 return $value unless ref $value; # If it's not an object, don't touch it
4a07648a 27 return $value unless exists $self->_columns->{$col}{_inflate_info};
0e5c2582 28 return $value unless exists $self->_columns->{$col}{_inflate_info}{deflate};
29 my $deflate = $self->_columns->{$col}{_inflate_info}{deflate};
30 return $deflate->($value, $self);
31}
32
33sub get_inflated_column {
34 my ($self, $col) = @_;
35 $self->throw("$col is not an inflated column") unless
36 exists $self->_columns->{$col}{_inflate_info};
4a07648a 37
0e5c2582 38 return $self->{_inflated_column}{$col}
39 if exists $self->{_inflated_column}{$col};
0e5c2582 40 return $self->{_inflated_column}{$col} =
4a07648a 41 $self->_inflated_column($col, $self->get_column($col));
0e5c2582 42}
43
44sub 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
51sub 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 }
4a07648a 57
58 my $deflated = $self->_deflated_column($col, $obj);
9f300b1b 59 # Do this now so we don't store if it's invalid
4a07648a 60
0e5c2582 61 $self->{_inflated_column}{$col} = $obj;
62 #warn "Storing $obj: ".($obj->_ident_values)[0];
9f300b1b 63 $self->store_column($col, $deflated);
0e5c2582 64 return $obj;
65}
66
67sub new {
68 my ($class, $attrs, @rest) = @_;
69 $attrs ||= {};
70 my %deflated;
71 foreach my $key (keys %$attrs) {
72 if (exists $class->_columns->{$key}{_inflate_info}) {
4a07648a 73 $deflated{$key} = $class->_deflated_column($key,
0e5c2582 74 delete $attrs->{$key});
75 }
76 }
77 return $class->NEXT::ACTUAL::new({ %$attrs, %deflated }, @rest);
78}
79
80sub _cond_value {
81 my ($self, $attrs, $key, $value) = @_;
82 if (exists $self->_columns->{$key}) {
4a07648a 83 $value = $self->_deflated_column($key, $value);
0e5c2582 84 }
85 return $self->NEXT::ACTUAL::_cond_value($attrs, $key, $value);
86}
87
881;