Typo in scalar ref example
[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
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
89279e9d 86sub _deflated_column {
87 my ($self, $col, $value) = @_;
88 return $value unless ref $value; # If it's not an object, don't touch it
89 my $info = $self->column_info($col) or
90 $self->throw_exception("No column info for $col");
91 return $value unless exists $info->{_inflate_info};
92 my $deflate = $info->{_inflate_info}{deflate};
93 $self->throw_exception("No deflator for $col") unless defined $deflate;
94 return $deflate->($value, $self);
0e5c2582 95}
96
7eb4ecc8 97=head2 get_inflated_column
98
99 my $val = $obj->get_inflated_column($col);
100
101Fetch a column value in its inflated state. This is directly
102analogous to L<DBIx::Class::Row/get_column> in that it only fetches a
103column already retreived from the database, and then inflates it.
104Throws an exception if the column requested is not an inflated column.
105
106=cut
107
0e5c2582 108sub get_inflated_column {
109 my ($self, $col) = @_;
bc0c9800 110 $self->throw_exception("$col is not an inflated column")
111 unless exists $self->column_info($col)->{_inflate_info};
0e5c2582 112 return $self->{_inflated_column}{$col}
113 if exists $self->{_inflated_column}{$col};
0e5c2582 114 return $self->{_inflated_column}{$col} =
4a07648a 115 $self->_inflated_column($col, $self->get_column($col));
0e5c2582 116}
117
7eb4ecc8 118=head2 set_inflated_column
119
120 my $copy = $obj->set_inflated_column($col => $val);
121
122Sets a column value from an inflated value. This is directly
123analogous to L<DBIx::Class::Row/set_column>.
124
125=cut
126
0e5c2582 127sub set_inflated_column {
180c7679 128 my ($self, $col, $obj) = @_;
9f471067 129 $self->set_column($col, $self->_deflated_column($col, $obj));
130 if (blessed $obj) {
131 $self->{_inflated_column}{$col} = $obj;
132 } else {
133 delete $self->{_inflated_column}{$col};
134 }
135 return $obj;
0e5c2582 136}
137
7eb4ecc8 138=head2 store_inflated_column
139
140 my $copy = $obj->store_inflated_column($col => $val);
141
142Sets a column value from an inflated value without marking the column
47c56124 143as dirty. This is directly analogous to L<DBIx::Class::Row/store_column>.
7eb4ecc8 144
145=cut
146
0e5c2582 147sub store_inflated_column {
180c7679 148 my ($self, $col, $obj) = @_;
9f471067 149 unless (blessed $obj) {
150 delete $self->{_inflated_column}{$col};
c5cf11f1 151 $self->store_column($col => $obj);
152 return $obj;
9f471067 153 }
25594f03 154 delete $self->{_column_data}{$col};
89279e9d 155 return $self->{_inflated_column}{$col} = $obj;
180c7679 156}
4a07648a 157
47c56124 158=head2 get_column
159
160Gets a column value in the same way as L<DBIx::Class::Row/get_column>. If there
161is an inflated value stored that has not yet been deflated, it is deflated
162when the method is invoked.
163
164=cut
165
180c7679 166sub get_column {
167 my ($self, $col) = @_;
89279e9d 168 if (exists $self->{_inflated_column}{$col}
169 && !exists $self->{_column_data}{$col}) {
170 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
171 }
180c7679 172 return $self->next::method($col);
173}
4a07648a 174
3fbd7eac 175=head2 get_columns
176
177Returns the get_column info for all columns as a hash,
178just like L<DBIx::Class::Row/get_columns>. Handles inflation just
179like L</get_column>.
180
181=cut
182
180c7679 183sub get_columns {
184 my $self = shift;
185 if (exists $self->{_inflated_column}) {
89279e9d 186 foreach my $col (keys %{$self->{_inflated_column}}) {
425f2ea9 187 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
89279e9d 188 unless exists $self->{_column_data}{$col};
189 }
180c7679 190 }
191 return $self->next::method;
192}
193
3fbd7eac 194=head2 has_column_loaded
195
196Like L<DBIx::Class::Row/has_column_loaded>, but also returns true if there
197is an inflated value stored.
198
199=cut
200
180c7679 201sub has_column_loaded {
202 my ($self, $col) = @_;
203 return 1 if exists $self->{_inflated_column}{$col};
204 return $self->next::method($col);
0e5c2582 205}
206
7eb4ecc8 207=head2 update
208
209Updates a row in the same way as L<DBIx::Class::Row/update>, handling
210inflation and deflation of columns appropriately.
211
212=cut
213
9fcda149 214sub update {
215 my ($class, $attrs, @rest) = @_;
180c7679 216 foreach my $key (keys %{$attrs||{}}) {
9fcda149 217 if (ref $attrs->{$key}
218 && exists $class->column_info($key)->{_inflate_info}) {
180c7679 219 $class->set_inflated_column($key, delete $attrs->{$key});
9fcda149 220 }
221 }
222 return $class->next::method($attrs, @rest);
223}
224
7eb4ecc8 225=head2 new
226
227Creates a row in the same way as L<DBIx::Class::Row/new>, handling
228inflation and deflation of columns appropriately.
229
230=cut
231
0e5c2582 232sub new {
233 my ($class, $attrs, @rest) = @_;
180c7679 234 my $inflated;
235 foreach my $key (keys %{$attrs||{}}) {
236 $inflated->{$key} = delete $attrs->{$key}
237 if ref $attrs->{$key} && exists $class->column_info($key)->{_inflate_info};
0e5c2582 238 }
180c7679 239 my $obj = $class->next::method($attrs, @rest);
240 $obj->{_inflated_column} = $inflated if $inflated;
241 return $obj;
0e5c2582 242}
243
bcae85db 244=head1 SEE ALSO
245
246=over 4
247
248=item L<DBIx::Class::Core> - This component is loaded as part of the
249 "core" L<DBIx::Class> components; generally there is no need to
250 load it directly
251
252=back
253
254=head1 AUTHOR
255
256Matt S. Trout <mst@shadowcatsystems.co.uk>
257
258=head1 CONTRIBUTORS
259
260Daniel Westermann-Clark <danieltwc@cpan.org> (documentation)
261
262=head1 LICENSE
263
264You may distribute this code under the same terms as Perl itself.
265
266=cut
267
0e5c2582 2681;