DBIC::DigestColumns

Class::DBI::Plugin::DigestColumnsに名前あわせてみて、
MD5とSHAを使えるようにしてみた。

SHAに関してはSHA1とかSHA2とか色々あってどれが良いのか微妙だったけど、
Digest::SHAがレーティング高くて
Perl extension for SHA-1/224/256/384/512
って言ってるからこれにしてみた。

使いかた。

__PACKAGE__->digest_columns(qw/passwd/);

で、digestに関連付けるカラムを設定。

__PACKAGE__->set_digest_type('MD5');

or

__PACKAGE__->set_digest_type('SHA');

で、Digest::MD5かDigest::SHAのどっちを使うかを設定。
selectするときはdigest_searchメソッドで実行。

ソースはこんなの。
なんかもっと綺麗に書ける気がする。

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 : 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 $self->search($query, { %$attrs });

}

1;