[Bast-commits] r7780 - in trunk/DBIx-Class-EncodedColumn: .
lib/DBIx/Class lib/DBIx/Class/EncodedColumn t
t/lib/DigestTest/Schema
kentnl at dev.catalyst.perl.org
kentnl at dev.catalyst.perl.org
Sun Oct 11 15:00:52 GMT 2009
Author: kentnl
Date: 2009-10-11 15:00:51 +0000 (Sun, 11 Oct 2009)
New Revision: 7780
Modified:
trunk/DBIx-Class-EncodedColumn/Changes
trunk/DBIx-Class-EncodedColumn/Makefile.PL
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm
trunk/DBIx-Class-EncodedColumn/t/02digest.t
trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
Log:
Fix bug with Whirlpool and other misc small tweaks.
Modified: trunk/DBIx-Class-EncodedColumn/Changes
===================================================================
--- trunk/DBIx-Class-EncodedColumn/Changes 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/Changes 2009-10-11 15:00:51 UTC (rev 7780)
@@ -1,3 +1,7 @@
+
+ - Fix hashing/validation with Whirlpool ( Kent Fredric )
+ - Add Repository META
+
0.00004 2009-09-03
- correct option name typo in the docs (digest_class -> encode_class)
- put the .gpg files back into the test so tests pass (mst == fool)
Modified: trunk/DBIx-Class-EncodedColumn/Makefile.PL
===================================================================
--- trunk/DBIx-Class-EncodedColumn/Makefile.PL 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/Makefile.PL 2009-10-11 15:00:51 UTC (rev 7780)
@@ -8,6 +8,8 @@
abstract "Automatically encode column values";
all_from 'lib/DBIx/Class/EncodedColumn.pm';
+repository 'http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class-EncodedColumn';
+
# Specific dependencies
requires 'DBIx::Class' => '0.06002';
requires 'Sub::Name' => '0.04';
Modified: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm 2009-10-11 15:00:51 UTC (rev 7780)
@@ -46,7 +46,7 @@
my $encoder = sub {
my ($plain_text, $salt) = @_;
$salt ||= join('', map { $salt_pool[int(rand(65))] } 1 .. $slen);
- $object->add($plain_text.$salt);
+ $object->reset()->add($plain_text.$salt);
my $digest = $object->$format_method;
#print "${plain_text}\t ${salt}:\t${digest}${salt}\n" if $salt;
return $digest.$salt;
@@ -176,6 +176,10 @@
Based on the Vienna WoC ToDo manager code by Matt S trout (mst)
+=head1 CONTRIBUTORS
+
+See L<DBIx::Class::EncodedColumn>
+
=head1 LICENSE
This module is free software; you can redistribute it and/or modify it under
Modified: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm 2009-10-11 15:00:51 UTC (rev 7780)
@@ -9,7 +9,7 @@
__PACKAGE__->mk_classdata( _column_encoders => {} );
-our $VERSION = '0.00004';
+our $VERSION = '0.00005';
sub register_column {
my $self = shift;
@@ -229,8 +229,12 @@
=head1 CONTRIBUTORS
+kentnl - Kent Fredric <kentnl at cpan.org>
+
mst - Matt S Trout <mst at shadowcat.co.uk>
+=back
+
=head1 COPYRIGHT
Copyright (c) 2008 - 2009 the DBIx::Class::EncodedColumn L</AUTHOR> and
Modified: trunk/DBIx-Class-EncodedColumn/t/02digest.t
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/02digest.t 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/t/02digest.t 2009-10-11 15:00:51 UTC (rev 7780)
@@ -9,17 +9,20 @@
use FindBin '$Bin';
use lib File::Spec->catdir($Bin, 'lib');
-my ($sha_ok, $bcrypt_ok, $pgp_ok);
+my ($sha_ok, $bcrypt_ok, $pgp_ok, $whirlpool_ok);
+
BEGIN {
$sha_ok = eval 'require Digest' && eval 'require Digest::SHA;';
$bcrypt_ok = eval 'require Crypt::Eksblowfish::Bcrypt';
$pgp_ok = eval 'require Crypt::OpenPGP';
+ $whirlpool_ok = eval 'require Digest; 1' && eval 'require Digest::Whirlpool; 1';
}
my $tests = 5;
$tests += 21 if $sha_ok;
$tests += 6 if $bcrypt_ok;
$tests += 6 if $pgp_ok;
+$tests += 7 if $whirlpool_ok;
plan tests => $tests;
@@ -45,12 +48,31 @@
}
}
}
+if ( $whirlpool_ok ) {
+ for my $algorithm( qw/Whirlpool/){
+ my $maker = Digest->new($algorithm);
+ my $encodings = $checks->{$algorithm} = {};
+ for my $encoding (qw/base64 hex/){
+ my $values = $encodings->{$encoding} = {};
+ my $encoding_method = $encoding eq 'binary' ? 'digest' :
+ ($encoding eq 'hex' ? 'hexdigest' : 'b64digest');
+ for my $value (qw/test1 test2/){
+ $maker->reset()->add($value);
+ $values->{$value} = $maker->$encoding_method;
+ }
+ }
+ }
+}
my %create_vals = (dummy_col => 'test1');
if( $sha_ok ){
$create_vals{$_} = 'test1'
for(qw/sha1_hex sha1_b64 sha256_hex sha256_b64 sha256_b64_salted/);
}
+if( $whirlpool_ok ){
+ $create_vals{$_} = 'test1'
+ for(qw/whirlpool_hex whirlpool_b64/);
+}
if( $bcrypt_ok ){
$create_vals{$_} = 'test1' for(qw/bcrypt_1 bcrypt_2/);
@@ -132,6 +154,23 @@
is($copy->sha256b64, $checks->{'SHA-256'}{base64}{test2},'b64 sha256 on copy');
}
+# 7
+if( $whirlpool_ok ){
+ is( $row->whirlpool_hex, $checks->{'Whirlpool'}{hex}{test1}, 'Whirlpool hex');
+ is( $row->whirlpool_b64, $checks->{'Whirlpool'}{base64}{test1}, 'Whirlpool b64');
+
+ can_ok( $row, qw/check_whirlpool_hex check_whirlpool_b64/ );
+ ok( $row->check_whirlpool_hex('test1'), 'Checking hex digest_check_method for Whirlpool');
+ ok( $row->check_whirlpool_b64('test1'), 'Checking b64 digest_check_method for Whirlpool');
+
+ $row->whirlpool_hex('test2');
+ is( $row->whirlpool_hex, $checks->{'Whirlpool'}{hex}{test2}, 'Checking accessor (Whirlpool)');
+
+ $row->update({ whirlpool_b64 => 'test2' });
+ is( $row->whirlpool_b64, $checks->{'Whirlpool'}{base64}{test2}, 'Checking Update (Whirlpool)');
+
+}
+
#1
my $new = $rs->new( \%create_vals );
is($new->dummy_col, 'test1', 'dummy on new');
Modified: trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2009-10-11 13:44:18 UTC (rev 7779)
+++ trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2009-10-11 15:00:51 UTC (rev 7780)
@@ -1,11 +1,12 @@
package # hide from PAUSE
DigestTest::Schema::Test;
-my ($sha_ok, $bcrypt_ok);
+my ($sha_ok, $bcrypt_ok, $whirlpool_ok);
BEGIN {
$sha_ok = eval 'require Digest' && eval 'require Digest::SHA;';
$bcrypt_ok = eval 'require Crypt::Eksblowfish::Bcrypt';
$pgp_ok = eval 'require Crypt::OpenPGP';
+ $whirlpool_ok = eval 'require Digest; 1' && eval 'require Digest::Whirlpool; 1';
}
use base qw/DBIx::Class/;
@@ -80,6 +81,35 @@
);
}
+if ( $whirlpool_ok ) {
+
+ __PACKAGE__->add_columns(
+ whirlpool_hex => {
+ data_type => 'char',
+ is_nullable => 1,
+ size => 128,
+ encode_column => 1,
+ encode_class => 'Digest',
+ encode_args => {
+ format => 'hex',
+ algorithm => 'Whirlpool',
+ },
+ encode_check_method => 'check_whirlpool_hex',
+ },
+ whirlpool_b64 => {
+ data_type => 'char',
+ is_nullable => 1,
+ size => 86,
+ encode_column => 1,
+ encode_class => 'Digest',
+ encode_args => {
+ algorithm => 'Whirlpool',
+ },
+ encode_check_method => 'check_whirlpool_b64',
+ },
+ );
+}
+
if( $bcrypt_ok ){
__PACKAGE__->add_columns(
bcrypt_1 => {
More information about the Bast-commits
mailing list