Commit | Line | Data |
5ef62e9f |
1 | package |
2 | DBIx::Class::CDBICompat::ColumnsAsHash; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
5e0eea35 |
7 | use base 'DBIx::Class'; |
5ef62e9f |
8 | |
9 | =head1 NAME |
10 | |
b24d86a1 |
11 | DBIx::Class::CDBICompat::ColumnsAsHash - Emulates the behavior of Class::DBI where the object can be accessed as a hash of columns. |
5ef62e9f |
12 | |
13 | =head1 SYNOPSIS |
14 | |
48580715 |
15 | See DBIx::Class::CDBICompat for usage directions. |
5ef62e9f |
16 | |
17 | =head1 DESCRIPTION |
18 | |
4a0eed52 |
19 | 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. |
5ef62e9f |
20 | |
47d7b769 |
21 | my $column = $result->{column}; |
5ef62e9f |
22 | |
23 | =head2 Differences from Class::DBI |
24 | |
10221b79 |
25 | If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key. |
5ef62e9f |
26 | |
27 | =cut |
28 | |
29 | sub new { |
30 | my $class = shift; |
31 | |
32 | my $new = $class->next::method(@_); |
33 | |
34 | $new->_make_columns_as_hash; |
35 | |
36 | return $new; |
37 | } |
38 | |
39 | sub inflate_result { |
40 | my $class = shift; |
41 | |
42 | my $new = $class->next::method(@_); |
d4daee7b |
43 | |
5ef62e9f |
44 | $new->_make_columns_as_hash; |
d4daee7b |
45 | |
5ef62e9f |
46 | return $new; |
47 | } |
48 | |
49 | |
50 | sub _make_columns_as_hash { |
51 | my $self = shift; |
d4daee7b |
52 | |
5ef62e9f |
53 | for my $col ($self->columns) { |
54 | if( exists $self->{$col} ) { |
55 | warn "Skipping mapping $col to a hash key because it exists"; |
56 | } |
57 | |
ebe790db |
58 | tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue', |
59 | $self, $col; |
5ef62e9f |
60 | } |
61 | } |
62 | |
ebe790db |
63 | |
64 | package DBIx::Class::CDBICompat::Tied::ColumnValue; |
65 | |
66 | use Carp; |
67 | use Scalar::Util qw(weaken isweak); |
68 | |
69 | |
70 | sub TIESCALAR { |
71 | my($class, $obj, $col) = @_; |
72 | my $self = [$obj, $col]; |
73 | weaken $self->[0]; |
74 | |
75 | return bless $self, $_[0]; |
5ef62e9f |
76 | } |
77 | |
ebe790db |
78 | sub FETCH { |
79 | my $self = shift; |
80 | my($obj, $col) = @$self; |
5ef62e9f |
81 | |
ebe790db |
82 | my $class = ref $obj; |
83 | my $id = $obj->id; |
10221b79 |
84 | carp "Column '$col' of '$class/$id' was fetched as a hash" |
85 | if $ENV{DBIC_CDBICOMPAT_HASH_WARN}; |
ebe790db |
86 | |
1c779eb2 |
87 | return $obj->column_info($col)->{_inflate_info} |
88 | ? $obj->get_inflated_column($col) |
89 | : $obj->get_column($col); |
5ef62e9f |
90 | } |
91 | |
ebe790db |
92 | sub STORE { |
93 | my $self = shift; |
94 | my($obj, $col) = @$self; |
95 | |
96 | my $class = ref $obj; |
97 | my $id = $obj->id; |
10221b79 |
98 | carp "Column '$col' of '$class/$id' was stored as a hash" |
99 | if $ENV{DBIC_CDBICOMPAT_HASH_WARN}; |
ebe790db |
100 | |
1c779eb2 |
101 | return $obj->column_info($col)->{_inflate_info} |
102 | ? $obj->set_inflated_column($col => shift) |
103 | : $obj->set_column($col => shift); |
5ef62e9f |
104 | } |
105 | |
a2bd3796 |
106 | =head1 FURTHER QUESTIONS? |
107 | |
108 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
109 | |
110 | =head1 COPYRIGHT AND LICENSE |
111 | |
112 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
113 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
114 | redistribute it and/or modify it under the same terms as the |
115 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
116 | |
117 | =cut |
118 | |
5ef62e9f |
119 | 1; |