lib/DBIx/Class/InflateColumn.pm

   1 package DBIx::Class::InflateColumn;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Row/;
   7
   8 =head1 NAME
   9
  10 DBIx::Class::InflateColumn - Automatically create references from column data
  11
  12 =head1 SYNOPSIS
  13
  14   # In your table classes
  15   __PACKAGE__->inflate_column('column_name', {
  16     inflate => sub {
  17       my ($raw_value_from_db, $result_object) = @_;
  18       ...
  19     },
  20     deflate => sub {
  21       my ($inflated_value_from_user, $result_object) = @_;
  22       ...
  23     },
  24   });
  25
  26 =head1 DESCRIPTION
  27
  28 This component translates column data into references, i.e. "inflating"
  29 the column data. It also "deflates" references into an appropriate format
  30 for the database.
  31
  32 It can be used, for example, to automatically convert to and from
  33 L<DateTime> objects for your date and time fields. There's a
  34 convenience component to actually do that though, try
  35 L<DBIx::Class::InflateColumn::DateTime>.
  36
  37 It will handle all types of references except scalar references. It
  38 will not handle scalar values, these are ignored and thus passed
  39 through to L<SQL::Abstract>. This is to allow setting raw values to
  40 "just work". Scalar references are passed through to the database to
  41 deal with, to allow such settings as C< \'year + 1'> and C< \'DEFAULT' >
  42 to work.
  43
  44 If you want to filter plain scalar values and replace them with
  45 something else, see L<DBIx::Class::FilterColumn>.
  46
  47 =head1 METHODS
  48
  49 =head2 inflate_column
  50
  51 Instruct L<DBIx::Class> to inflate the given column.
  52
  53 In addition to the column name, you must provide C<inflate> and
  54 C<deflate> methods. The C<inflate> method is called when you access
  55 the field, while the C<deflate> method is called when the field needs
  56 to used by the database.
  57
  58 For example, if you have a table C<events> with a timestamp field
  59 named C<insert_time>, you could inflate the column in the
  60 corresponding table class using something like:
  61
  62     __PACKAGE__->inflate_column('insert_time', {
  63         inflate => sub {
  64           my ($insert_time_raw_value, $event_result_object) = @_;
  65           DateTime->from_epoch( epoch => $insert_time_raw_value );
  66         },
  67         deflate => sub {
  68           my ($insert_time_dt_object, $event_result_object) = @_;
  69           $insert_time_dt_object->epoch;
  70         },
  71     });
  72
  73 The coderefs you set for inflate and deflate are called with two parameters,
  74 the first is the value of the column to be inflated/deflated, the second is
  75 the result object itself.
  76
  77 In this example, calls to an event's C<insert_time> accessor return a
  78 L<DateTime> object. This L<DateTime> object is later "deflated" back
  79 to the integer epoch representation when used in the database layer.
  80 For a much more thorough handling of the above example, please see
  81 L<DBIx::Class::DateTime::Epoch>
  82
  83 =cut
  84
  85 sub inflate_column {
  86   my ($self, $col, $attrs) = @_;
  87
  88   my $colinfo = $self->column_info($col);
  89
  90   $self->throw_exception("InflateColumn does not work with FilterColumn")
  91     if $self->isa('DBIx::Class::FilterColumn') &&
  92       defined $colinfo->{_filter_info};
  93
  94   $self->throw_exception("No such column $col to inflate")
  95     unless $self->has_column($col);
  96   $self->throw_exception("inflate_column needs attr hashref")
  97     unless ref $attrs eq 'HASH';
  98   $colinfo->{_inflate_info} = $attrs;
  99   my $acc = $colinfo->{accessor};
 100   $self->mk_group_accessors('inflated_column' => [ (defined $acc ? $acc : $col), $col]);
 101   return 1;
 102 }
 103
 104 sub _inflated_column {
 105   my ($self, $col, $value) = @_;
 106   return $value unless defined $value; # NULL is NULL is NULL
 107   my $info = $self->column_info($col)
 108     or $self->throw_exception("No column info for $col");
 109   return $value unless exists $info->{_inflate_info};
 110   my $inflate = $info->{_inflate_info}{inflate};
 111   $self->throw_exception("No inflator for $col") unless defined $inflate;
 112   return $inflate->($value, $self);
 113 }
 114
 115 sub _deflated_column {
 116   my ($self, $col, $value) = @_;
 117 #  return $value unless ref $value && blessed($value); # If it's not an object, don't touch it
 118   ## Leave scalar refs (ala SQL::Abstract literal SQL), untouched, deflate all other refs
 119   return $value unless (ref $value && ref($value) ne 'SCALAR');
 120   my $info = $self->column_info($col) or
 121     $self->throw_exception("No column info for $col");
 122   return $value unless exists $info->{_inflate_info};
 123   my $deflate = $info->{_inflate_info}{deflate};
 124   $self->throw_exception("No deflator for $col") unless defined $deflate;
 125   return $deflate->($value, $self);
 126 }
 127
 128 =head2 get_inflated_column
 129
 130   my $val = $obj->get_inflated_column($col);
 131
 132 Fetch a column value in its inflated state.  This is directly
 133 analogous to L<DBIx::Class::Row/get_column> in that it only fetches a
 134 column already retrieved from the database, and then inflates it.
 135 Throws an exception if the column requested is not an inflated column.
 136
 137 =cut
 138
 139 sub get_inflated_column {
 140   my ($self, $col) = @_;
 141   $self->throw_exception("$col is not an inflated column")
 142     unless exists $self->column_info($col)->{_inflate_info};
 143   return $self->{_inflated_column}{$col}
 144     if exists $self->{_inflated_column}{$col};
 145
 146   my $val = $self->get_column($col);
 147   return $val if ref $val eq 'SCALAR';  #that would be a not-yet-reloaded sclarref update
 148
 149   return $self->{_inflated_column}{$col} = $self->_inflated_column($col, $val);
 150 }
 151
 152 =head2 set_inflated_column
 153
 154   my $copy = $obj->set_inflated_column($col => $val);
 155
 156 Sets a column value from an inflated value.  This is directly
 157 analogous to L<DBIx::Class::Row/set_column>.
 158
 159 =cut
 160
 161 sub set_inflated_column {
 162   my ($self, $col, $inflated) = @_;
 163   $self->set_column($col, $self->_deflated_column($col, $inflated));
 164 #  if (blessed $inflated) {
 165   if (ref $inflated && ref($inflated) ne 'SCALAR') {
 166     $self->{_inflated_column}{$col} = $inflated;
 167   } else {
 168     delete $self->{_inflated_column}{$col};
 169   }
 170   return $inflated;
 171 }
 172
 173 =head2 store_inflated_column
 174
 175   my $copy = $obj->store_inflated_column($col => $val);
 176
 177 Sets a column value from an inflated value without marking the column
 178 as dirty. This is directly analogous to L<DBIx::Class::Row/store_column>.
 179
 180 =cut
 181
 182 sub store_inflated_column {
 183   my ($self, $col, $inflated) = @_;
 184 #  unless (blessed $inflated) {
 185   unless (ref $inflated && ref($inflated) ne 'SCALAR') {
 186       delete $self->{_inflated_column}{$col};
 187       $self->store_column($col => $inflated);
 188       return $inflated;
 189   }
 190   delete $self->{_column_data}{$col};
 191   return $self->{_inflated_column}{$col} = $inflated;
 192 }
 193
 194 =head1 SEE ALSO
 195
 196 =over 4
 197
 198 =item L<DBIx::Class::Core> - This component is loaded as part of the
 199       C<core> L<DBIx::Class> components; generally there is no need to
 200       load it directly
 201
 202 =back
 203
 204 =head1 AUTHOR
 205
 206 Matt S. Trout <mst@shadowcatsystems.co.uk>
 207
 208 =head1 CONTRIBUTORS
 209
 210 Daniel Westermann-Clark <danieltwc@cpan.org> (documentation)
 211
 212 Jess Robinson <cpan@desert-island.demon.co.uk>
 213
 214 =head1 LICENSE
 215
 216 You may distribute this code under the same terms as Perl itself.
 217
 218 =cut
 219
 220 1;