[Bast-commits] r3939 - in
DBIx-Class/0.08/branches/cdbicompat_integration: .
lib/DBIx/Class/CDBICompat t/cdbi-t
schwern at dev.catalyst.perl.org
schwern at dev.catalyst.perl.org
Wed Jan 16 07:57:57 GMT 2008
Author: schwern
Date: 2008-01-16 07:57:57 +0000 (Wed, 16 Jan 2008)
New Revision: 3939
Modified:
DBIx-Class/0.08/branches/cdbicompat_integration/
DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t
Log:
r52285 at windhund: schwern | 2008-01-15 23:56:23 -0800
mst pointed out that my $val = $obj->{col}; $obj->col(23); print $val; will reflect the change because of the deferring. Using a tied scalar as the value is much, much simpler.
Property changes on: DBIx-Class/0.08/branches/cdbicompat_integration
___________________________________________________________________
Name: svk:merge
- 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:52284
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3729
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:52285
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3729
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
Modified: DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm 2008-01-16 07:57:37 UTC (rev 3938)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm 2008-01-16 07:57:57 UTC (rev 3939)
@@ -4,11 +4,7 @@
use strict;
use warnings;
-use Scalar::Defer;
-use Scalar::Util qw(weaken);
-use Carp;
-
=head1 NAME
DBIx::Class::CDBICompat::ColumnsAsHash
@@ -53,56 +49,52 @@
sub _make_columns_as_hash {
my $self = shift;
- weaken $self;
for my $col ($self->columns) {
if( exists $self->{$col} ) {
warn "Skipping mapping $col to a hash key because it exists";
}
next unless $self->can($col);
- $self->{$col} = defer {
- my $class = ref $self;
- carp "Column '$col' of '$class/$self' was accessed as a hash";
- $self->$col();
- };
+ tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue',
+ $self, $col;
}
}
-sub update {
- my $self = shift;
-
- for my $col ($self->columns) {
- if( $self->_hash_changed($col) ) {
- my $class = ref $self;
- carp "Column '$col' of '$class/$self' was updated as a hash";
- $self->$col($self->_get_column_from_hash($col));
- $self->{$col} = defer { $self->$col() };
- }
- }
-
- return $self->next::method(@_);
+
+package DBIx::Class::CDBICompat::Tied::ColumnValue;
+
+use Carp;
+use Scalar::Util qw(weaken isweak);
+
+
+sub TIESCALAR {
+ my($class, $obj, $col) = @_;
+ my $self = [$obj, $col];
+ weaken $self->[0];
+
+ return bless $self, $_[0];
}
-sub _hash_changed {
- my($self, $col) = @_;
-
- return 0 unless exists $self->{$col};
-
- my $hash = $self->_get_column_from_hash($col);
- my $obj = $self->$col();
+sub FETCH {
+ my $self = shift;
+ my($obj, $col) = @$self;
- return 1 if defined $hash xor defined $obj;
- return 0 if !defined $hash and !defined $obj;
- return 1 if $hash ne $obj;
- return 0;
+ my $class = ref $obj;
+ my $id = $obj->id;
+ carp "Column '$col' of '$class/$id' was fetched as a hash";
+
+ return $obj->$col();
}
-# get the column value without a warning
-sub _get_column_from_hash {
- my($self, $col) = @_;
-
- local $SIG{__WARN__} = sub {};
- return force $self->{$col};
+sub STORE {
+ my $self = shift;
+ my($obj, $col) = @$self;
+
+ my $class = ref $obj;
+ my $id = $obj->id;
+ carp "Column '$col' of '$class/$id' was stored as a hash";
+
+ $obj->$col(shift);
}
1;
Modified: DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t 2008-01-16 07:57:37 UTC (rev 3938)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t 2008-01-16 07:57:57 UTC (rev 3939)
@@ -7,7 +7,7 @@
BEGIN {
eval "use DBIx::Class::CDBICompat;";
plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
- : (tests=> 6);
+ : (tests=> 8);
}
use lib 't/testlib';
@@ -20,20 +20,26 @@
});
warnings_like {
+ my $rating = $waves->{rating};
+ $waves->Rating("PG");
+ is $rating, "R", 'evaluation of column value is not deferred';
+} qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at \Q$0};
+
+warnings_like {
is $waves->{title}, $waves->Title, "columns can be accessed as hashes";
-} qr{^Column 'title' of 'Film/$waves' was accessed as a hash at .*$};
+} qr{^Column 'title' of 'Film/$waves' was fetched as a hash at\b};
$waves->Rating("G");
warnings_like {
is $waves->{rating}, "G", "updating via the accessor updates the hash";
-} qr{^Column 'rating' of 'Film/$waves' was accessed as a hash .*$};
+} qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b};
-$waves->{rating} = "PG";
warnings_like {
- $waves->update;
-} qr{^Column 'rating' of 'Film/$waves' was updated as a hash .*$};
+ $waves->{rating} = "PG";
+} qr{^Column 'rating' of 'Film/$waves' was stored as a hash at\b};
+$waves->update;
my @films = Film->search( Rating => "PG", Title => "Breaking the Waves" );
is @films, 1, "column updated as hash was saved";
More information about the Bast-commits
mailing list