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->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->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->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   foreach my $col (keys %{$data||{}}) {
 144     if (
 145       $self->has_column($col)
 146         &&
 147       exists $self->column_info($col)->{_filter_info}
 148     ) {
 149       $self->set_filtered_column($col, delete $data->{$col});
 150
 151       # FIXME update() reaches directly into the object-hash
 152       # and we may *not* have a filtered value there - thus
 153       # the void-ctx filter-trigger
 154       $self->get_column($col) unless exists $self->{_column_data}{$col};
 155     }
 156   }
 157
 158   return $self->next::method($data, @rest);
 159 }
 160
 161 sub new {
 162   my ($class, $data, @rest) = @_;
 163   my $source = $data->{-result_source}
 164     or $class->throw_exception('Sourceless rows are not supported with DBIx::Class::FilterColumn');
 165
 166   my $obj = $class->next::method($data, @rest);
 167
 168   foreach my $col (keys %{$data||{}}) {
 169     if ($obj->has_column($col) &&
 170           exists $obj->column_info($col)->{_filter_info} ) {
 171       $obj->set_filtered_column($col, $data->{$col});
 172     }
 173   }
 174
 175   return $obj;
 176 }
 177
 178 1;
 179
 180 =head1 NAME
 181
 182 DBIx::Class::FilterColumn - Automatically convert column data
 183
 184 =head1 SYNOPSIS
 185
 186 In your Schema or DB class add "FilterColumn" to the top of the component list.
 187
 188   __PACKAGE__->load_components(qw( FilterColumn ... ));
 189
 190 Set up filters for the columns you want to convert.
 191
 192  __PACKAGE__->filter_column( money => {
 193      filter_to_storage => 'to_pennies',
 194      filter_from_storage => 'from_pennies',
 195  });
 196
 197  sub to_pennies   { $_[1] * 100 }
 198
 199  sub from_pennies { $_[1] / 100 }
 200
 201  1;
 202
 203
 204 =head1 DESCRIPTION
 205
 206 This component is meant to be a more powerful, but less DWIM-y,
 207 L<DBIx::Class::InflateColumn>.  One of the major issues with said component is
 208 that it B<only> works with references.  Generally speaking anything that can
 209 be done with L<DBIx::Class::InflateColumn> can be done with this component.
 210
 211 =head1 METHODS
 212
 213 =head2 filter_column
 214
 215  __PACKAGE__->filter_column( colname => {
 216      filter_from_storage => 'method'|\&coderef,
 217      filter_to_storage   => 'method'|\&coderef,
 218  })
 219
 220 This is the method that you need to call to set up a filtered column. It takes
 221 exactly two arguments; the first being the column name the second being a hash
 222 reference with C<filter_from_storage> and C<filter_to_storage> set to either
 223 a method name or a code reference. In either case the filter is invoked as:
 224
 225   $result->$filter_specification ($value_to_filter)
 226
 227 with C<$filter_specification> being chosen depending on whether the
 228 C<$value_to_filter> is being retrieved from or written to permanent
 229 storage.
 230
 231 If a specific directional filter is not specified, the original value will be
 232 passed to/from storage unfiltered.
 233
 234 =head2 get_filtered_column
 235
 236  $obj->get_filtered_column('colname')
 237
 238 Returns the filtered value of the column
 239
 240 =head2 set_filtered_column
 241
 242  $obj->set_filtered_column(colname => 'new_value')
 243
 244 Sets the filtered value of the column
 245
 246 =head1 EXAMPLE OF USE
 247
 248 Some databases have restrictions on values that can be passed to
 249 boolean columns, and problems can be caused by passing value that
 250 perl considers to be false (such as C<undef>).
 251
 252 One solution to this is to ensure that the boolean values are set
 253 to something that the database can handle - such as numeric zero
 254 and one, using code like this:-
 255
 256     __PACKAGE__->filter_column(
 257         my_boolean_column => {
 258             filter_to_storage   => sub { $_[1] ? 1 : 0 },
 259         }
 260     );
 261
 262 In this case the C<filter_from_storage> is not required, as just
 263 passing the database value through to perl does the right thing.