lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm

   1 package
   2     DBIx::Class::CDBICompat::ColumnsAsHash;
   3
   4 use strict;
   5 use warnings;
   6
   7
   8 =head1 NAME
   9
  10 DBIx::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
  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
  24 If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
  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
  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
  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];
  75 }
  76
  77 sub 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
  91 sub 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
 105 1;