Fix the skip for DBD::Multi
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / ColumnsAsHash.pm
1 package
2     DBIx::Class::CDBICompat::ColumnsAsHash;
3
4 use strict;
5 use warnings;
6
7
8 =head1 NAME
9
10 DBIx::Class::CDBICompat::ColumnsAsHash
11
12 =head1 SYNOPSIS
13
14 See DBIx::Class::CDBICompat for directions for use.
15
16 =head1 DESCRIPTION
17
18 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.
19
20     my $column = $row->{column};
21
22 =head2 Differences from Class::DBI
23
24 If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
25
26 =cut
27
28 sub new {
29     my $class = shift;
30
31     my $new = $class->next::method(@_);
32
33     $new->_make_columns_as_hash;
34
35     return $new;
36 }
37
38 sub inflate_result {
39     my $class = shift;
40
41     my $new = $class->next::method(@_);
42     
43     $new->_make_columns_as_hash;
44     
45     return $new;
46 }
47
48
49 sub _make_columns_as_hash {
50     my $self = shift;
51     
52     for my $col ($self->columns) {
53         if( exists $self->{$col} ) {
54             warn "Skipping mapping $col to a hash key because it exists";
55         }
56
57         tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue',
58             $self, $col;
59     }
60 }
61
62
63 package DBIx::Class::CDBICompat::Tied::ColumnValue;
64
65 use Carp;
66 use Scalar::Util qw(weaken isweak);
67
68
69 sub TIESCALAR {
70     my($class, $obj, $col) = @_;
71     my $self = [$obj, $col];
72     weaken $self->[0];
73
74     return bless $self, $_[0];
75 }
76
77 sub FETCH {
78     my $self = shift;
79     my($obj, $col) = @$self;
80
81     my $class = ref $obj;
82     my $id    = $obj->id;
83     carp "Column '$col' of '$class/$id' was fetched as a hash"
84         if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
85
86     return $obj->column_info($col)->{_inflate_info}
87                 ? $obj->get_inflated_column($col)
88                 : $obj->get_column($col);
89 }
90
91 sub STORE {
92     my $self = shift;
93     my($obj, $col) = @$self;
94
95     my $class = ref $obj;
96     my $id    = $obj->id;
97     carp "Column '$col' of '$class/$id' was stored as a hash"
98         if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
99
100     return $obj->column_info($col)->{_inflate_info}
101                 ? $obj->set_inflated_column($col => shift)
102                 : $obj->set_column($col => shift);
103 }
104
105 1;