Commit | Line | Data |
51bec050 |
1 | package DBIx::Class::FilterColumn; |
51bec050 |
2 | use strict; |
3 | use warnings; |
4 | |
a524980e |
5 | use base 'DBIx::Class::Row'; |
b5ce6748 |
6 | use SQL::Abstract 'is_literal_value'; |
a524980e |
7 | use namespace::clean; |
51bec050 |
8 | |
9 | sub filter_column { |
10 | my ($self, $col, $attrs) = @_; |
11 | |
e5053694 |
12 | my $colinfo = $self->result_source_instance->column_info($col); |
52416317 |
13 | |
85aee309 |
14 | $self->throw_exception("FilterColumn can not be used on a column with a declared InflateColumn inflator") |
15 | if defined $colinfo->{_inflate_info} and $self->isa('DBIx::Class::InflateColumn'); |
c227b295 |
16 | |
51bec050 |
17 | $self->throw_exception("No such column $col to filter") |
e5053694 |
18 | unless $self->result_source_instance->has_column($col); |
51bec050 |
19 | |
eec182b6 |
20 | $self->throw_exception('filter_column expects a hashref of filter specifications') |
51bec050 |
21 | unless ref $attrs eq 'HASH'; |
22 | |
eec182b6 |
23 | $self->throw_exception('An invocation of filter_column() must specify either a filter_from_storage or filter_to_storage') |
24 | unless $attrs->{filter_from_storage} || $attrs->{filter_to_storage}; |
25 | |
52416317 |
26 | $colinfo->{_filter_info} = $attrs; |
27 | my $acc = $colinfo->{accessor}; |
d7d38bef |
28 | $self->mk_group_accessors(filtered_column => [ (defined $acc ? $acc : $col), $col]); |
51bec050 |
29 | return 1; |
30 | } |
31 | |
4c0c3038 |
32 | sub _column_from_storage { |
9b2c0de6 |
33 | my ($self, $col, $value) = @_; |
51bec050 |
34 | |
cfa1ab03 |
35 | return $value if is_literal_value($value); |
51bec050 |
36 | |
4006691d |
37 | my $info = $self->result_source->column_info($col) |
51bec050 |
38 | or $self->throw_exception("No column info for $col"); |
39 | |
40 | return $value unless exists $info->{_filter_info}; |
41 | |
d7d38bef |
42 | my $filter = $info->{_filter_info}{filter_from_storage}; |
51bec050 |
43 | |
eec182b6 |
44 | return defined $filter ? $self->$filter($value) : $value; |
51bec050 |
45 | } |
46 | |
4c0c3038 |
47 | sub _column_to_storage { |
9b2c0de6 |
48 | my ($self, $col, $value) = @_; |
51bec050 |
49 | |
a524980e |
50 | return $value if is_literal_value($value); |
51 | |
4006691d |
52 | my $info = $self->result_source->column_info($col) or |
51bec050 |
53 | $self->throw_exception("No column info for $col"); |
54 | |
55 | return $value unless exists $info->{_filter_info}; |
56 | |
d7d38bef |
57 | my $unfilter = $info->{_filter_info}{filter_to_storage}; |
eec182b6 |
58 | |
59 | return defined $unfilter ? $self->$unfilter($value) : $value; |
51bec050 |
60 | } |
61 | |
d7d38bef |
62 | sub get_filtered_column { |
51bec050 |
63 | my ($self, $col) = @_; |
64 | |
65 | $self->throw_exception("$col is not a filtered column") |
4006691d |
66 | unless exists $self->result_source->column_info($col)->{_filter_info}; |
51bec050 |
67 | |
68 | return $self->{_filtered_column}{$col} |
69 | if exists $self->{_filtered_column}{$col}; |
70 | |
71 | my $val = $self->get_column($col); |
72 | |
5ae153d7 |
73 | return $self->{_filtered_column}{$col} = $self->_column_from_storage( |
74 | $col, $val |
75 | ); |
51bec050 |
76 | } |
77 | |
491c8ff9 |
78 | sub get_column { |
79 | my ($self, $col) = @_; |
dc6dadae |
80 | |
b482a095 |
81 | ! exists $self->{_column_data}{$col} |
82 | and |
83 | exists $self->{_filtered_column}{$col} |
84 | and |
85 | $self->{_column_data}{$col} = $self->_column_to_storage ( |
86 | $col, $self->{_filtered_column}{$col} |
87 | ); |
491c8ff9 |
88 | |
89 | return $self->next::method ($col); |
90 | } |
91 | |
92 | # sadly a separate codepath in Row.pm ( used by insert() ) |
93 | sub get_columns { |
94 | my $self = shift; |
95 | |
dc6dadae |
96 | $self->{_column_data}{$_} = $self->_column_to_storage ( |
97 | $_, $self->{_filtered_column}{$_} |
98 | ) for grep |
99 | { ! exists $self->{_column_data}{$_} } |
100 | keys %{$self->{_filtered_column}||{}} |
101 | ; |
491c8ff9 |
102 | |
103 | $self->next::method (@_); |
104 | } |
105 | |
b482a095 |
106 | # and *another* separate codepath, argh! |
107 | sub get_dirty_columns { |
108 | my $self = shift; |
109 | |
110 | $self->{_dirty_columns}{$_} |
111 | and |
112 | ! exists $self->{_column_data}{$_} |
113 | and |
114 | $self->{_column_data}{$_} = $self->_column_to_storage ( |
115 | $_, $self->{_filtered_column}{$_} |
116 | ) |
117 | for keys %{$self->{_filtered_column}||{}}; |
118 | |
119 | $self->next::method(@_); |
120 | } |
121 | |
491c8ff9 |
122 | sub store_column { |
85439e0c |
123 | my ($self, $col) = (shift, @_); |
124 | |
125 | # blow cache |
126 | delete $self->{_filtered_column}{$col}; |
127 | |
128 | $self->next::method(@_); |
129 | } |
130 | |
dc6dadae |
131 | sub has_column_loaded { |
132 | my ($self, $col) = @_; |
133 | return 1 if exists $self->{_filtered_column}{$col}; |
134 | return $self->next::method($col); |
135 | } |
136 | |
d7d38bef |
137 | sub set_filtered_column { |
51bec050 |
138 | my ($self, $col, $filtered) = @_; |
139 | |
dc6dadae |
140 | # unlike IC, FC does not need to deal with the 'filter' abomination |
141 | # thus we can short-curcuit filtering entirely and never call set_column |
142 | # in case this is already a dirty change OR the row never touched storage |
143 | if ( |
144 | ! $self->in_storage |
145 | or |
146 | $self->is_column_changed($col) |
147 | ) { |
148 | $self->make_column_dirty($col); |
149 | delete $self->{_column_data}{$col}; |
cde96798 |
150 | } |
dc6dadae |
151 | else { |
152 | $self->set_column($col, $self->_column_to_storage($col, $filtered)); |
153 | }; |
51bec050 |
154 | |
491c8ff9 |
155 | return $self->{_filtered_column}{$col} = $filtered; |
51bec050 |
156 | } |
157 | |
7b461f8a |
158 | sub update { |
5ae153d7 |
159 | my ($self, $data, @rest) = @_; |
491c8ff9 |
160 | |
4006691d |
161 | my $colinfos = $self->result_source->columns_info; |
162 | |
5ae153d7 |
163 | foreach my $col (keys %{$data||{}}) { |
4006691d |
164 | if ( exists $colinfos->{$col}{_filter_info} ) { |
5ae153d7 |
165 | $self->set_filtered_column($col, delete $data->{$col}); |
7c6fa77f |
166 | |
167 | # FIXME update() reaches directly into the object-hash |
168 | # and we may *not* have a filtered value there - thus |
169 | # the void-ctx filter-trigger |
5ae153d7 |
170 | $self->get_column($col) unless exists $self->{_column_data}{$col}; |
7b461f8a |
171 | } |
172 | } |
491c8ff9 |
173 | |
5ae153d7 |
174 | return $self->next::method($data, @rest); |
7b461f8a |
175 | } |
176 | |
7b461f8a |
177 | sub new { |
5ae153d7 |
178 | my ($class, $data, @rest) = @_; |
4006691d |
179 | |
180 | my $rsrc = $data->{-result_source} |
d9ea6d6d |
181 | or $class->throw_exception('Sourceless rows are not supported with DBIx::Class::FilterColumn'); |
182 | |
5ae153d7 |
183 | my $obj = $class->next::method($data, @rest); |
184 | |
4006691d |
185 | my $colinfos = $rsrc->columns_info; |
186 | |
5ae153d7 |
187 | foreach my $col (keys %{$data||{}}) { |
4006691d |
188 | if (exists $colinfos->{$col}{_filter_info} ) { |
5ae153d7 |
189 | $obj->set_filtered_column($col, $data->{$col}); |
7b461f8a |
190 | } |
191 | } |
491c8ff9 |
192 | |
7b461f8a |
193 | return $obj; |
194 | } |
195 | |
51bec050 |
196 | 1; |
22d9e05a |
197 | |
a2bd3796 |
198 | __END__ |
199 | |
9b2c0de6 |
200 | =head1 NAME |
22d9e05a |
201 | |
9b2c0de6 |
202 | DBIx::Class::FilterColumn - Automatically convert column data |
203 | |
204 | =head1 SYNOPSIS |
205 | |
f10a2e9a |
206 | In your Schema or DB class add "FilterColumn" to the top of the component list. |
207 | |
208 | __PACKAGE__->load_components(qw( FilterColumn ... )); |
209 | |
210 | Set up filters for the columns you want to convert. |
211 | |
9b2c0de6 |
212 | __PACKAGE__->filter_column( money => { |
213 | filter_to_storage => 'to_pennies', |
214 | filter_from_storage => 'from_pennies', |
215 | }); |
22d9e05a |
216 | |
217 | sub to_pennies { $_[1] * 100 } |
9b2c0de6 |
218 | |
22d9e05a |
219 | sub from_pennies { $_[1] / 100 } |
220 | |
221 | 1; |
222 | |
f10a2e9a |
223 | |
9b2c0de6 |
224 | =head1 DESCRIPTION |
22d9e05a |
225 | |
9b2c0de6 |
226 | This component is meant to be a more powerful, but less DWIM-y, |
227 | L<DBIx::Class::InflateColumn>. One of the major issues with said component is |
228 | that it B<only> works with references. Generally speaking anything that can |
229 | be done with L<DBIx::Class::InflateColumn> can be done with this component. |
22d9e05a |
230 | |
9b2c0de6 |
231 | =head1 METHODS |
22d9e05a |
232 | |
9b2c0de6 |
233 | =head2 filter_column |
22d9e05a |
234 | |
9b2c0de6 |
235 | __PACKAGE__->filter_column( colname => { |
eec182b6 |
236 | filter_from_storage => 'method'|\&coderef, |
237 | filter_to_storage => 'method'|\&coderef, |
9b2c0de6 |
238 | }) |
22d9e05a |
239 | |
eec182b6 |
240 | This is the method that you need to call to set up a filtered column. It takes |
241 | exactly two arguments; the first being the column name the second being a hash |
242 | reference with C<filter_from_storage> and C<filter_to_storage> set to either |
243 | a method name or a code reference. In either case the filter is invoked as: |
244 | |
47d7b769 |
245 | $result->$filter_specification ($value_to_filter) |
eec182b6 |
246 | |
247 | with C<$filter_specification> being chosen depending on whether the |
248 | C<$value_to_filter> is being retrieved from or written to permanent |
249 | storage. |
250 | |
251 | If a specific directional filter is not specified, the original value will be |
252 | passed to/from storage unfiltered. |
22d9e05a |
253 | |
9b2c0de6 |
254 | =head2 get_filtered_column |
22d9e05a |
255 | |
9b2c0de6 |
256 | $obj->get_filtered_column('colname') |
257 | |
258 | Returns the filtered value of the column |
259 | |
260 | =head2 set_filtered_column |
261 | |
262 | $obj->set_filtered_column(colname => 'new_value') |
263 | |
264 | Sets the filtered value of the column |
eec182b6 |
265 | |
266 | =head1 EXAMPLE OF USE |
267 | |
268 | Some databases have restrictions on values that can be passed to |
269 | boolean columns, and problems can be caused by passing value that |
270 | perl considers to be false (such as C<undef>). |
271 | |
272 | One solution to this is to ensure that the boolean values are set |
273 | to something that the database can handle - such as numeric zero |
274 | and one, using code like this:- |
275 | |
276 | __PACKAGE__->filter_column( |
277 | my_boolean_column => { |
278 | filter_to_storage => sub { $_[1] ? 1 : 0 }, |
279 | } |
280 | ); |
281 | |
282 | In this case the C<filter_from_storage> is not required, as just |
283 | passing the database value through to perl does the right thing. |
a2bd3796 |
284 | |
285 | =head1 FURTHER QUESTIONS? |
286 | |
287 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
288 | |
289 | =head1 COPYRIGHT AND LICENSE |
290 | |
291 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
292 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
293 | redistribute it and/or modify it under the same terms as the |
294 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |