Added small create test that passes and existing DateTime object
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / InflateColumn.pm
CommitLineData
0e5c2582 1package DBIx::Class::InflateColumn;
2
3use strict;
4use warnings;
aa562407 5
aa562407 6
75a23b3e 7use base qw/DBIx::Class::Row/;
0e5c2582 8
75d07914 9=head1 NAME
bcae85db 10
11DBIx::Class::InflateColumn - Automatically create objects from column data
12
13=head1 SYNOPSIS
14
15 # In your table classes
16 __PACKAGE__->inflate_column('column_name', {
17 inflate => sub { ... },
18 deflate => sub { ... },
19 });
20
21=head1 DESCRIPTION
22
23This component translates column data into objects, i.e. "inflating"
24the column data. It also "deflates" objects into an appropriate format
25for the database.
26
27It can be used, for example, to automatically convert to and from
75d07914 28L<DateTime> objects for your date and time fields.
bcae85db 29
30=head1 METHODS
31
32=head2 inflate_column
33
75d07914 34Instruct L<DBIx::Class> to inflate the given column.
bcae85db 35
36In addition to the column name, you must provide C<inflate> and
37C<deflate> methods. The C<inflate> method is called when you access
38the field, while the C<deflate> method is called when the field needs
39to used by the database.
40
41For example, if you have a table C<events> with a timestamp field
42named C<insert_time>, you could inflate the column in the
43corresponding table class using something like:
44
45 __PACKAGE__->inflate_column('insert_time', {
46 inflate => sub { DateTime::Format::Pg->parse_datetime(shift); },
47 deflate => sub { DateTime::Format::Pg->format_datetime(shift); },
48 });
49
50(Replace L<DateTime::Format::Pg> with the appropriate module for your
51database, or consider L<DateTime::Format::DBI>.)
52
06fc5fc9 53The coderefs you set for inflate and deflate are called with two parameters,
54the first is the value of the column to be inflated/deflated, the second is the
55row object itself. Thus you can call C<< ->result_source->schema->storage->dbh >> on
56it, to feed to L<DateTime::Format::DBI>.
57
bcae85db 58In this example, calls to an event's C<insert_time> accessor return a
59L<DateTime> object. This L<DateTime> object is later "deflated" when
60used in the database layer.
61
62=cut
63
0e5c2582 64sub inflate_column {
65 my ($self, $col, $attrs) = @_;
bc0c9800 66 $self->throw_exception("No such column $col to inflate")
67 unless $self->has_column($col);
68 $self->throw_exception("inflate_column needs attr hashref")
69 unless ref $attrs eq 'HASH';
103647d5 70 $self->column_info($col)->{_inflate_info} = $attrs;
0e5c2582 71 $self->mk_group_accessors('inflated_column' => $col);
72 return 1;
73}
74
4a07648a 75sub _inflated_column {
0e5c2582 76 my ($self, $col, $value) = @_;
9f300b1b 77 return $value unless defined $value; # NULL is NULL is NULL
bc0c9800 78 my $info = $self->column_info($col)
79 or $self->throw_exception("No column info for $col");
103647d5 80 return $value unless exists $info->{_inflate_info};
81 my $inflate = $info->{_inflate_info}{inflate};
701da8c4 82 $self->throw_exception("No inflator for $col") unless defined $inflate;
0e5c2582 83 return $inflate->($value, $self);
84}
85
180c7679 86sub _deflate_column {
87 my ($self, $col) = @_;
88 return if exists $self->{_column_data}{$col};
89 my $value = $self->{_inflated_column}{$col};
90 if (ref $value) {
91 my $info = $self->column_info($col) or
92 $self->throw_exception("No column info for $col");
93 if (exists $info->{_inflate_info}) {
94 my $deflate = $info->{_inflate_info}{deflate};
95 $self->throw_exception("No deflator for $col") unless defined $deflate;
96 $value = $deflate->($value, $self);
97 }
98 }
99 $self->store_column($col, $value);
0e5c2582 100}
101
7eb4ecc8 102=head2 get_inflated_column
103
104 my $val = $obj->get_inflated_column($col);
105
106Fetch a column value in its inflated state. This is directly
107analogous to L<DBIx::Class::Row/get_column> in that it only fetches a
108column already retreived from the database, and then inflates it.
109Throws an exception if the column requested is not an inflated column.
110
111=cut
112
0e5c2582 113sub get_inflated_column {
114 my ($self, $col) = @_;
bc0c9800 115 $self->throw_exception("$col is not an inflated column")
116 unless exists $self->column_info($col)->{_inflate_info};
4a07648a 117
0e5c2582 118 return $self->{_inflated_column}{$col}
119 if exists $self->{_inflated_column}{$col};
0e5c2582 120 return $self->{_inflated_column}{$col} =
4a07648a 121 $self->_inflated_column($col, $self->get_column($col));
0e5c2582 122}
123
7eb4ecc8 124=head2 set_inflated_column
125
126 my $copy = $obj->set_inflated_column($col => $val);
127
128Sets a column value from an inflated value. This is directly
129analogous to L<DBIx::Class::Row/set_column>.
130
131=cut
132
0e5c2582 133sub set_inflated_column {
180c7679 134 my ($self, $col, $obj) = @_;
135 my $old = $self->get_inflated_column($col);
136 my $ret = $self->store_inflated_column($col, $obj);
137 $self->{_dirty_columns}{$col} = 1
138 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
0e5c2582 139 return $ret;
140}
141
7eb4ecc8 142=head2 store_inflated_column
143
144 my $copy = $obj->store_inflated_column($col => $val);
145
146Sets a column value from an inflated value without marking the column
47c56124 147as dirty. This is directly analogous to L<DBIx::Class::Row/store_column>.
7eb4ecc8 148
149=cut
150
0e5c2582 151sub store_inflated_column {
180c7679 152 my ($self, $col, $obj) = @_;
47c56124 153 if (ref $obj) {
154 delete $self->{_column_data}{$col};
155 return $self->{_inflated_column}{$col} = $obj;
156 } else {
0e5c2582 157 delete $self->{_inflated_column}{$col};
47c56124 158 return $self->store_column($col, $obj);
0e5c2582 159 }
180c7679 160}
4a07648a 161
47c56124 162=head2 get_column
163
164Gets a column value in the same way as L<DBIx::Class::Row/get_column>. If there
165is an inflated value stored that has not yet been deflated, it is deflated
166when the method is invoked.
167
168=cut
169
180c7679 170sub get_column {
171 my ($self, $col) = @_;
172 $self->_deflate_column($col);
173 return $self->next::method($col);
174}
4a07648a 175
180c7679 176sub get_columns {
177 my $self = shift;
178 if (exists $self->{_inflated_column}) {
179 $self->_deflate_column($_) for keys %{$self->{_inflated_column}};
180 }
181 return $self->next::method;
182}
183
184sub has_column_loaded {
185 my ($self, $col) = @_;
186 return 1 if exists $self->{_inflated_column}{$col};
187 return $self->next::method($col);
0e5c2582 188}
189
7eb4ecc8 190=head2 update
191
192Updates a row in the same way as L<DBIx::Class::Row/update>, handling
193inflation and deflation of columns appropriately.
194
195=cut
196
9fcda149 197sub update {
198 my ($class, $attrs, @rest) = @_;
180c7679 199 foreach my $key (keys %{$attrs||{}}) {
9fcda149 200 if (ref $attrs->{$key}
201 && exists $class->column_info($key)->{_inflate_info}) {
180c7679 202 $class->set_inflated_column($key, delete $attrs->{$key});
9fcda149 203 }
204 }
205 return $class->next::method($attrs, @rest);
206}
207
7eb4ecc8 208=head2 new
209
210Creates a row in the same way as L<DBIx::Class::Row/new>, handling
211inflation and deflation of columns appropriately.
212
213=cut
214
0e5c2582 215sub new {
216 my ($class, $attrs, @rest) = @_;
180c7679 217 my $inflated;
218 foreach my $key (keys %{$attrs||{}}) {
219 $inflated->{$key} = delete $attrs->{$key}
220 if ref $attrs->{$key} && exists $class->column_info($key)->{_inflate_info};
0e5c2582 221 }
180c7679 222 my $obj = $class->next::method($attrs, @rest);
223 $obj->{_inflated_column} = $inflated if $inflated;
224 return $obj;
0e5c2582 225}
226
bcae85db 227=head1 SEE ALSO
228
229=over 4
230
231=item L<DBIx::Class::Core> - This component is loaded as part of the
232 "core" L<DBIx::Class> components; generally there is no need to
233 load it directly
234
235=back
236
237=head1 AUTHOR
238
239Matt S. Trout <mst@shadowcatsystems.co.uk>
240
241=head1 CONTRIBUTORS
242
243Daniel Westermann-Clark <danieltwc@cpan.org> (documentation)
244
245=head1 LICENSE
246
247You may distribute this code under the same terms as Perl itself.
248
249=cut
250
0e5c2582 2511;