Reorder the accessor_name_for() check to get the more likely one first to
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / ColumnsAsHash.pm
CommitLineData
5ef62e9f 1package
2 DBIx::Class::CDBICompat::ColumnsAsHash;
3
4use strict;
5use warnings;
6
5ef62e9f 7
8=head1 NAME
9
10DBIx::Class::CDBICompat::ColumnsAsHash
11
12=head1 SYNOPSIS
13
14See DBIx::Class::CDBICompat for directions for use.
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
10221b79 24If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
5ef62e9f 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
5ef62e9f 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
ebe790db 57 tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue',
58 $self, $col;
5ef62e9f 59 }
60}
61
ebe790db 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];
5ef62e9f 75}
76
ebe790db 77sub FETCH {
78 my $self = shift;
79 my($obj, $col) = @$self;
5ef62e9f 80
ebe790db 81 my $class = ref $obj;
82 my $id = $obj->id;
10221b79 83 carp "Column '$col' of '$class/$id' was fetched as a hash"
84 if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
ebe790db 85
1c779eb2 86 return $obj->column_info($col)->{_inflate_info}
87 ? $obj->get_inflated_column($col)
88 : $obj->get_column($col);
5ef62e9f 89}
90
ebe790db 91sub STORE {
92 my $self = shift;
93 my($obj, $col) = @$self;
94
95 my $class = ref $obj;
96 my $id = $obj->id;
10221b79 97 carp "Column '$col' of '$class/$id' was stored as a hash"
98 if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
ebe790db 99
1c779eb2 100 return $obj->column_info($col)->{_inflate_info}
101 ? $obj->set_inflated_column($col => shift)
102 : $obj->set_column($col => shift);
5ef62e9f 103}
104
1051;