Remove Class::Data::Inheritable and use CAG 'inherited' style accessors

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / ColumnsAsHash.pm

diff --git a/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm b/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
index 62f4773..51b6e0b 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
@@ -4,28 +4,25 @@ package
 use strict;
 use warnings;
 
-use Scalar::Defer;
-use Scalar::Util qw(weaken);
-use Carp;
-
+use base 'DBIx::Class';
 
 =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
 
-Emulates the I<undocumnted> behavior of Class::DBI where the object can be accessed as a hash of columns.  This is often used as a performance hack.
+Emulates the I<undocumented> behavior of Class::DBI where the object can be accessed as a hash of columns.  This is often used as a performance hack.
 
-    my $column = $row->{column};
+    my $column = $result->{column};
 
 =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 +40,80 @@ 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);
 }
 
+=head1 FURTHER QUESTIONS?
+
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
+
+=head1 COPYRIGHT AND LICENSE
+
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
+
+=cut
+
 1;