Updated version and Changes for 0.06999_02
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / InflateColumn.pm
1 package DBIx::Class::InflateColumn;
2
3 use strict;
4 use warnings;
5
6
7 use base qw/DBIx::Class::Row/;
8
9 =head1 NAME
10
11 DBIx::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
23 This component translates column data into objects, i.e. "inflating"
24 the column data. It also "deflates" objects into an appropriate format
25 for the database.
26
27 It can be used, for example, to automatically convert to and from
28 L<DateTime> objects for your date and time fields.
29
30 =head1 METHODS
31
32 =head2 inflate_column
33
34 Instruct L<DBIx::Class> to inflate the given column.
35
36 In addition to the column name, you must provide C<inflate> and
37 C<deflate> methods. The C<inflate> method is called when you access
38 the field, while the C<deflate> method is called when the field needs
39 to used by the database.
40
41 For example, if you have a table C<events> with a timestamp field
42 named C<insert_time>, you could inflate the column in the
43 corresponding 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
51 database, or consider L<DateTime::Format::DBI>.)
52
53 The coderefs you set for inflate and deflate are called with two parameters,
54 the first is the value of the column to be inflated/deflated, the second is the
55 row object itself. Thus you can call C<< ->result_source->schema->storage->dbh >> on
56 it, to feed to L<DateTime::Format::DBI>.
57
58 In this example, calls to an event's C<insert_time> accessor return a
59 L<DateTime> object. This L<DateTime> object is later "deflated" when
60 used in the database layer.
61
62 =cut
63
64 sub inflate_column {
65   my ($self, $col, $attrs) = @_;
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';
70   $self->column_info($col)->{_inflate_info} = $attrs;
71   $self->mk_group_accessors('inflated_column' => $col);
72   return 1;
73 }
74
75 sub _inflated_column {
76   my ($self, $col, $value) = @_;
77   return $value unless defined $value; # NULL is NULL is NULL
78   my $info = $self->column_info($col)
79     or $self->throw_exception("No column info for $col");
80   return $value unless exists $info->{_inflate_info};
81   my $inflate = $info->{_inflate_info}{inflate};
82   $self->throw_exception("No inflator for $col") unless defined $inflate;
83   return $inflate->($value, $self);
84 }
85
86 sub _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);
95 }
96
97 =head2 get_inflated_column
98
99   my $val = $obj->get_inflated_column($col);
100
101 Fetch a column value in its inflated state.  This is directly
102 analogous to L<DBIx::Class::Row/get_column> in that it only fetches a
103 column already retreived from the database, and then inflates it.
104 Throws an exception if the column requested is not an inflated column.
105
106 =cut
107
108 sub get_inflated_column {
109   my ($self, $col) = @_;
110   $self->throw_exception("$col is not an inflated column")
111     unless exists $self->column_info($col)->{_inflate_info};
112
113   return $self->{_inflated_column}{$col}
114     if exists $self->{_inflated_column}{$col};
115   return $self->{_inflated_column}{$col} =
116            $self->_inflated_column($col, $self->get_column($col));
117 }
118
119 =head2 set_inflated_column
120
121   my $copy = $obj->set_inflated_column($col => $val);
122
123 Sets a column value from an inflated value.  This is directly
124 analogous to L<DBIx::Class::Row/set_column>.
125
126 =cut
127
128 sub set_inflated_column {
129   my ($self, $col, @rest) = @_;
130   my $ret = $self->_inflated_column_op('set', $col, @rest);
131   return $ret;
132 }
133
134 =head2 store_inflated_column
135
136   my $copy = $obj->store_inflated_column($col => $val);
137
138 Sets a column value from an inflated value without marking the column
139 as dirty.  This is directly analogous to
140 L<DBIx::Class::Row/store_column>.
141
142 =cut
143
144 sub store_inflated_column {
145   my ($self, $col, @rest) = @_;
146   my $ret = $self->_inflated_column_op('store', $col, @rest);
147   return $ret;
148 }
149
150 sub _inflated_column_op {
151   my ($self, $op, $col, $obj) = @_;
152   my $meth = "${op}_column";
153   unless (ref $obj) {
154     delete $self->{_inflated_column}{$col};
155     return $self->$meth($col, $obj);
156   }
157
158   my $deflated = $self->_deflated_column($col, $obj);
159            # Do this now so we don't store if it's invalid
160
161   $self->{_inflated_column}{$col} = $obj;
162   $self->$meth($col, $deflated);
163   return $obj;
164 }
165
166 =head2 update
167
168 Updates a row in the same way as L<DBIx::Class::Row/update>, handling
169 inflation and deflation of columns appropriately.
170
171 =cut
172
173 sub update {
174   my ($class, $attrs, @rest) = @_;
175   $attrs ||= {};
176   foreach my $key (keys %$attrs) {
177     if (ref $attrs->{$key}
178           && exists $class->column_info($key)->{_inflate_info}) {
179 #      $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
180       $class->set_inflated_column ($key, delete $attrs->{$key});
181     }
182   }
183   return $class->next::method($attrs, @rest);
184 }
185
186 =head2 new
187
188 Creates a row in the same way as L<DBIx::Class::Row/new>, handling
189 inflation and deflation of columns appropriately.
190
191 =cut
192
193 sub new {
194   my ($class, $attrs, @rest) = @_;
195   $attrs ||= {};
196   foreach my $key (keys %$attrs) {
197     if (ref $attrs->{$key}
198           && exists $class->column_info($key)->{_inflate_info}) {
199       $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
200     }
201   }
202   return $class->next::method($attrs, @rest);
203 }
204
205 =head1 SEE ALSO
206
207 =over 4
208
209 =item L<DBIx::Class::Core> - This component is loaded as part of the
210       "core" L<DBIx::Class> components; generally there is no need to
211       load it directly
212
213 =back
214
215 =head1 AUTHOR
216
217 Matt S. Trout <mst@shadowcatsystems.co.uk>
218
219 =head1 CONTRIBUTORS
220
221 Daniel Westermann-Clark <danieltwc@cpan.org> (documentation)
222
223 =head1 LICENSE
224
225 You may distribute this code under the same terms as Perl itself.
226
227 =cut
228
229 1;