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