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