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->result_source_instance->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->result_source_instance->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   ! exists $self->{_column_data}{$col}
  82     and
  83   exists $self->{_filtered_column}{$col}
  84     and
  85   $self->{_column_data}{$col} = $self->_column_to_storage (
  86     $col, $self->{_filtered_column}{$col}
  87   );
  88
  89   return $self->next::method ($col);
  90 }
  91
  92 # sadly a separate codepath in Row.pm ( used by insert() )
  93 sub get_columns {
  94   my $self = shift;
  95
  96   $self->{_column_data}{$_} = $self->_column_to_storage (
  97     $_, $self->{_filtered_column}{$_}
  98   ) for grep
  99     { ! exists $self->{_column_data}{$_} }
 100     keys %{$self->{_filtered_column}||{}}
 101   ;
 102
 103   $self->next::method (@_);
 104 }
 105
 106 # and *another* separate codepath, argh!
 107 sub get_dirty_columns {
 108   my $self = shift;
 109
 110   $self->{_dirty_columns}{$_}
 111     and
 112   ! exists $self->{_column_data}{$_}
 113     and
 114   $self->{_column_data}{$_} = $self->_column_to_storage (
 115     $_, $self->{_filtered_column}{$_}
 116   )
 117     for keys %{$self->{_filtered_column}||{}};
 118
 119   $self->next::method(@_);
 120 }
 121
 122 sub store_column {
 123   my ($self, $col) = (shift, @_);
 124
 125   # blow cache
 126   delete $self->{_filtered_column}{$col};
 127
 128   $self->next::method(@_);
 129 }
 130
 131 sub has_column_loaded {
 132   my ($self, $col) = @_;
 133   return 1 if exists $self->{_filtered_column}{$col};
 134   return $self->next::method($col);
 135 }
 136
 137 sub set_filtered_column {
 138   my ($self, $col, $filtered) = @_;
 139
 140   # unlike IC, FC does not need to deal with the 'filter' abomination
 141   # thus we can short-curcuit filtering entirely and never call set_column
 142   # in case this is already a dirty change OR the row never touched storage
 143   if (
 144     ! $self->in_storage
 145       or
 146     $self->is_column_changed($col)
 147   ) {
 148     $self->make_column_dirty($col);
 149     delete $self->{_column_data}{$col};
 150   }
 151   else {
 152     $self->set_column($col, $self->_column_to_storage($col, $filtered));
 153   };
 154
 155   return $self->{_filtered_column}{$col} = $filtered;
 156 }
 157
 158 sub update {
 159   my ($self, $data, @rest) = @_;
 160
 161   my $colinfos = $self->result_source->columns_info;
 162
 163   foreach my $col (keys %{$data||{}}) {
 164     if ( exists $colinfos->{$col}{_filter_info} ) {
 165       $self->set_filtered_column($col, delete $data->{$col});
 166
 167       # FIXME update() reaches directly into the object-hash
 168       # and we may *not* have a filtered value there - thus
 169       # the void-ctx filter-trigger
 170       $self->get_column($col) unless exists $self->{_column_data}{$col};
 171     }
 172   }
 173
 174   return $self->next::method($data, @rest);
 175 }
 176
 177 sub new {
 178   my ($class, $data, @rest) = @_;
 179
 180   my $rsrc = $data->{-result_source}
 181     or $class->throw_exception('Sourceless rows are not supported with DBIx::Class::FilterColumn');
 182
 183   my $obj = $class->next::method($data, @rest);
 184
 185   my $colinfos = $rsrc->columns_info;
 186
 187   foreach my $col (keys %{$data||{}}) {
 188     if (exists $colinfos->{$col}{_filter_info} ) {
 189       $obj->set_filtered_column($col, $data->{$col});
 190     }
 191   }
 192
 193   return $obj;
 194 }
 195
 196 1;
 197
 198 __END__
 199
 200 =head1 NAME
 201
 202 DBIx::Class::FilterColumn - Automatically convert column data
 203
 204 =head1 SYNOPSIS
 205
 206 In your Schema or DB class add "FilterColumn" to the top of the component list.
 207
 208   __PACKAGE__->load_components(qw( FilterColumn ... ));
 209
 210 Set up filters for the columns you want to convert.
 211
 212  __PACKAGE__->filter_column( money => {
 213      filter_to_storage => 'to_pennies',
 214      filter_from_storage => 'from_pennies',
 215  });
 216
 217  sub to_pennies   { $_[1] * 100 }
 218
 219  sub from_pennies { $_[1] / 100 }
 220
 221  1;
 222
 223
 224 =head1 DESCRIPTION
 225
 226 This component is meant to be a more powerful, but less DWIM-y,
 227 L<DBIx::Class::InflateColumn>.  One of the major issues with said component is
 228 that it B<only> works with references.  Generally speaking anything that can
 229 be done with L<DBIx::Class::InflateColumn> can be done with this component.
 230
 231 =head1 METHODS
 232
 233 =head2 filter_column
 234
 235  __PACKAGE__->filter_column( colname => {
 236      filter_from_storage => 'method'|\&coderef,
 237      filter_to_storage   => 'method'|\&coderef,
 238  })
 239
 240 This is the method that you need to call to set up a filtered column. It takes
 241 exactly two arguments; the first being the column name the second being a hash
 242 reference with C<filter_from_storage> and C<filter_to_storage> set to either
 243 a method name or a code reference. In either case the filter is invoked as:
 244
 245   $result->$filter_specification ($value_to_filter)
 246
 247 with C<$filter_specification> being chosen depending on whether the
 248 C<$value_to_filter> is being retrieved from or written to permanent
 249 storage.
 250
 251 If a specific directional filter is not specified, the original value will be
 252 passed to/from storage unfiltered.
 253
 254 =head2 get_filtered_column
 255
 256  $obj->get_filtered_column('colname')
 257
 258 Returns the filtered value of the column
 259
 260 =head2 set_filtered_column
 261
 262  $obj->set_filtered_column(colname => 'new_value')
 263
 264 Sets the filtered value of the column
 265
 266 =head1 EXAMPLE OF USE
 267
 268 Some databases have restrictions on values that can be passed to
 269 boolean columns, and problems can be caused by passing value that
 270 perl considers to be false (such as C<undef>).
 271
 272 One solution to this is to ensure that the boolean values are set
 273 to something that the database can handle - such as numeric zero
 274 and one, using code like this:-
 275
 276     __PACKAGE__->filter_column(
 277         my_boolean_column => {
 278             filter_to_storage   => sub { $_[1] ? 1 : 0 },
 279         }
 280     );
 281
 282 In this case the C<filter_from_storage> is not required, as just
 283 passing the database value through to perl does the right thing.
 284
 285 =head1 FURTHER QUESTIONS?
 286
 287 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 288
 289 =head1 COPYRIGHT AND LICENSE
 290
 291 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 292 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 293 redistribute it and/or modify it under the same terms as the
 294 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.