lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm

   1 package
   2     DBIx::Class::CDBICompat::ColumnsAsHash;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base 'DBIx::Class';
   8
   9 =head1 NAME
  10
  11 DBIx::Class::CDBICompat::ColumnsAsHash - Emulates the behavior of Class::DBI where the object can be accessed as a hash of columns.
  12
  13 =head1 SYNOPSIS
  14
  15 See DBIx::Class::CDBICompat for usage directions.
  16
  17 =head1 DESCRIPTION
  18
  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.
  20
  21     my $column = $result->{column};
  22
  23 =head2 Differences from Class::DBI
  24
  25 If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
  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(@_);
  43
  44     $new->_make_columns_as_hash;
  45
  46     return $new;
  47 }
  48
  49
  50 sub _make_columns_as_hash {
  51     my $self = shift;
  52
  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
  58         tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue',
  59             $self, $col;
  60     }
  61 }
  62
  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];
  76 }
  77
  78 sub FETCH {
  79     my $self = shift;
  80     my($obj, $col) = @$self;
  81
  82     my $class = ref $obj;
  83     my $id    = $obj->id;
  84     carp "Column '$col' of '$class/$id' was fetched as a hash"
  85         if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
  86
  87     return $obj->column_info($col)->{_inflate_info}
  88                 ? $obj->get_inflated_column($col)
  89                 : $obj->get_column($col);
  90 }
  91
  92 sub STORE {
  93     my $self = shift;
  94     my($obj, $col) = @$self;
  95
  96     my $class = ref $obj;
  97     my $id    = $obj->id;
  98     carp "Column '$col' of '$class/$id' was stored as a hash"
  99         if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
 100
 101     return $obj->column_info($col)->{_inflate_info}
 102                 ? $obj->set_inflated_column($col => shift)
 103                 : $obj->set_column($col => shift);
 104 }
 105
 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
 119 1;