X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FInflateColumn.pm;h=6a8e1e7f76c7137c6a70ef257beb3ac2f46b2283;hb=aea52c85cb46edd8f8fea4fe01f169fcba814c33;hp=a3290b0d8d3cfd187a9515ee6b4b0554d8c1e7dd;hpb=4a07648ace2ace5b878c63aec52b7a30c1432b4d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index a3290b0..6a8e1e7 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -3,11 +3,65 @@ package DBIx::Class::InflateColumn; use strict; use warnings; +use Carp qw/croak/; + +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; + croak "No such column $col to inflate" unless $self->has_column($col); + croak "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 +69,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) || croak "No column info for $col"; + return $value unless exists $info->{_inflate_info}; + my $inflate = $info->{_inflate_info}{inflate}; + croak "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) || croak "No column info for $col"; + return $value unless exists $info->{_inflate_info}; + my $deflate = $info->{_inflate_info}{deflate}; + croak "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}; + exists $self->column_info($col)->{_inflate_info}; return $self->{_inflated_column}{$col} if exists $self->{_inflated_column}{$col}; @@ -43,46 +99,66 @@ 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 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); } -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;