lib/DBIx/Class/FilterColumn.pm

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