X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnsAsHash.pm;h=494dbb90f1e991124d58dd0a42f40c1d5de7a083;hb=be64931c710bcde7abe7334349b4c8a123645332;hp=62f47733993e9c0448e52db87ba1adc595accad8;hpb=5ef62e9f53f21785ad3879efedb0548dd991d175;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm b/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
index 62f4773..494dbb9 100644
--- a/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
@@ -4,18 +4,14 @@ package
 use strict;
 use warnings;
 
-use Scalar::Defer;
-use Scalar::Util qw(weaken);
-use Carp;
-
 
 =head1 NAME
 
-DBIx::Class::CDBICompat::ColumnsAsHash
+DBIx::Class::CDBICompat::ColumnsAsHash - Emulates the behavior of Class::DBI where the object can be accessed as a hash of columns.
 
 =head1 SYNOPSIS
 
-See DBIx::Class::CDBICompat for directions for use.
+See DBIx::Class::CDBICompat for usage directions.
 
 =head1 DESCRIPTION
 
@@ -25,7 +21,7 @@ Emulates the I<undocumnted> behavior of Class::DBI where the object can be acces
 
 =head2 Differences from Class::DBI
 
-This will warn when a column is accessed as a hash key.
+If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
 
 =cut
 
@@ -43,66 +39,67 @@ sub inflate_result {
     my $class = shift;
 
     my $new = $class->next::method(@_);
-    
+
     $new->_make_columns_as_hash;
-    
+
     return $new;
 }
 
 
 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();
-
-    return 1 if defined $hash xor defined $obj;
-    return 0 if !defined $hash and !defined $obj;
-    return 1 if $hash ne $obj;
-    return 0;
+sub FETCH {
+    my $self = shift;
+    my($obj, $col) = @$self;
+
+    my $class = ref $obj;
+    my $id    = $obj->id;
+    carp "Column '$col' of '$class/$id' was fetched as a hash"
+        if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
+
+    return $obj->column_info($col)->{_inflate_info}
+                ? $obj->get_inflated_column($col)
+                : $obj->get_column($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"
+        if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
+
+    return $obj->column_info($col)->{_inflate_info}
+                ? $obj->set_inflated_column($col => shift)
+                : $obj->set_column($col => shift);
 }
 
 1;