view release on metacpan or  search on metacpan

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

=cut

sub _digest_column_values{
    my $self = shift;

    for my $col (@{$self->digest_auto_columns}) {
	#if dirty is required then don't update unchanged columns
	next if $self->digest_dirty && 
	    !$self->is_column_changed( $col ) &&  $self->in_storage;
	
	
	#don't digest null columns
	my $col_v = $self->get_column( $col );
	next unless defined $col_v;
	    
	#update column value with encoded value if needed
	$self->set_column( $col, $self->_get_digest_string( $col_v ) );
    }    
}

=head2 digest_auto

  __PACKAGE__->digest_auto(1);

Turns on and off automatic digest columns.  When on, this feature makes all
UPDATEs and INSERTs automatically insert a message digest of selected columns.

The default is for digest_auto is to be on.

=head2 digest_dirty

  __PACKAGE__->digest_dirty(1);

Turns on and off the limiting of automatic digests to only dirty columns.
When on, only columns that have been dirtied will have their values digested
during UPDATEs and INSERTs. If auto is set to off this option does nothing.

The default is for digest_dirty is to be off to mantain compatibility with older
versions of this module.

=head1 EXTENDED METHODS

The following L<DBIx::Class::Row> methods are extended by this module:-

=over 4

=item insert

=cut

sub insert {
    my $self = shift;
    $self->_digest_column_values if $self->digest_auto;
    $self->next::method(@_);
}

=item update

=cut

sub update {
    my ( $self, $upd, @rest ) = @_;
    if ( ref $upd ) {
        for my $col ( @{$self->digest_auto_columns} ) {
	    $self->set_column($col => delete $upd->{$col}) 
		if ( exists $upd->{$col} );
        }
    }
    $self->_digest_column_values if $self->digest_auto;
    $self->next::method($upd, @rest);
}

1;
__END__

=back

=head1 SEE ALSO

L<DBIx::Class>,
L<Digest>

=head1 AUTHOR

Tom Kirkpatrick (tkp) <tkp@cpan.org>

With contributions from
Guillermo Roditi (groditi) <groditi@cpan.org>
and Marc Mims <marc@questright.com>

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.