explained a cryptic error message
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / InflateColumn.pm
CommitLineData
0e5c2582 1package DBIx::Class::InflateColumn;
2
3use strict;
4use warnings;
ba026511 5use Scalar::Util qw/blessed/;
aa562407 6
75a23b3e 7use base qw/DBIx::Class::Row/;
0e5c2582 8
75d07914 9=head1 NAME
bcae85db 10
e81a6241 11DBIx::Class::InflateColumn - Automatically create references from column data
bcae85db 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
e81a6241 23This component translates column data into references, i.e. "inflating"
24the column data. It also "deflates" references into an appropriate format
bcae85db 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
e81a6241 30It will accept arrayrefs, hashrefs and blessed references (objects),
31but not scalarrefs. Scalar references are passed through to the
32database to deal with, to allow such settings as C< \'year + 1'> and
33C< \'DEFAULT' > to work.
34
bcae85db 35=head1 METHODS
36
37=head2 inflate_column
38
75d07914 39Instruct L<DBIx::Class> to inflate the given column.
bcae85db 40
41In addition to the column name, you must provide C<inflate> and
42C<deflate> methods. The C<inflate> method is called when you access
43the field, while the C<deflate> method is called when the field needs
44to used by the database.
45
46For example, if you have a table C<events> with a timestamp field
47named C<insert_time>, you could inflate the column in the
48corresponding table class using something like:
49
50 __PACKAGE__->inflate_column('insert_time', {
51 inflate => sub { DateTime::Format::Pg->parse_datetime(shift); },
52 deflate => sub { DateTime::Format::Pg->format_datetime(shift); },
53 });
54
55(Replace L<DateTime::Format::Pg> with the appropriate module for your
56database, or consider L<DateTime::Format::DBI>.)
57
06fc5fc9 58The coderefs you set for inflate and deflate are called with two parameters,
59the first is the value of the column to be inflated/deflated, the second is the
60row object itself. Thus you can call C<< ->result_source->schema->storage->dbh >> on
61it, to feed to L<DateTime::Format::DBI>.
62
bcae85db 63In this example, calls to an event's C<insert_time> accessor return a
64L<DateTime> object. This L<DateTime> object is later "deflated" when
65used in the database layer.
66
67=cut
68
0e5c2582 69sub inflate_column {
70 my ($self, $col, $attrs) = @_;
bc0c9800 71 $self->throw_exception("No such column $col to inflate")
72 unless $self->has_column($col);
73 $self->throw_exception("inflate_column needs attr hashref")
74 unless ref $attrs eq 'HASH';
103647d5 75 $self->column_info($col)->{_inflate_info} = $attrs;
0e5c2582 76 $self->mk_group_accessors('inflated_column' => $col);
77 return 1;
78}
79
4a07648a 80sub _inflated_column {
0e5c2582 81 my ($self, $col, $value) = @_;
9f300b1b 82 return $value unless defined $value; # NULL is NULL is NULL
bc0c9800 83 my $info = $self->column_info($col)
84 or $self->throw_exception("No column info for $col");
103647d5 85 return $value unless exists $info->{_inflate_info};
86 my $inflate = $info->{_inflate_info}{inflate};
701da8c4 87 $self->throw_exception("No inflator for $col") unless defined $inflate;
0e5c2582 88 return $inflate->($value, $self);
89}
90
89279e9d 91sub _deflated_column {
92 my ($self, $col, $value) = @_;
e81a6241 93# return $value unless ref $value && blessed($value); # If it's not an object, don't touch it
94 ## Leave scalar refs (ala SQL::Abstract literal SQL), untouched, deflate all other refs
95 return $value unless (ref $value && ref($value) ne 'SCALAR');
89279e9d 96 my $info = $self->column_info($col) or
97 $self->throw_exception("No column info for $col");
98 return $value unless exists $info->{_inflate_info};
99 my $deflate = $info->{_inflate_info}{deflate};
100 $self->throw_exception("No deflator for $col") unless defined $deflate;
101 return $deflate->($value, $self);
0e5c2582 102}
103
7eb4ecc8 104=head2 get_inflated_column
105
106 my $val = $obj->get_inflated_column($col);
107
108Fetch a column value in its inflated state. This is directly
109analogous to L<DBIx::Class::Row/get_column> in that it only fetches a
110column already retreived from the database, and then inflates it.
111Throws an exception if the column requested is not an inflated column.
112
113=cut
114
0e5c2582 115sub get_inflated_column {
116 my ($self, $col) = @_;
bc0c9800 117 $self->throw_exception("$col is not an inflated column")
118 unless exists $self->column_info($col)->{_inflate_info};
0e5c2582 119 return $self->{_inflated_column}{$col}
120 if exists $self->{_inflated_column}{$col};
0e5c2582 121 return $self->{_inflated_column}{$col} =
4a07648a 122 $self->_inflated_column($col, $self->get_column($col));
0e5c2582 123}
124
7eb4ecc8 125=head2 set_inflated_column
126
127 my $copy = $obj->set_inflated_column($col => $val);
128
129Sets a column value from an inflated value. This is directly
130analogous to L<DBIx::Class::Row/set_column>.
131
132=cut
133
0e5c2582 134sub set_inflated_column {
ad5d0ee9 135 my ($self, $col, $inflated) = @_;
136 $self->set_column($col, $self->_deflated_column($col, $inflated));
137# if (blessed $inflated) {
138 if (ref $inflated && ref($inflated) ne 'SCALAR') {
139 $self->{_inflated_column}{$col} = $inflated;
9f471067 140 } else {
141 delete $self->{_inflated_column}{$col};
142 }
ad5d0ee9 143 return $inflated;
0e5c2582 144}
145
7eb4ecc8 146=head2 store_inflated_column
147
148 my $copy = $obj->store_inflated_column($col => $val);
149
150Sets a column value from an inflated value without marking the column
47c56124 151as dirty. This is directly analogous to L<DBIx::Class::Row/store_column>.
7eb4ecc8 152
153=cut
154
0e5c2582 155sub store_inflated_column {
ad5d0ee9 156 my ($self, $col, $inflated) = @_;
157# unless (blessed $inflated) {
158 unless (ref $inflated && ref($inflated) ne 'SCALAR') {
9f471067 159 delete $self->{_inflated_column}{$col};
ad5d0ee9 160 $self->store_column($col => $inflated);
161 return $inflated;
9f471067 162 }
25594f03 163 delete $self->{_column_data}{$col};
ad5d0ee9 164 return $self->{_inflated_column}{$col} = $inflated;
180c7679 165}
4a07648a 166
47c56124 167=head2 get_column
168
169Gets a column value in the same way as L<DBIx::Class::Row/get_column>. If there
170is an inflated value stored that has not yet been deflated, it is deflated
171when the method is invoked.
172
173=cut
174
180c7679 175sub get_column {
176 my ($self, $col) = @_;
89279e9d 177 if (exists $self->{_inflated_column}{$col}
178 && !exists $self->{_column_data}{$col}) {
179 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
180 }
180c7679 181 return $self->next::method($col);
182}
4a07648a 183
3fbd7eac 184=head2 get_columns
185
186Returns the get_column info for all columns as a hash,
187just like L<DBIx::Class::Row/get_columns>. Handles inflation just
188like L</get_column>.
189
190=cut
191
180c7679 192sub get_columns {
193 my $self = shift;
194 if (exists $self->{_inflated_column}) {
89279e9d 195 foreach my $col (keys %{$self->{_inflated_column}}) {
425f2ea9 196 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
89279e9d 197 unless exists $self->{_column_data}{$col};
198 }
180c7679 199 }
200 return $self->next::method;
201}
202
3fbd7eac 203=head2 has_column_loaded
204
205Like L<DBIx::Class::Row/has_column_loaded>, but also returns true if there
206is an inflated value stored.
207
208=cut
209
180c7679 210sub has_column_loaded {
211 my ($self, $col) = @_;
212 return 1 if exists $self->{_inflated_column}{$col};
213 return $self->next::method($col);
0e5c2582 214}
215
7eb4ecc8 216=head2 update
217
218Updates a row in the same way as L<DBIx::Class::Row/update>, handling
219inflation and deflation of columns appropriately.
220
221=cut
222
9fcda149 223sub update {
224 my ($class, $attrs, @rest) = @_;
180c7679 225 foreach my $key (keys %{$attrs||{}}) {
096f4212 226 if (ref $attrs->{$key} && $class->has_column($key)
9fcda149 227 && exists $class->column_info($key)->{_inflate_info}) {
180c7679 228 $class->set_inflated_column($key, delete $attrs->{$key});
9fcda149 229 }
230 }
231 return $class->next::method($attrs, @rest);
232}
233
7eb4ecc8 234=head2 new
235
236Creates a row in the same way as L<DBIx::Class::Row/new>, handling
237inflation and deflation of columns appropriately.
238
239=cut
240
0e5c2582 241sub new {
242 my ($class, $attrs, @rest) = @_;
180c7679 243 my $inflated;
244 foreach my $key (keys %{$attrs||{}}) {
245 $inflated->{$key} = delete $attrs->{$key}
096f4212 246 if ref $attrs->{$key} && $class->has_column($key)
247 && exists $class->column_info($key)->{_inflate_info};
0e5c2582 248 }
180c7679 249 my $obj = $class->next::method($attrs, @rest);
250 $obj->{_inflated_column} = $inflated if $inflated;
251 return $obj;
0e5c2582 252}
253
bcae85db 254=head1 SEE ALSO
255
256=over 4
257
258=item L<DBIx::Class::Core> - This component is loaded as part of the
259 "core" L<DBIx::Class> components; generally there is no need to
260 load it directly
261
262=back
263
264=head1 AUTHOR
265
266Matt S. Trout <mst@shadowcatsystems.co.uk>
267
268=head1 CONTRIBUTORS
269
270Daniel Westermann-Clark <danieltwc@cpan.org> (documentation)
271
e81a6241 272Jess Robinson <cpan@desert-island.demon.co.uk>
273
bcae85db 274=head1 LICENSE
275
276You may distribute this code under the same terms as Perl itself.
277
278=cut
279
0e5c2582 2801;