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

use Digest::MD5 qw(md5_hex);

our $VERSION = '0.01';

__PACKAGE__->mk_classdata( force_md5_columns => [] );
__PACKAGE__->load_components(qw/ResultSetManager/);

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

sub store_column {
    my ( $self, $column, $value ) = @_;
    if ( { map { $_ => 1 } @{ $self->force_md5_columns } }->{$column} ) {
        $value = md5_hex($value);
    }

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

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

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

    for my $column ( keys %$query ) {
        if ( { map { $column => 1 } @{ $base_class->force_md5_columns } }->{$column} ) {
            $query->{$column} = md5_hex($query->{$column});
        }
    }

    return $class->search($query, { %$attrs });
}

1;
__END__

=head1 NAME

DBIx::Class::MD5Columns - easy to MD5

=head1 SYNOPSIS

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

and your script

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

=head1 DESCRIPTION

DBIx::Class::MD5Columns is Extension to DBIx::Class.
DBIx::Class::MD5Columns is easy to Digest::MD5 the plugin for DBIC.

=head1 DEPENDENCIES

L<DBIx::Class>

L<DBIx::Class::ResultSetManager>

L<Digest::MD5>

=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>

=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