lib/DBIx/Class/FilterColumn.pm

   1 package DBIx::Class::FilterColumn;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Row/;
   7
   8 sub filter_column {
   9   my ($self, $col, $attrs) = @_;
  10
  11   $self->throw_exception("No such column $col to filter")
  12     unless $self->has_column($col);
  13
  14   $self->throw_exception("filter_column needs attr hashref")
  15     unless ref $attrs eq 'HASH';
  16
  17   $self->column_info($col)->{_filter_info} = $attrs;
  18   my $acc = $self->column_info($col)->{accessor};
  19   $self->mk_group_accessors('value' => [ (defined $acc ? $acc : $col), $col]);
  20   return 1;
  21 }
  22
  23 sub _filtered_column {
  24   my ($self, $col, $value) = @_;
  25
  26   return $value unless defined $value;
  27
  28   my $info = $self->column_info($col)
  29     or $self->throw_exception("No column info for $col");
  30
  31   return $value unless exists $info->{_filter_info};
  32
  33   my $filter = $info->{_filter_info}{filter};
  34   $self->throw_exception("No inflator for $col") unless defined $filter;
  35
  36   return $self->$filter($value);
  37 }
  38
  39 sub _unfiltered_column {
  40   my ($self, $col, $value) = @_;
  41
  42   my $info = $self->column_info($col) or
  43     $self->throw_exception("No column info for $col");
  44
  45   return $value unless exists $info->{_filter_info};
  46
  47   my $unfilter = $info->{_filter_info}{unfilter};
  48   $self->throw_exception("No unfilter for $col") unless defined $unfilter;
  49   return $self->$unfilter($value);
  50 }
  51
  52 sub get_value {
  53   my ($self, $col) = @_;
  54
  55   $self->throw_exception("$col is not a filtered column")
  56     unless exists $self->column_info($col)->{_filter_info};
  57
  58   return $self->{_filtered_column}{$col}
  59     if exists $self->{_filtered_column}{$col};
  60
  61   my $val = $self->get_column($col);
  62
  63   return $self->{_filtered_column}{$col} = $self->_filtered_column($col, $val);
  64 }
  65
  66 sub set_value {
  67   my ($self, $col, $filtered) = @_;
  68
  69   $self->set_column($col, $self->_unfiltered_column($col, $filtered));
  70
  71   delete $self->{_filtered_column}{$col};
  72
  73   return $filtered;
  74 }
  75
  76 1;