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