Commit | Line | Data |
5ef62e9f |
1 | package |
2 | DBIx::Class::CDBICompat::ColumnsAsHash; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
5ef62e9f |
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 | |
10221b79 |
24 | If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key. |
5ef62e9f |
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 | |
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 | |
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]; |
5ef62e9f |
75 | } |
76 | |
ebe790db |
77 | sub 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 |
91 | sub 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 | |
105 | 1; |