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