package DBIx::Class::DigestColumns;

use strict;
use warnings;
use base qw/DBIx::Class/;

our $VERSION = '0.01';

__PACKAGE__->mk_classdata( force_digest_columns => [] );
__PACKAGE__->mk_classdata( digest_engine => '');
__PACKAGE__->mk_classdata( digest_type => '');
__PACKAGE__->load_components(qw/ResultSetManager/);

sub digest_columns {
    my $self = shift;
    for (@_) {
        $self->throw_exception("column $_ doesn't exist")
            unless $self->has_column($_);
    }
    $self->force_digest_columns( \@_ );
}

sub set_digest_type {
    my $self = shift;
    my $type = shift;

    $self->digest_type($type);

    if ( $self->digest_type =~ /^MD5$/ ) {
        eval("use Digest::MD5 qw/md5_hex/");
        $self->throw_exception("Can't load Digest::MD5 $@")
            if $@;
        $self->digest_engine( \&md5_hex );
    }
    elsif ( $self->digest_type =~ /^SHA$/ ) {
        eval("use Digest::SHA qw/sha1_hex/");
        $self->throw_exception("Can't load Digest::SHA $@")
            if $@;
        $self->digest_engine( \&sha1_hex );
    }
    else {
        $self->throw_exception("Unknown digest type");
    }

    return;
}

sub store_column {
    my ( $self, $column, $value ) = @_;
    $self->throw_exception("Unknown digest type")
        unless $self->digest_type;
    if ( { map { $_ => 1 } @{ $self->force_digest_columns } }->{$column} ) {
        $value = &{$self->digest_engine}($value);
    }

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

sub _digest_search_setting : ResultSet {
    my $self = shift;
    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};

    my $base_class = ref $self;
    $base_class =~ s/^(.+)::_resultset$/$1/;

    $self->throw_exception("Unknown digest type")
        unless $base_class->digest_type;

    $self->throw_exception("Undefined digest engine")
        unless $base_class->digest_engine;

    for my $column ( keys %$query ) {
        if ( { map { $_ => 1 } @{ $base_class->force_digest_columns } }->{$column} ) {
            $query->{$column} = &{$base_class->digest_engine}($query->{$column});
        }
    }
    return ( $query, { %$attrs } );
}

sub digest_search : ResultSet {
    my $self = shift;
    my ($query,$attrs) = $self->_digest_search_setting( @_ );

    return $self->search($query,$attrs);
}

sub digest_count : ResultSet {
    my $self = shift;
    my ($query,$attrs) = $self->_digest_search_setting( @_ );

    return $self->count($query,$attrs);
}

1;
__END__

=head1 NAME

DBIx::Class::DigestColumns - easy to Digest

=head1 VERSION

This documentation refers to DBIx::Class::DigestColumns version 0.01

=head1 SYNOPSIS

    package DBIC::User;
    use base 'DBIx::Class';
    __PACKAGE__->load_components(qw/DigestColumns PK::Auto::SQLite Core/);
    ....
    __PACKAGE__->digest_columns(qw/passwd/);

and your script

    my $it = $schema->resultset('User')->digest_search({passwd => $passwd});
    my $count = $schema->resultset('User')->digest_count({passwd => $passwd});

=head1 DESCRIPTION

DBIx::Class::DigestColumns is Extension to DBIx::Class.
DBIx::Class::DigestColumns is easy to Digest::MD5 or SHA the plugin for DBIC.

=head1 DEPENDENCIES

L<DBIx::Class>

L<DBIx::Class::ResultSetManager>

L<Digest::MD5>

L<Digest::SHA>

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.
Please report problems to Atsushi Kobayashi (E<lt>nekokak@cpan.orgE<gt>)
Patches are welcome.

=head1 SEE ALSO

L<DBIx::Class>

L<DBIx::Class::ResultSetManager>

L<Digest::MD5>

L<Digest::SHA>

=head1 AUTHOR

Atsushi Kobayashi, E<lt>nekokak@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Atsushi Kobayashi (E<lt>nekokak@cpan.orgE<gt>). All rights reserved.

This library is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself. See L<perlartistic>.

=cut