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   $self->throw_exception("FilterColumn does not work with InflateColumn")
  11     if $self->isa('DBIx::Class::InflateColumn') &&
  12       defined $self->column_info($col)->{_inflate_info};
  13
  14   $self->throw_exception("No such column $col to filter")
  15     unless $self->has_column($col);
  16
  17   $self->throw_exception("filter_column needs attr hashref")
  18     unless ref $attrs eq 'HASH';
  19
  20   $self->column_info($col)->{_filter_info} = $attrs;
  21   my $acc = $self->column_info($col)->{accessor};
  22   $self->mk_group_accessors(filtered_column => [ (defined $acc ? $acc : $col), $col]);
  23   return 1;
  24 }
  25
  26 sub _column_from_storage {
  27   my ($self, $col, $value) = @_;
  28
  29   return $value unless defined $value;
  30
  31   my $info = $self->column_info($col)
  32     or $self->throw_exception("No column info for $col");
  33
  34   return $value unless exists $info->{_filter_info};
  35
  36   my $filter = $info->{_filter_info}{filter_from_storage};
  37   $self->throw_exception("No filter for $col") unless defined $filter;
  38
  39   return $self->$filter($value);
  40 }
  41
  42 sub _column_to_storage {
  43   my ($self, $col, $value) = @_;
  44
  45   my $info = $self->column_info($col) or
  46     $self->throw_exception("No column info for $col");
  47
  48   return $value unless exists $info->{_filter_info};
  49
  50   my $unfilter = $info->{_filter_info}{filter_to_storage};
  51   $self->throw_exception("No unfilter for $col") unless defined $unfilter;
  52   return $self->$unfilter($value);
  53 }
  54
  55 sub get_filtered_column {
  56   my ($self, $col) = @_;
  57
  58   $self->throw_exception("$col is not a filtered column")
  59     unless exists $self->column_info($col)->{_filter_info};
  60
  61   return $self->{_filtered_column}{$col}
  62     if exists $self->{_filtered_column}{$col};
  63
  64   my $val = $self->get_column($col);
  65
  66   return $self->{_filtered_column}{$col} = $self->_column_from_storage($col, $val);
  67 }
  68
  69 sub get_column {
  70   my ($self, $col) = @_;
  71   if (exists $self->{_filtered_column}{$col}) {
  72     return $self->{_column_data}{$col} ||= $self->_column_to_storage ($col, $self->{_filtered_column}{$col});
  73   }
  74
  75   return $self->next::method ($col);
  76 }
  77
  78 # sadly a separate codepath in Row.pm ( used by insert() )
  79 sub get_columns {
  80   my $self = shift;
  81
  82   foreach my $col (keys %{$self->{_filtered_column}||{}}) {
  83     $self->{_column_data}{$col} ||= $self->_column_to_storage ($col, $self->{_filtered_column}{$col})
  84       if exists $self->{_filtered_column}{$col};
  85   }
  86
  87   $self->next::method (@_);
  88 }
  89
  90 sub store_column {
  91   my ($self, $col) = (shift, @_);
  92
  93   # blow cache
  94   delete $self->{_filtered_column}{$col};
  95
  96   $self->next::method(@_);
  97 }
  98
  99 sub set_filtered_column {
 100   my ($self, $col, $filtered) = @_;
 101
 102   # do not blow up the cache via set_column unless necessary
 103   # (filtering may be expensive!)
 104   if (exists $self->{_filtered_column}{$col}) {
 105     return $filtered
 106       if ($self->_eq_column_values ($col, $filtered, $self->{_filtered_column}{$col} ) );
 107
 108     $self->make_column_dirty ($col); # so the comparison won't run again
 109   }
 110
 111   $self->set_column($col, $self->_column_to_storage($col, $filtered));
 112
 113   return $self->{_filtered_column}{$col} = $filtered;
 114 }
 115
 116 sub update {
 117   my ($self, $attrs, @rest) = @_;
 118
 119   foreach my $key (keys %{$attrs||{}}) {
 120     if (
 121       $self->has_column($key)
 122         &&
 123       exists $self->column_info($key)->{_filter_info}
 124     ) {
 125       $self->set_filtered_column($key, delete $attrs->{$key});
 126
 127       # FIXME update() reaches directly into the object-hash
 128       # and we may *not* have a filtered value there - thus
 129       # the void-ctx filter-trigger
 130       $self->get_column($key) unless exists $self->{_column_data}{$key};
 131     }
 132   }
 133
 134   return $self->next::method($attrs, @rest);
 135 }
 136
 137 sub new {
 138   my ($class, $attrs, @rest) = @_;
 139   my $source = $attrs->{-result_source}
 140     or $class->throw_exception('Sourceless rows are not supported with DBIx::Class::FilterColumn');
 141
 142   my $obj = $class->next::method($attrs, @rest);
 143   foreach my $key (keys %{$attrs||{}}) {
 144     if ($obj->has_column($key) &&
 145           exists $obj->column_info($key)->{_filter_info} ) {
 146       $obj->set_filtered_column($key, $attrs->{$key});
 147     }
 148   }
 149
 150   return $obj;
 151 }
 152
 153 1;
 154
 155 =head1 NAME
 156
 157 DBIx::Class::FilterColumn - Automatically convert column data
 158
 159 =head1 SYNOPSIS
 160
 161  # In your result classes
 162  __PACKAGE__->filter_column( money => {
 163      filter_to_storage => 'to_pennies',
 164      filter_from_storage => 'from_pennies',
 165  });
 166
 167  sub to_pennies   { $_[1] * 100 }
 168
 169  sub from_pennies { $_[1] / 100 }
 170
 171  1;
 172
 173 =head1 DESCRIPTION
 174
 175 This component is meant to be a more powerful, but less DWIM-y,
 176 L<DBIx::Class::InflateColumn>.  One of the major issues with said component is
 177 that it B<only> works with references.  Generally speaking anything that can
 178 be done with L<DBIx::Class::InflateColumn> can be done with this component.
 179
 180 =head1 METHODS
 181
 182 =head2 filter_column
 183
 184  __PACKAGE__->filter_column( colname => {
 185      filter_from_storage => 'method',
 186      filter_to_storage   => 'method',
 187  })
 188
 189 This is the method that you need to call to set up a filtered column.  It takes
 190 exactly two arguments; the first being the column name the second being a
 191 C<HashRef> with C<filter_from_storage> and C<filter_to_storage> having
 192 something that can be called as a method.  The method will be called with
 193 the value of the column as the first non-C<$self> argument.
 194
 195 =head2 get_filtered_column
 196
 197  $obj->get_filtered_column('colname')
 198
 199 Returns the filtered value of the column
 200
 201 =head2 set_filtered_column
 202
 203  $obj->set_filtered_column(colname => 'new_value')
 204
 205 Sets the filtered value of the column