From b9aaa8cfb235b8a626289f920c99ddb2680c8f3d Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Sat, 6 Feb 2016 06:54:51 +0000 Subject: [PATCH] Bug 15759 - Allow Koha::Object derived objects to be used as hashrefs On occasion, bugs in Koha have been revealed to be a mis-use of Koha::Object. This seems to be due to our long standing use of hashrefs for data in Koha. For instance, a developer may accidentally write: my $borrowernumber = $borrower->{borrowernumber}; instead of my $borrowernumber = $borrower->borrowernumber; Since our object is a blessed hashref, this does not cause an error. Instead, we just access that key of the hashref, which is almost certainly undefined. With some extra code in Koha/Object.pm, we can allow hashref-like use of our Objects, which will not only prevent these errors, but allow drop-in use of Koha::Objects where we currently use hashrefs! Test Plan: 1) Apply this patch 2) prove t/db_dependent/Borrower.t --- Koha/Object.pm | 107 +++++++++++++++++++++++++++++++++++++++++++--- t/db_dependent/Borrower.t | 6 ++- 2 files changed, 106 insertions(+), 7 deletions(-) diff --git a/Koha/Object.pm b/Koha/Object.pm index 34776a1..cf5cce48 100644 --- a/Koha/Object.pm +++ b/Koha/Object.pm @@ -23,6 +23,11 @@ use Carp; use Koha::Database; +use overload + '%{}' => \&_get_hashref, + '""' => \&_stringify, + ; + =head1 NAME Koha::Object - Koha Object base class @@ -53,10 +58,10 @@ Note that this cannot be used to retrieve record from the DB. sub new { my ( $class, $attributes ) = @_; - my $self = {}; + my $self = \{}; if ($attributes) { - $self->{_result} = + $$self->{_result} = Koha::Database->new()->schema()->resultset( $class->type() ) ->new($attributes); } @@ -229,10 +234,10 @@ sub _result { my ($self) = @_; # If we don't have a dbic row at this point, we need to create an empty one - $self->{_result} ||= + $$self->{_result} ||= Koha::Database->new()->schema()->resultset( $self->type() )->new({}); - return $self->{_result}; + return $$self->{_result}; } =head3 $object->_columns(); @@ -245,9 +250,9 @@ sub _columns { my ($self) = @_; # If we don't have a dbic row at this point, we need to create an empty one - $self->{_columns} ||= [ $self->_result()->result_source()->columns() ]; + $$self->{_columns} ||= [ $self->_result()->result_source()->columns() ]; - return $self->{_columns}; + return $$self->{_columns}; } @@ -279,6 +284,96 @@ sub AUTOLOAD { return; } +=head3 _get_hashref + +This method is used to overload the perl hash dereferencing operator for this class + +=cut + +sub _get_hashref { + my $self = shift; + + tie my %h, ref $self, $self; + + return \%h; +} + +=head3 _stringify + +This method is used to overload the perl string conversion operator for this class + +=cut + +sub _stringify { + return ref( $_[0] ); +} + +=head3 TIEHASH + +This method returns our object so Perl treats it has a hashref + +=cut + +sub TIEHASH { + my ( $package, $self ) = @_; + return $self; +} + +=head3 STORE + +This method is used when setting a value by treating our object as a hashref. + +This allows + +$object->{key} = $value; + +to be equivilent to + +$object->key($value); + +If the key is not a db column, it is simply stored in the object for later retrieval. + +=cut + +sub STORE { + my ( $self, $key, $value ) = @_; + + if ( $self->_result()->can($key) ) { + $self->_result()->set_column( $key, $value ); + } + else { + $$self->{$key} = $value; + } +} + +=head3 FETCH + +This method is used when fetching a value by treating our object as a heashref. + +This allows + +my $value = $object->{key}; + +to be equivilent to + +my $value = $object->key(); + +If the key is a db column, that value is retrieved, +otherwise the object's hashref is accessed to retrieve the value + +=cut + +sub FETCH { + my ( $self, $key ) = @_; + + if ( $self->_result()->can($key) ) { + return $self->_result()->get_column($key); + } + else { + return $$self->{$key}; + } +} + =head3 type This method must be defined in the child class. The value is the name of the DBIC resultset. diff --git a/t/db_dependent/Borrower.t b/t/db_dependent/Borrower.t index c619754..bacbbcb 100755 --- a/t/db_dependent/Borrower.t +++ b/t/db_dependent/Borrower.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 13; +use Test::More tests => 15; use Test::Warn; use C4::Context; @@ -64,6 +64,10 @@ is( $object->is_changed(), 1, "Object is changed after Set" ); $object->store(); is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" ); +is( $object->{firstname}, 'Test Firstname', 'Got first name using object as hashref' ); +$object->{firstname} = 'Test Firstname 2'; +is( $object->firstname, 'Test Firstname 2', 'Set first name using object as hashref' ); + $object->delete(); $borrower = $schema->resultset('Borrower')->find( $borrowernumber ); ok( ! $borrower, "Object no longer found in database" ); -- 2.1.4