Commit | Line | Data |
0e5c2582 |
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) = @_; |
9f300b1b |
17 | return $value unless defined $value; # NULL is NULL is NULL |
0e5c2582 |
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 | } |
9f300b1b |
57 | my $deflated = $self->_deflate_column_value($col, $obj); |
58 | # Do this now so we don't store if it's invalid |
0e5c2582 |
59 | $self->{_inflated_column}{$col} = $obj; |
60 | #warn "Storing $obj: ".($obj->_ident_values)[0]; |
9f300b1b |
61 | $self->store_column($col, $deflated); |
0e5c2582 |
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; |