view release on metacpan or  search on metacpan

lib/DBIx/Class/FrozenColumns.pm  view on Meta::CPAN

sub _ensure_column_unpacked {
    my ($self, $column, $type) = @_;
    unless ( ref (my $packed = $self->get_column($column)) ) {
        $self->store_column($column, $type->recover(\$packed));
    }
}

=head2 has_column_loaded

Returns true if data_column of frozen column has loaded.

=cut

sub has_column_loaded {
    my ($self, $column) = @_;

    if (my $frozen_info = $self->_frozen_columns->{$column}) {
        return $self->has_column_loaded( $frozen_info->{column} );
    }

    $self->next::method($column);
}

=head2 is_column_changed

=cut

sub is_column_changed {
    my ($self, $column) = @_;

    if ($self->_frozen_columns->{$column}) {
        my $frozen_dirty = $self->_dirty_frozen_columns;
        return $frozen_dirty && exists $frozen_dirty->{$column};
    }

    $self->next::method($column);
}

=head2 is_changed

=cut

sub is_changed {
    my $self = shift;

    if(wantarray) {
        my @columns = $self->next::method(@_);
        my $frozen_dirty = $self->_dirty_frozen_columns;
        push @columns, keys %$frozen_dirty if $frozen_dirty;
        return @columns;
    }

    return 1 if $self->next::method(@_) or keys %{$self->_dirty_frozen_columns||{}};
}

=head2 update

=cut

sub update {
    my $self = shift;
    $self->_dirty_frozen_columns(undef);
    $self->next::method(@_);
}


=head2 insert

=cut

sub insert {
    my $self = shift;
    $self->_dirty_frozen_columns(undef);
    $self->next::method(@_);
}

=head1 Custom frozen class

Such a class must be derived from 'DBIx::Class::FrozenColumns::Base' and is
responsible for fetching and storing frozen columns to/from a real database column.
The corresponding methods are 'recover' and 'stringify'.

The best explanation is an expamle:

    package DBIx::Class::FrozenColumns::Frozen;
    use base qw/DBIx::Class::FrozenColumns::Base/;

    use strict;
    use Storable qw/freeze thaw/;

    sub stringify {
         freeze(shift);
    }

    sub recover {
        my ($this, $dataref) = @_;
        my $data = defined $$dataref ? eval {thaw($$dataref)} || {} : {};
        bless ($data, ref $this || $this);
    }

Information actually stored in database can be used by any other programs as a simple
hash (possibly containing another hashes like itself).

=cut

package DBIx::Class::FrozenColumns::Base;
use strict;
use overload '.'      => sub {$_[0]->stringify},
             '""'     => sub {$_[0]->stringify},
             'ne'     => sub{1},
             'eq'     => sub{undef},
             fallback => 1;

package DBIx::Class::FrozenColumns::Frozen;
use base qw/DBIx::Class::FrozenColumns::Base/;

use strict;
use Storable qw/freeze thaw/;

sub stringify {