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