1package
2    DBIx::Class::CDBICompat::ColumnsAsHash;
3
4use strict;
5use warnings;
6
7
8=head1 NAME
9
10DBIx::Class::CDBICompat::ColumnsAsHash - Emulates the behavior of Class::DBI where the object can be accessed as a hash of columns.
11
12=head1 SYNOPSIS
13
14See DBIx::Class::CDBICompat for usage directions.
15
16=head1 DESCRIPTION
17
18Emulates 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
24If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
25
26=cut
27
28sub 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
38sub 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
49sub _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
63package DBIx::Class::CDBICompat::Tied::ColumnValue;
64
65use Carp;
66use Scalar::Util qw(weaken isweak);
67
68
69sub TIESCALAR {
70    my($class, $obj, $col) = @_;
71    my $self = [$obj, $col];
72    weaken $self->[0];
73
74    return bless $self, $_[0];
75}
76
77sub 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
91sub 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
1051;
106