[Bast-commits] r3984 - in trunk: . Class-Accessor-Grouped/lib/Class/Accessor DBIx-Class-DigestOnSet DBIx-Class-DigestOnSet/lib DBIx-Class-DigestOnSet/lib/DBIx DBIx-Class-DigestOnSet/lib/DBIx/Class DBIx-Class-DigestOnSet/t DBIx-Class-DigestOnSet/t/lib DBIx-Class-DigestOnSet/t/lib/DigestTest DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema

groditi at dev.catalyst.perl.org groditi at dev.catalyst.perl.org
Tue Jan 29 04:00:05 GMT 2008


Author: groditi
Date: 2008-01-29 04:00:04 +0000 (Tue, 29 Jan 2008)
New Revision: 3984

Added:
   trunk/DBIx-Class-DigestOnSet/
   trunk/DBIx-Class-DigestOnSet/Changes
   trunk/DBIx-Class-DigestOnSet/MANIFEST
   trunk/DBIx-Class-DigestOnSet/MANIFEST.SKIP
   trunk/DBIx-Class-DigestOnSet/Makefile.PL
   trunk/DBIx-Class-DigestOnSet/README
   trunk/DBIx-Class-DigestOnSet/lib/
   trunk/DBIx-Class-DigestOnSet/lib/DBIx/
   trunk/DBIx-Class-DigestOnSet/lib/DBIx/Class/
   trunk/DBIx-Class-DigestOnSet/lib/DBIx/Class/DigestOnSet.pm
   trunk/DBIx-Class-DigestOnSet/t/
   trunk/DBIx-Class-DigestOnSet/t/01load.t
   trunk/DBIx-Class-DigestOnSet/t/02digest.t
   trunk/DBIx-Class-DigestOnSet/t/lib/
   trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest.pm
   trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/
   trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema.pm
   trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema/
   trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema/Test.pm
   trunk/DBIx-Class-DigestOnSet/t/var/
Modified:
   trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
Log:
I got tired of the DigestColumns interface...

Modified: trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
===================================================================
--- trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2008-01-28 21:03:25 UTC (rev 3983)
+++ trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2008-01-29 04:00:04 UTC (rev 3984)
@@ -363,9 +363,9 @@
 Gets the value of the specified component class.
 
     __PACKAGE__->mk_group_accessors('component_class' => 'result_class');
-    
+
     $self->result_class->method();
-    
+
     ## same as
     $self->get_component_class('result_class')->method();
 
@@ -390,7 +390,7 @@
 
     __PACKAGE__->mk_group_accessors('component_class' => 'result_class');
     __PACKAGE__->result_class('MyClass');
-    
+
     $self->result_class->method();
 
 =cut

Added: trunk/DBIx-Class-DigestOnSet/Changes
===================================================================
--- trunk/DBIx-Class-DigestOnSet/Changes	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/Changes	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,2 @@
+0.000001_01     2008-01-28
+	- Initial release

Added: trunk/DBIx-Class-DigestOnSet/MANIFEST
===================================================================
--- trunk/DBIx-Class-DigestOnSet/MANIFEST	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/MANIFEST	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,22 @@
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/DBIx/Class/DigestOnSet.pm
+Makefile.PL
+MANIFEST
+META.yml
+README
+t/01load.t
+t/02digest.t
+t/lib/DigestTest.pm
+t/lib/DigestTest/Schema.pm
+t/lib/DigestTest/Schema/Test.pm

Added: trunk/DBIx-Class-DigestOnSet/MANIFEST.SKIP
===================================================================
--- trunk/DBIx-Class-DigestOnSet/MANIFEST.SKIP	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/MANIFEST.SKIP	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,48 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+\B\.cvsignore$
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\bBuild.bat$
+\b_build
+
+# Avoid Devel::Cover generated files
+\bcover_db
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+#   Mac OSX metadata
+\B\.DS_Store
+#   Mac OSX SMB mount metadata files
+\B\._
+# Avoid archives of this distribution
+\bDBIx-Class-DigestOnSet-[\d\.\_]+
+
+# Don't ship the test db
+^t/var
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# for developers only :)
+^TODO$
\ No newline at end of file

Added: trunk/DBIx-Class-DigestOnSet/Makefile.PL
===================================================================
--- trunk/DBIx-Class-DigestOnSet/Makefile.PL	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/Makefile.PL	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,25 @@
+#! /usr/bin/perl -w
+
+# Load the Module::Install bundled in ./inc/
+use inc::Module::Install;
+
+# Define metadata
+name 'DBIx-Class-DigestOnSet';
+abstract "Automatically encode values when they are set";
+all_from 'lib/DBIx/Class/DigestOnSet.pm';
+
+# Specific dependencies
+requires 'Digest'      => '1.11';
+requires 'DBIx::Class' => '0.06002';
+
+#build dependencies
+build_requires 'Test::More';
+build_requires 'DBD::SQLite';
+build_requires 'Digest::SHA';
+build_requires 'File::Spec';
+
+#recommended modules
+recommends 'Digest::MD5';
+
+auto_install;
+WriteAll;

Added: trunk/DBIx-Class-DigestOnSet/README
===================================================================
--- trunk/DBIx-Class-DigestOnSet/README	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/README	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,4 @@
+perl Makefile.PL
+make test 
+sudo make install 
+make clean
\ No newline at end of file

Added: trunk/DBIx-Class-DigestOnSet/lib/DBIx/Class/DigestOnSet.pm
===================================================================
--- trunk/DBIx-Class-DigestOnSet/lib/DBIx/Class/DigestOnSet.pm	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/lib/DBIx/Class/DigestOnSet.pm	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,210 @@
+package DBIx::Class::DigestOnSet;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+use Digest;
+
+__PACKAGE__->mk_classdata( _digest_encoders => {} );
+
+our $VERSION = '0.000001_01';
+
+sub register_column {
+  my $self = shift;
+  my ($column, $info) = @_;
+  $self->next::method(@_);
+
+  return unless ( exists $info->{digest_enable} && $info->{digest_enable} );
+  my $enc = exists $info->{digest_encoding}  ? $info->{digest_encoding}  : 'hex';
+  my $alg = exists $info->{digest_algorithm} ? $info->{digest_algorithm} : 'SHA-1';
+
+  $self->throw_exception("Valid values for digest_encoding are 'binary', 'hex' or 'base64'. You used '${enc}'")
+    unless $enc =~ /^(?:hex|base64|binary)$/;
+  my $object = eval{ Digest->new($alg) };
+  $self->throw_exception("Digest->new('${alg}') failed: $@") if $@;
+
+  my $encoding_method = $enc eq 'binary' ? 'digest' :
+    ($enc eq 'hex' ? 'hexdigest' : 'b64digest');
+  my $encoder = $self->_digest_encoders->{$column} = sub {
+    $object->add(@_);
+    return $object->$encoding_method;
+  };
+
+  if ( exists $info->{digest_check_method} && $info->{digest_check_method} ){
+    no strict 'refs';
+    my $check_method = $self->result_class.'::'.$info->{digest_check_method};
+    #candidate for inlining...
+    *$check_method = sub{ $_[0]->get_column($column) eq $encoder->($_[1]) };
+  }
+}
+
+sub set_column {
+  my $self = shift;
+  if (defined(my $encoder = $self->_digest_encoders->{$_[0]})){
+    return $self->next::method($_[0], $encoder->($_[1]));
+  }
+  $self->next::method(@_);
+}
+
+sub new {
+  my($self, $attr, @rest) = @_;
+  my $encoders = $self->_digest_encoders;
+  for my $col (keys %$encoders ) {
+    next unless exists $attr->{$col} && defined $attr->{$col};
+    $attr->{$col} = $encoders->{$col}->( $attr->{$col} );
+  }
+  return $self->next::method($attr, @rest);
+}
+
+1;
+
+__END__;
+
+=head1 NAME
+
+DBIx::Class::DigestOnSet - Automatically encode columns with Digest
+
+=head1 SYNOPSIS
+
+In your L<DBIx::Class> ResultSource class (the 'table' class):
+
+  __PACKAGE__->load_components(qw/DigestOnSet ... Core/);
+
+  #Simplest example. use hex encoding and SHA-1 algorithm
+  __PACKAGE__->add_columns(
+    'password' => {
+      data_type     => 'CHAR',
+      size          => 40,
+      digest_enable => 1,
+  }
+
+  #SHA-1 / hex encoding / generate check method
+  __PACKAGE__->add_columns(
+    'password' => {
+      data_type   => 'CHAR',
+      size        => 40,
+      digest_enable       => 1,
+      digest_check_method => 'check_password',
+  }
+
+  #SHA-1 / binary encoding / generate check method
+  __PACKAGE__->add_columns(
+    'password' => {
+      data_type   => 'BLOB',
+      size        => 20,
+      digest_enable       => 1,
+      digest_encoding     => 'binary',
+      digest_check_method => 'check_password',
+  }
+
+  #MD5 /  hex encoding / generate check method
+  __PACKAGE__->add_columns(
+    'password' => {
+      data_type => 'CHAR',
+      size      => 32,
+      digest_enable       => 1,
+      digest_algorithm    => 'MD5',
+      digest_check_method => 'check_password',
+  }
+
+In your application code:
+
+   #updating the value.
+   $row->password('plaintext');
+   my $digest = $row->password;
+
+   #checking against an existing value with a check_method
+   $row->check_password('old_password'); #true
+   $row->password('new_password');
+   $row->check_password('new_password'); #returns true
+   $row->check_password('old_password'); #returns false
+
+
+B<Note:> The component needs to be loaded I<before> Core.
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class> component can be used to automatically encode a column's
+contents whenever the value of that column is set.
+
+This module is similar to the existing L<DBIx::Class::DigestColumns>, but there
+is some key differences. The main difference is that C<DigestColumns> performs
+the encode operation on C<insert> and C<update>, and C<DigestOnSet> performs
+the operation when the value is set. Another difference is that DigestOnSet
+supports having more than one encoded column per table using different
+L<Digest> algorithms. Finally, C<DigestOnSet> adds only one item to the
+namespace of the object utilizing it (C<_digest_encoders>).
+
+There is, unfortunately, some defficiencies that come with C<DigestOnSet>.
+C<DigestColumns> supports changing certain options at runtime, as well as
+the option to not automatically encode values on set. The author of this module
+found these options to be non essential and they were left out by design.
+
+=head1 Options added to add_column
+
+If any one of these options is present the column will be treated as a digest
+column and all of the defaults will be applied to the rest of the options.
+
+=head2 digest_enable => 1
+
+Enable automatic encoding of column values. If this option is not set to true
+any other options will become noops.
+
+=head2 digest_check_method => $method_name
+
+By using the digest_check_method attribute when you declare a column you
+can create a check method for that column. The check method accepts a plain
+text string, and returns a boolean that indicates whether the digest of the
+provided value matches the current value.
+
+=head2 digest_encoding
+
+The encoding to use for the digest. Valid values are 'binary', 'hex', and
+'base64'. Will default to 'hex' if not specified.
+
+=head2 digest_algorithm
+
+The digest algorithm to use for the digest. You may specify any valid L<Digest>
+algorithm. Examples are L<MD5|Digest::MD5>, L<SHA-1|Digest::SHA>,
+L<Whirlpool|Digest::Whirlpool> etc. Will default to 'SHA-1' if not specified.
+
+See L<Digest> for supported digest algorithms.
+
+=head1 EXTENDED METHODS
+
+The following L<DBIx::Class::ResultSource> method is extended:
+
+=over 4
+
+=item B<register_column> - Handle the options described above.
+
+=back
+
+The following L<DBIx::Class::Row> methods are extended by this module:
+
+=over 4
+
+=item B<new> - Encode the columns on new() so that copy and create DWIM.
+
+=item B<set_column> - Encode values whenever column is set.
+
+=back
+
+=head1 SEE ALSO
+
+L<DBIx::Class::DigestColumns>, L<DBIx::Class>, L<Digest>
+
+=head1 AUTHOR
+
+Guillermo Roditi (groditi) <groditi at cpan.org>
+
+Inspired by the original module written by Tom Kirkpatrick (tkp) <tkp at cpan.org>
+featuring contributions from Guillermo Roditi (groditi) <groditi at cpan.org>
+and Marc Mims <marc at questright.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut

Added: trunk/DBIx-Class-DigestOnSet/t/01load.t
===================================================================
--- trunk/DBIx-Class-DigestOnSet/t/01load.t	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/t/01load.t	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,5 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use_ok('DBIx::Class::DigestColumns');

Added: trunk/DBIx-Class-DigestOnSet/t/02digest.t
===================================================================
--- trunk/DBIx-Class-DigestOnSet/t/02digest.t	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/t/02digest.t	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,98 @@
+#! /usr/bin/perl -w
+
+use strict;
+use warnings;
+use Test::More tests => 24;
+use Digest;
+
+use File::Spec;
+use FindBin '$Bin';
+use lib File::Spec->catdir($Bin, 'lib');
+
+use_ok("DigestTest");
+
+my $schema = DigestTest->init_schema;
+my $rs     = $schema->resultset('Test');
+
+my $sha256_maker = Digest->new('SHA-256');
+
+my $checks = {};
+for my $algorithm( qw/SHA-1 SHA-256/){
+  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->add($value);
+      $values->{$value} = $maker->$encoding_method;
+    }
+  }
+}
+
+my $row = $rs->create(
+                      {
+                       dummy_col  => 'test1',
+                       sha1_hex   => 'test1',
+                       sha1_b64   => 'test1',
+                       sha256_hex => 'test1',
+                       sha256_b64 => 'test1',
+                      }
+                     );
+
+is($row->dummy_col,  'test1',                            'dummy on create');
+is($row->sha1_hex,   $checks->{'SHA-1'}{hex}{test1},     'hex sha1 on create');
+is($row->sha1_b64,   $checks->{'SHA-1'}{base64}{test1},  'b64 sha1 on create');
+is($row->sha256_hex, $checks->{'SHA-256'}{hex}{test1},   'hex sha256 on create');
+is($row->sha256b64,  $checks->{'SHA-256'}{base64}{test1},'b64 sha256 on create');
+
+can_ok($row, qw/check_sha1_hex check_sha1_b64/);
+ok(!$row->can('check_dummy_col'));
+ok($row->check_sha1_hex('test1'),'Checking hex digest_check_method');
+ok($row->check_sha1_b64('test1'),'Checking b64 digest_check_method');
+
+$row->sha1_hex('test2');
+is($row->sha1_hex, $checks->{'SHA-1'}{hex}{test2}, 'Checking accessor');
+
+$row->update({sha1_b64 => 'test2',  dummy_col => 'test2'});
+is($row->sha1_b64, $checks->{'SHA-1'}{base64}{test2}, 'Checking update');
+is($row->dummy_col,  'test2', 'dummy on update');
+
+$row->set_column(sha256_hex => 'test2');
+is($row->sha256_hex, $checks->{'SHA-256'}{hex}{test2}, 'Checking set_column');
+
+$row->sha256b64('test2');
+is($row->sha256b64, $checks->{'SHA-256'}{base64}{test2}, 'custom accessor');
+
+$row->update;
+
+my $copy = $row->copy({sha256_b64 => 'test2'});
+is($copy->sha1_hex,   $checks->{'SHA-1'}{hex}{test2},     'hex sha1 on copy');
+is($copy->sha1_b64,   $checks->{'SHA-1'}{base64}{test2},  'b64 sha1 on copy');
+is($copy->sha256_hex, $checks->{'SHA-256'}{hex}{test2},   'hex sha256 on copy');
+is($copy->sha256b64,  $checks->{'SHA-256'}{base64}{test2},'b64 sha256 on copy');
+
+my $new = $rs->new(
+                   {
+                    sha1_hex   => 'test1',
+                    sha1_b64   => 'test1',
+                    sha256_hex => 'test1',
+                    sha256_b64 => 'test1',
+                    dummy_col  => 'test1',
+                   }
+                  );
+
+is($new->dummy_col,  'test1',                             'dummy on new');
+is($new->sha1_hex,   $checks->{'SHA-1'}{hex}{test1},      'hex sha1 on new');
+is($new->sha1_b64,   $checks->{'SHA-1'}{base64}{test1},   'b64 sha1 on new');
+is($new->sha256_hex, $checks->{'SHA-256'}{hex}{test1},    'hex sha256 on new');
+is($new->sha256b64,  $checks->{'SHA-256'}{base64}{test1}, 'b64 sha256 on new');
+
+DigestTest->clear;
+
+#TODO
+# -- dies_ok tests when using invalid cyphers and encodings
+
+1;
+

Added: trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema/Test.pm
===================================================================
--- trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema/Test.pm	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema/Test.pm	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,55 @@
+package # hide from PAUSE
+    DigestTest::Schema::Test;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/DigestOnSet Core/);
+__PACKAGE__->table('test');
+__PACKAGE__->add_columns
+  (
+   id => {
+          data_type => 'int',
+          is_nullable => 0,
+          is_auto_increment => 1,
+         },
+   sha1_hex => {
+                data_type => 'char',
+                size      => 40,
+                digest_enable => 1,
+                digest_algorithm => 'SHA-1',
+                digest_check_method => 'check_sha1_hex',
+               },
+   sha1_b64 => {
+                data_type => 'char',
+                size      => 27,
+                digest_enable => 1,
+                digest_encoding => 'base64',
+                digest_check_method => 'check_sha1_b64',
+               },
+   sha256_hex => {
+                  data_type => 'char',
+                  size      => 64,
+                  digest_enable    => 1,
+                  digest_algorithm => 'SHA-256',
+                 },
+   sha256_b64 => {
+                  data_type => 'char',
+                  size      => 43,
+                  accessor  => 'sha256b64',
+                  digest_enable    => 1,
+                  digest_algorithm => 'SHA-256',
+                  digest_encoding  => 'base64',
+                 },
+   dummy_col => {
+                 data_type => 'char',
+                 size      => 43,
+                 digest_enable    => 0,
+                 digest_algorithm => 'SHA-256',
+                 digest_encoding  => 'base64',
+                 digest_check_method => 'check_dummy_col',
+                },
+  );
+
+__PACKAGE__->set_primary_key('id');
+
+1;

Added: trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema.pm
===================================================================
--- trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema.pm	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest/Schema.pm	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,8 @@
+package # hide from PAUSE
+    DigestTest::Schema;
+
+use base qw/DBIx::Class::Schema/;
+
+__PACKAGE__->load_classes(qw/Test/);
+
+1;

Added: trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest.pm
===================================================================
--- trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest.pm	                        (rev 0)
+++ trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest.pm	2008-01-29 04:00:04 UTC (rev 3984)
@@ -0,0 +1,32 @@
+package # hide from PAUSE
+    DigestTest;
+
+use strict;
+use warnings;
+use DigestTest::Schema;
+
+use FindBin '$Bin';
+
+
+sub init_schema {
+  my $self = shift;
+  my $db_dir  = File::Spec->catdir($Bin, "var");
+  my $db_file = File::Spec->catfile($db_dir, "Test.db");
+
+  unlink($db_file) if -e $db_file;
+  unlink($db_file . "-journal") if -e $db_file . "-journal";
+  mkdir($db_dir) unless -d $db_dir;
+
+  my $dsn = "dbi:SQLite:dbname=${db_file}";
+  my $schema = DigestTest::Schema->connect($dsn);
+  $schema->deploy();
+  return $schema;
+}
+
+sub clear {
+  my $db_dir  = File::Spec->catdir($Bin, "var");
+  my $db_file = File::Spec->catfile($db_dir, "Test.db");
+  unlink($db_file) or die "Failed to clear test db $db_file";
+}
+
+1;


Property changes on: trunk/DBIx-Class-DigestOnSet/t/lib/DigestTest.pm
___________________________________________________________________
Name: svn:executable
   + *




More information about the Bast-commits mailing list