lib/DBIx/Class/FilterColumn.pm

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