From d2510f3e76b1b24ad473944d96141cc0f7a643d4 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 30 Aug 2016 16:13:21 +0100 Subject: [PATCH] Bug 17226: Improve Koha::Object's AUTOLOAD method Following the path of bug 17091, Koha::Object needs to AUTOLOAD the methods provided by DBIX::Class. We already use in_storage, id and is_changed, but others are coming! Test plan: prove t/db_dependent/Koha/Object.t should return green Signed-off-by: Claire Gravely Signed-off-by: Brendan Gallagher --- Koha/Object.pm | 54 ++++++---------------- t/db_dependent/Koha/Object.t | 87 ++++++++++++++++++++++++++++++++++++ t/db_dependent/Patron.t | 72 ----------------------------- 3 files changed, 100 insertions(+), 113 deletions(-) create mode 100755 t/db_dependent/Koha/Object.t delete mode 100755 t/db_dependent/Patron.t diff --git a/Koha/Object.pm b/Koha/Object.pm index 9d23fb421e..a82f80e61a 100644 --- a/Koha/Object.pm +++ b/Koha/Object.pm @@ -1,6 +1,7 @@ package Koha::Object; # Copyright ByWater Solutions 2014 +# Copyright 2016 Koha Development Team # # This file is part of Koha. # @@ -109,31 +110,6 @@ sub store { return $self->_result()->update_or_insert() ? $self : undef; } -=head3 $object->in_storage(); - -Returns true if the object has been previously stored. - -=cut - -sub in_storage { - my ($self) = @_; - - return $self->_result()->in_storage(); -} - -=head3 $object->is_changed(); - -Returns true if the object has properties that are different from -the properties of the object in storage. - -=cut - -sub is_changed { - my ( $self, @columns ) = @_; - - return $self->_result()->is_changed(@columns); -} - =head3 $object->delete(); Removes the object from storage. @@ -193,20 +169,6 @@ sub set { return $self->_result()->set_columns($properties) ? $self : undef; } -=head3 $object->id(); - -Returns the id of the object if it has one. - -=cut - -sub id { - my ($self) = @_; - - my ( $id ) = $self->_result()->id(); - - return $id; -} - =head3 $object->unblessed(); Returns an unblessed representation of object. @@ -275,8 +237,16 @@ sub AUTOLOAD { } } - carp "No method $method!"; - return; + my @known_methods = qw( is_changed id in_storage ); + + carp "The method $method is not covered by tests or does not exist!" and return unless grep {/^$method$/} @known_methods; + + my $r = eval { $self->_result->$method(@_) }; + if ( $@ ) { + carp "No method $method found for " . ref($self) . " " . $@; + return + } + return $r; } =head3 _type @@ -294,6 +264,8 @@ sub DESTROY { } Kyle M Hall +Jonathan Druart + =cut 1; diff --git a/t/db_dependent/Koha/Object.t b/t/db_dependent/Koha/Object.t new file mode 100755 index 0000000000..a8eadedfc2 --- /dev/null +++ b/t/db_dependent/Koha/Object.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use Test::More tests => 5; +use Test::Warn; + +use C4::Context; +use Koha::Database; + +BEGIN { + use_ok('Koha::Object'); + use_ok('Koha::Patron'); +} + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; + +my $categorycode = $schema->resultset('Category')->first()->categorycode(); +my $branchcode = $schema->resultset('Branch')->first()->branchcode(); + +subtest 'is_changed' => sub { + plan tests => 6; + my $object = Koha::Patron->new(); + $object->categorycode( $categorycode ); + $object->branchcode( $branchcode ); + $object->surname("Test Surname"); + $object->store(); + is( $object->is_changed(), 0, "Object is unchanged" ); + $object->surname("Test Surname"); + is( $object->is_changed(), 0, "Object is still unchanged" ); + $object->surname("Test Surname 2"); + is( $object->is_changed(), 1, "Object is changed" ); + + $object->store(); + is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" ); + + $object->set({ firstname => 'Test Firstname' }); + 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" ); +}; + +subtest 'in_storage' => sub { + plan tests => 6; + my $object = Koha::Patron->new(); + is( $object->in_storage, 0, "Object is not in storage" ); + $object->categorycode( $categorycode ); + $object->branchcode( $branchcode ); + $object->surname("Test Surname"); + $object->store(); + is( $object->in_storage, 1, "Object is now stored" ); + $object->surname("another surname"); + is( $object->in_storage, 1 ); + + my $borrowernumber = $object->borrowernumber; + my $patron = $schema->resultset('Borrower')->find( $borrowernumber ); + is( $patron->surname(), "Test Surname", "Object found in database" ); + + $object->delete(); + $patron = $schema->resultset('Borrower')->find( $borrowernumber ); + ok( ! $patron, "Object no longer found in database" ); + is( $object->in_storage, 0, "Object is not in storage" ); +}; + +subtest 'id' => sub { + plan tests => 1; + my $patron = Koha::Patron->new({categorycode => $categorycode, branchcode => $branchcode })->store; + is( $patron->id, $patron->borrowernumber ); +}; + +1; diff --git a/t/db_dependent/Patron.t b/t/db_dependent/Patron.t deleted file mode 100755 index 11c57fed13..0000000000 --- a/t/db_dependent/Patron.t +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/perl - -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# Koha is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with Koha; if not, see . - -use Modern::Perl; - -use Test::More tests => 13; -use Test::Warn; - -use C4::Context; -use Koha::Database; - -BEGIN { - use_ok('Koha::Object'); - use_ok('Koha::Patron'); -} - -my $schema = Koha::Database->new->schema; -$schema->storage->txn_begin; - -my $categorycode = $schema->resultset('Category')->first()->categorycode(); -my $branchcode = $schema->resultset('Branch')->first()->branchcode(); - -my $object = Koha::Patron->new(); - -is( $object->in_storage, 0, "Object is not in storage" ); - -$object->categorycode( $categorycode ); -$object->branchcode( $branchcode ); -$object->surname("Test Surname"); -$object->store(); - -is( $object->in_storage, 1, "Object is now stored" ); - -my $borrowernumber = $object->borrowernumber; - -my $patron = $schema->resultset('Borrower')->find( $borrowernumber ); -is( $patron->surname(), "Test Surname", "Object found in database" ); - -is( $object->is_changed(), 0, "Object is unchanged" ); -$object->surname("Test Surname"); -is( $object->is_changed(), 0, "Object is still unchanged" ); -$object->surname("Test Surname 2"); -is( $object->is_changed(), 1, "Object is changed" ); - -$object->store(); -is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" ); - -$object->set({ firstname => 'Test Firstname' }); -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" ); - -$object->delete(); -$patron = $schema->resultset('Borrower')->find( $borrowernumber ); -ok( ! $patron, "Object no longer found in database" ); -is( $object->in_storage, 0, "Object is not in storage" ); - -1; -- 2.39.5