lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm

   1 package
   2     DBIx::Class::CDBICompat::ColumnsAsHash;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Scalar::Defer;
   8 use Scalar::Util qw(weaken);
   9 use Carp;
  10
  11
  12 =head1 NAME
  13
  14 DBIx::Class::CDBICompat::ColumnsAsHash
  15
  16 =head1 SYNOPSIS
  17
  18 See DBIx::Class::CDBICompat for directions for use.
  19
  20 =head1 DESCRIPTION
  21
  22 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.
  23
  24     my $column = $row->{column};
  25
  26 =head2 Differences from Class::DBI
  27
  28 This will warn when a column is accessed as a hash key.
  29
  30 =cut
  31
  32 sub new {
  33     my $class = shift;
  34
  35     my $new = $class->next::method(@_);
  36
  37     $new->_make_columns_as_hash;
  38
  39     return $new;
  40 }
  41
  42 sub inflate_result {
  43     my $class = shift;
  44
  45     my $new = $class->next::method(@_);
  46
  47     $new->_make_columns_as_hash;
  48
  49     return $new;
  50 }
  51
  52
  53 sub _make_columns_as_hash {
  54     my $self = shift;
  55
  56     weaken $self;
  57     for my $col ($self->columns) {
  58         if( exists $self->{$col} ) {
  59             warn "Skipping mapping $col to a hash key because it exists";
  60         }
  61
  62         next unless $self->can($col);
  63         $self->{$col} = defer {
  64             my $class = ref $self;
  65             carp "Column '$col' of '$class/$self' was accessed as a hash";
  66             $self->$col();
  67         };
  68     }
  69 }
  70
  71 sub update {
  72     my $self = shift;
  73
  74     for my $col ($self->columns) {
  75         if( $self->_hash_changed($col) ) {
  76             my $class = ref $self;
  77             carp "Column '$col' of '$class/$self' was updated as a hash";
  78             $self->$col($self->_get_column_from_hash($col));
  79             $self->{$col} = defer { $self->$col() };
  80         }
  81     }
  82
  83     return $self->next::method(@_);
  84 }
  85
  86 sub _hash_changed {
  87     my($self, $col) = @_;
  88
  89     return 0 unless exists $self->{$col};
  90
  91     my $hash = $self->_get_column_from_hash($col);
  92     my $obj  = $self->$col();
  93
  94     return 1 if defined $hash xor defined $obj;
  95     return 0 if !defined $hash and !defined $obj;
  96     return 1 if $hash ne $obj;
  97     return 0;
  98 }
  99
 100 # get the column value without a warning
 101 sub _get_column_from_hash {
 102     my($self, $col) = @_;
 103
 104     local $SIG{__WARN__} = sub {};
 105     return force $self->{$col};
 106 }
 107
 108 1;