X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FInflateColumn.pm;h=226913a555383d643cf1cad3e861a7df3a995426;hb=6d701f86fb5c2681cf99ff64cc6c42000376b675;hp=5c7f91450f6d6cb6e02fb5422fe2d09d7d305f95;hpb=fef421d0f2df20e7ac3001b30ed8a3c34d0766a9;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index 5c7f914..226913a 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -3,11 +3,64 @@ package DBIx::Class::InflateColumn; use strict; use warnings; + +use base qw/DBIx::Class::Row/; + +=head1 NAME + +DBIx::Class::InflateColumn - Automatically create objects from column data + +=head1 SYNOPSIS + + # In your table classes + __PACKAGE__->inflate_column('column_name', { + inflate => sub { ... }, + deflate => sub { ... }, + }); + +=head1 DESCRIPTION + +This component translates column data into objects, i.e. "inflating" +the column data. It also "deflates" objects into an appropriate format +for the database. + +It can be used, for example, to automatically convert to and from +L objects for your date and time fields. + +=head1 METHODS + +=head2 inflate_column + +Instruct L to inflate the given column. + +In addition to the column name, you must provide C and +C methods. The C method is called when you access +the field, while the C method is called when the field needs +to used by the database. + +For example, if you have a table C with a timestamp field +named C, you could inflate the column in the +corresponding table class using something like: + + __PACKAGE__->inflate_column('insert_time', { + inflate => sub { DateTime::Format::Pg->parse_datetime(shift); }, + deflate => sub { DateTime::Format::Pg->format_datetime(shift); }, + }); + +(Replace L with the appropriate module for your +database, or consider L.) + +In this example, calls to an event's C accessor return a +L object. This L object is later "deflated" when +used in the database layer. + +=cut + sub inflate_column { my ($self, $col, $attrs) = @_; - die "No such column $col to inflate" unless exists $self->_columns->{$col}; - die "inflate_column needs attr hashref" unless ref $attrs eq 'HASH'; - $self->_columns->{$col}{_inflate_info} = $attrs; + $self->throw_exception("No such column $col to inflate") unless $self->has_column($col); + $self->throw_exception("inflate_column needs attr hashref") unless ref $attrs eq 'HASH'; + $self->column_info($col)->{_inflate_info} = $attrs; $self->mk_group_accessors('inflated_column' => $col); return 1; } @@ -15,25 +68,27 @@ sub inflate_column { sub _inflated_column { my ($self, $col, $value) = @_; return $value unless defined $value; # NULL is NULL is NULL - return $value unless exists $self->_columns->{$col}{_inflate_info}; - return $value unless exists $self->_columns->{$col}{_inflate_info}{inflate}; - my $inflate = $self->_columns->{$col}{_inflate_info}{inflate}; + my $info = $self->column_info($col) || $self->throw_exception("No column info for $col"); + return $value unless exists $info->{_inflate_info}; + my $inflate = $info->{_inflate_info}{inflate}; + $self->throw_exception("No inflator for $col") unless defined $inflate; return $inflate->($value, $self); } sub _deflated_column { my ($self, $col, $value) = @_; return $value unless ref $value; # If it's not an object, don't touch it - return $value unless exists $self->_columns->{$col}{_inflate_info}; - return $value unless exists $self->_columns->{$col}{_inflate_info}{deflate}; - my $deflate = $self->_columns->{$col}{_inflate_info}{deflate}; + my $info = $self->column_info($col) || $self->throw_exception("No column info for $col"); + return $value unless exists $info->{_inflate_info}; + my $deflate = $info->{_inflate_info}{deflate}; + $self->throw_exception("No deflator for $col") unless defined $deflate; return $deflate->($value, $self); } sub get_inflated_column { my ($self, $col) = @_; - $self->throw("$col is not an inflated column") unless - exists $self->_columns->{$col}{_inflate_info}; + $self->throw_exception("$col is not an inflated column") unless + exists $self->column_info($col)->{_inflate_info}; return $self->{_inflated_column}{$col} if exists $self->{_inflated_column}{$col}; @@ -43,47 +98,79 @@ sub get_inflated_column { sub set_inflated_column { my ($self, $col, @rest) = @_; - my $ret = $self->store_inflated_column($col, @rest); - $self->{_dirty_columns}{$col} = 1; + my $ret = $self->_inflated_column_op('set', $col, @rest); return $ret; } sub store_inflated_column { - my ($self, $col, $obj) = @_; + my ($self, $col, @rest) = @_; + my $ret = $self->_inflated_column_op('store', $col, @rest); + return $ret; +} + +sub _inflated_column_op { + my ($self, $op, $col, $obj) = @_; + my $meth = "${op}_column"; unless (ref $obj) { delete $self->{_inflated_column}{$col}; - return $self->store_column($col, $obj); + return $self->$meth($col, $obj); } my $deflated = $self->_deflated_column($col, $obj); # Do this now so we don't store if it's invalid $self->{_inflated_column}{$col} = $obj; - #warn "Storing $obj: ".($obj->_ident_values)[0]; - $self->store_column($col, $deflated); + $self->$meth($col, $deflated); return $obj; } +sub update { + my ($class, $attrs, @rest) = @_; + $attrs ||= {}; + foreach my $key (keys %$attrs) { + if (ref $attrs->{$key} + && exists $class->column_info($key)->{_inflate_info}) { +# $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key}); + $class->set_inflated_column ($key, delete $attrs->{$key}); + } + } + return $class->next::method($attrs, @rest); +} + sub new { my ($class, $attrs, @rest) = @_; $attrs ||= {}; - my %deflated; foreach my $key (keys %$attrs) { - if (exists $class->_columns->{$key}{_inflate_info}) { - $deflated{$key} = $class->_deflated_column($key, - delete $attrs->{$key}); + if (ref $attrs->{$key} + && exists $class->column_info($key)->{_inflate_info}) { + $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key}); } } - return $class->NEXT::ACTUAL::new({ %$attrs, %deflated }, @rest); + return $class->next::method($attrs, @rest); } -# **** B0RKEN. DOESN'T GET CALLED! -#sub _cond_value { -# my ($self, $attrs, $key, $value) = @_; -# if (exists $self->_columns->{$key}) { -# $value = $self->_deflated_column($key, $value); -# } -# return $self->NEXT::ACTUAL::_cond_value($attrs, $key, $value); -#} +=head1 SEE ALSO + +=over 4 + +=item L - This component is loaded as part of the + "core" L components; generally there is no need to + load it directly + +=back + +=head1 AUTHOR + +Matt S. Trout + +=head1 CONTRIBUTORS + +Daniel Westermann-Clark (documentation) + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut 1;