· 8 years ago · Mar 15, 2018, 12:42 AM
1Index: t/03crosstable_leak.t
2===================================================================
3--- t/03crosstable_leak.t (revision 0)
4+++ t/03crosstable_leak.t (revision 0)
5@@ -0,0 +1,46 @@
6+#! /usr/bin/perl -w
7+
8+use strict;
9+use warnings;
10+use Test::More tests => 6;
11+use Digest;
12+
13+use File::Spec;
14+use FindBin '$Bin';
15+use lib File::Spec->catdir( $Bin, 'lib' );
16+
17+#1
18+use_ok("DigestTest");
19+
20+# ABOUT THIS TEST;
21+#
22+# TableA is not encoded.
23+# TableB is encoded.
24+#
25+# Both share a field with the same name.
26+#
27+# This test is to demonstrate, that one is inheriting the encoding options wrongly from the other.
28+#
29+
30+my $schema = DigestTest->init_schema;
31+my $tablea = $schema->resultset('TableA');
32+my $tableb = $schema->resultset('TableB');
33+
34+my $objecta = $tablea->create( { conflicting_name => 'foo' } );
35+my $objectb = $tableb->create( { conflicting_name => 'bar' } );
36+
37+is( $objecta->conflicting_name, 'foo', 'Table requested to not be encoded is not encoded' );
38+unlike( $objectb->conflicting_name, qr/^(bar|foo)$/, 'Table requested to be encoded is encoded' );
39+
40+is( $objecta->can('check_conflict'), undef, 'Table that is requested to not be encoded has no check_conflict method' );
41+ok( $objectb->can('check_conflict'), 'Table that is requested encoded has check_conflict method' );
42+
43+ok( $objectb->check_conflict( 'bar') , 'Hash-digest validation on encoded fields still works');
44+
45+END {
46+
47+ # In the END section so that the test DB file gets closed before we attempt to unlink it
48+ DigestTest::clear($schema);
49+}
50+
51+1;
52Index: t/lib/DigestTest/Schema/TableA.pm
53===================================================================
54--- t/lib/DigestTest/Schema/TableA.pm (revision 0)
55+++ t/lib/DigestTest/Schema/TableA.pm (revision 0)
56@@ -0,0 +1,25 @@
57+package # hide from PAUSE
58+ DigestTest::Schema::TableA;
59+
60+use base qw/DBIx::Class/;
61+
62+__PACKAGE__->load_components(qw/EncodedColumn Core/);
63+__PACKAGE__->table('tablea');
64+__PACKAGE__->add_columns(
65+ id => {
66+ data_type => 'int',
67+ is_nullable => 0,
68+ is_auto_increment => 1
69+ },
70+ conflicting_name => {
71+ data_type => 'char',
72+ size => 43,
73+ encode_column => 0,
74+ encode_class => 'Digest',
75+ encode_check_method => 'check_conflict',
76+ },
77+);
78+
79+__PACKAGE__->set_primary_key('id');
80+
81+1;
82Index: t/lib/DigestTest/Schema/TableB.pm
83===================================================================
84--- t/lib/DigestTest/Schema/TableB.pm (revision 0)
85+++ t/lib/DigestTest/Schema/TableB.pm (revision 0)
86@@ -0,0 +1,25 @@
87+package # hide from PAUSE
88+ DigestTest::Schema::TableB;
89+
90+use base qw/DBIx::Class/;
91+
92+__PACKAGE__->load_components(qw/EncodedColumn Core/);
93+__PACKAGE__->table('tableb');
94+__PACKAGE__->add_columns(
95+ id => {
96+ data_type => 'int',
97+ is_nullable => 0,
98+ is_auto_increment => 1
99+ },
100+ conflicting_name => {
101+ data_type => 'char',
102+ size => 43,
103+ encode_column => 1,
104+ encode_class => 'Digest',
105+ encode_check_method => 'check_conflict',
106+ },
107+);
108+
109+__PACKAGE__->set_primary_key('id');
110+
111+1;
112Index: t/lib/DigestTest/Schema.pm
113===================================================================
114--- t/lib/DigestTest/Schema.pm (revision 7824)
115+++ t/lib/DigestTest/Schema.pm (working copy)
116@@ -3,6 +3,6 @@
117
118 use base qw/DBIx::Class::Schema/;
119
120-__PACKAGE__->load_classes(qw/Test/);
121+__PACKAGE__->load_classes(qw/Test TableA TableB/);
122
123 1;
124Index: lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm
125===================================================================
126--- lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm (revision 7824)
127+++ lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm (working copy)
128@@ -41,7 +41,7 @@
129 #fast fast fast
130 return eval qq^ sub {
131 my \$col_v = \$_[0]->get_column('${col}');
132- \$_[0]->_column_encoders->{${col}}->(\$_[1], \$col_v) eq \$col_v;
133+ \$_[0]->_column_encoders->{ \$_[0]->result_class }->{${col}}->(\$_[1], \$col_v) eq \$col_v;
134 } ^ || die($@);
135 }
136
137Index: lib/DBIx/Class/EncodedColumn/Digest.pm
138===================================================================
139--- lib/DBIx/Class/EncodedColumn/Digest.pm (revision 7824)
140+++ lib/DBIx/Class/EncodedColumn/Digest.pm (working copy)
141@@ -68,7 +68,7 @@
142 return eval qq^ sub {
143 my \$col_v = \$_[0]->get_column('${col}');
144 my \$salt = substr(\$col_v, ${len});
145- \$_[0]->_column_encoders->{${col}}->(\$_[1], \$salt) eq \$col_v;
146+ \$_[0]->_column_encoders->{\$_[0]->result_class}->{${col}}->(\$_[1], \$salt) eq \$col_v;
147 } ^ || die($@);
148 }
149
150Index: lib/DBIx/Class/EncodedColumn.pm
151===================================================================
152--- lib/DBIx/Class/EncodedColumn.pm (revision 7824)
153+++ lib/DBIx/Class/EncodedColumn.pm (working copy)
154@@ -14,8 +14,8 @@
155 sub register_column {
156 my $self = shift;
157 my ($column, $info) = @_;
158+
159 $self->next::method(@_);
160-
161 return unless exists $info->{encode_column} && $info->{encode_column} == 1;
162 $self->throw_exception("'encode_class' is a required argument.")
163 unless exists $info->{encode_class} && defined $info->{encode_class};
164@@ -31,7 +31,7 @@
165
166 defined( my $encode_sub = eval{ $class->make_encode_sub($column, $args) }) ||
167 $self->throw_exception("Failed to create encoder with class '$class': $@");
168- $self->_column_encoders->{$column} = $encode_sub;
169+ $self->_column_encoders->{ $self->result_class }->{$column} = $encode_sub;
170
171 if ( exists $info->{encode_check_method} && $info->{encode_check_method} ){
172 no strict 'refs';
173@@ -44,7 +44,7 @@
174
175 sub set_column {
176 my $self = shift;
177- my $encs = $self->_column_encoders;
178+ my $encs = $self->_column_encoders->{ $self->result_class };
179 if(exists $encs->{$_[0]} && defined(my $encoder = $encs->{$_[0]})){
180 return $self->next::method($_[0], $encoder->($_[1]));
181 }
182@@ -53,7 +53,7 @@
183
184 sub new {
185 my($self, $attr, @rest) = @_;
186- my $encoders = $self->_column_encoders;
187+ my $encoders = $self->_column_encoders->{ $self->result_class };
188 for my $col (grep { defined $encoders->{$_} } keys %$encoders ) {
189 next unless exists $attr->{$col} && defined $attr->{$col};
190 $attr->{$col} = $encoders->{$col}->( $attr->{$col} );
191Index: Changes
192===================================================================
193--- Changes (revision 7824)
194+++ Changes (working copy)
195@@ -1,3 +1,4 @@
196+ - Fix intra-table digest collisons ( Kent Fredric )
197 - Fix build_requires version number for SQLA ( fREW )
198
199 0.00005 2009-10-11