From cd33ffbf366967095682ae4ab9fcabf8c35a3b66 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Tue, 30 Sep 2014 15:05:30 -0400 Subject: [PATCH] Bug 13019 - Add base classes on which to build Koha objects The idea behind this is to have a pair of base classes on which to build our new generation of Koha objects. Koha::Object is a base class, which in it's most basic form, is to represent a row in a table. For example, Koha::Borrower inherits from Koha::Object. So too could Koha::Biblio and Koha::Item for example. Koha::Objects is to represent a way to fetch and manipulate sets of objects. For example, Koha::Borrowers has a method to get a Koha::Borrower object by id and a method to search for an get a list of Koha::Borrower objects. Right now Koha::Objects has only the essentials but can easily be extended and those enhancements will be passed down to all the child classes based on it. By using these classes as a base, we will add consistency to our code, allow us to keep our code DRY, reduce bugs, and encapsulate our database access among other benefits. Test Plan: 1) Apply this patch 2) prove t/Object.t t/db_dependent/Object.t t/db_dependent/Objects.t Signed-off-by: Jonathan Druart http://bugs.koha-community.org/show_bug.cgi?id=10363 --- Koha/Borrower.pm | 52 +++++++++ Koha/Borrowers.pm | 58 +++++++++ Koha/Object.pm | 285 +++++++++++++++++++++++++++++++++++++++++++++ Koha/Objects.pm | 240 ++++++++++++++++++++++++++++++++++++++ t/Borrower.t | 57 +++++++++ t/db_dependent/Borrower.t | 70 +++++++++++ t/db_dependent/Borrowers.t | 93 +++++++++++++++ 7 files changed, 855 insertions(+) create mode 100644 Koha/Borrower.pm create mode 100644 Koha/Borrowers.pm create mode 100644 Koha/Object.pm create mode 100644 Koha/Objects.pm create mode 100755 t/Borrower.t create mode 100755 t/db_dependent/Borrower.t create mode 100755 t/db_dependent/Borrowers.t diff --git a/Koha/Borrower.pm b/Koha/Borrower.pm new file mode 100644 index 0000000..93426bf --- /dev/null +++ b/Koha/Borrower.pm @@ -0,0 +1,52 @@ +package Koha::Borrower; + +# Copyright ByWater Solutions 2014 +# +# 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Carp; + +use Koha::Database; + +use base qw(Koha::Object); + +=head1 NAME + +Koha::Borrower - Koha Borrower Object class + +=head1 API + +=head2 Class Methods + +=cut + +=head3 type + +=cut + +sub type { + return 'Borrower'; +} + +=head1 AUTHOR + +Kyle M Hall + +=cut + +1; diff --git a/Koha/Borrowers.pm b/Koha/Borrowers.pm new file mode 100644 index 0000000..9fb01f0 --- /dev/null +++ b/Koha/Borrowers.pm @@ -0,0 +1,58 @@ +package Koha::Borrowers; + +# Copyright ByWater Solutions 2014 +# +# 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Carp; + +use Koha::Database; + +use Koha::Borrower; + +use base qw(Koha::Objects); + +=head1 NAME + +Koha::Borrower - Koha Borrower Object class + +=head1 API + +=head2 Class Methods + +=cut + +=head3 type + +=cut + +sub type { + return 'Borrower'; +} + +sub object_class { + return 'Koha::Borrower'; +} + +=head1 AUTHOR + +Kyle M Hall + +=cut + +1; diff --git a/Koha/Object.pm b/Koha/Object.pm new file mode 100644 index 0000000..d1e0455 --- /dev/null +++ b/Koha/Object.pm @@ -0,0 +1,285 @@ +package Koha::Object; + +# Copyright ByWater Solutions 2014 +# +# 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Carp; +use Encode qw{encode}; + +use Koha::Database; + +=head1 NAME + +Koha::Object - Koha Object base class + +=head1 SYNOPSIS + + use Koha::Object; + my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } ); + +=head1 DESCRIPTION + +This class must always be subclassed. + +=head1 API + +=head2 Class Methods + +=cut + +=head3 Koha::Object->new(); + +my $object = Koha::Object->new(); +my $object = Koha::Object->new($attributes); + +=cut + +sub new { + my ( $class, $attributes ) = @_; + my $self = {}; + + if ($attributes) { + $self->{_result} = + Koha::Database->new()->schema()->resultset( $class->type() ) + ->new($attributes); + } + + croak("No type found! Koha::Object must be subclassed!") + unless $class->type(); + + bless( $self, $class ); + +} + +=head3 Koha::Object->new_from_dbic(); + +my $object = Koha::Object->new_from_dbic($dbic_row); + +=cut + +sub new_from_dbic { + my ( $class, $dbic_row ) = @_; + my $self = {}; + + # DBIC result row + $self->{_result} = $dbic_row; + + croak("No type found! Koha::Object must be subclassed!") + unless $class->type(); + + croak( "DBIC result type " . ref( $self->{_result} ) . " isn't of the type " . $class->type() ) + unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->type(); + + bless( $self, $class ); + +} + +=head3 $object->store(); + +Saves the object in storage. +If the object is new, it will be created. +If the object previously existed, it will be updated. + +Returns: + 1 if the store was a success + 0 if the store failed + +=cut + +sub store { + my ($self) = @_; + + return $self->_result()->update_or_insert() ? 1 : 0; +} + +=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. + +Returns: + 1 if the deletion was a success + 0 if the deletion failed + -1 if the object was never in storage + +=cut + +sub delete { + my ($self) = @_; + + # Deleting something not in storage thows an exception + return -1 unless $self->_result()->in_storage(); + + # Return a boolean for succcess + return $self->_result()->delete() ? 1 : 0; +} + +=head3 $object->set( $properties_hashref ) + +$object->set( + { + property1 => $property1, + property2 => $property2, + property3 => $propery3, + } +); + +Enables multiple properties to be set at once + +Returns: + 1 if all properties were set. + 0 if one or more properties do not exist. + undef if all properties exist but a different error + prevents one or more properties from being set. + +If one or more of the properties do not exist, +no properties will be set. + +=cut + +sub set { + my ( $self, $properties ) = @_; + + my @columns = @{$self->_columns()}; + + foreach my $p ( keys %$properties ) { + unless ( $p ~~ @columns ) { + carp("No property $p!"); + return 0; + } + } + + return $self->_result()->set_columns($properties) ? 1 : 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->_result(); + +Returns the internal DBIC Row object + +=cut + +sub _result { + my ($self) = @_; + + # If we don't have a dbic row at this point, we need to create an empty one + $self->{_result} ||= + Koha::Database->new()->schema()->resultset( $self->type() )->new({}); + + return $self->{_result}; +} + +=head3 $object->_columns(); + +Returns an arrayref of the table columns + +=cut + +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() ]; + + return $self->{_columns}; +} + + +=head3 AUTOLOAD + +The autoload method is used only to get and set values for an objects properties. + +=cut + +sub AUTOLOAD { + my $self = shift; + + my $method = our $AUTOLOAD; + $method =~ s/.*://; + + my @columns = @{$self->_columns()}; + # Using direct setter/getter like $item->barcode() or $item->barcode($barcode); + if ( $method ~~ @columns ) { + if ( @_ ) { + return $self->_result()->set_column( $method, @_ ); + } else { + my $value = $self->_result()->get_column( $method ); + return encode( 'UTF-8', $value ); + } + } + + carp "No method $method!"; + return; +} + +=head3 type + +This method must be defined in the child class. The value is the name of the DBIC resultset. +For example, for borrowers, the type method will return "Borrower". + +=cut + +sub type { } + +sub DESTROY { } + +=head1 AUTHOR + +Kyle M Hall + +=cut + +1; diff --git a/Koha/Objects.pm b/Koha/Objects.pm new file mode 100644 index 0000000..1eaf2be --- /dev/null +++ b/Koha/Objects.pm @@ -0,0 +1,240 @@ +package Koha::Objects; + +# Copyright ByWater Solutions 2014 +# +# 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use overload "0+" => "count", "<>" => "next", fallback => 1; + +use Modern::Perl; + +use Carp; + +use Koha::Database; + +our $type; + +=head1 NAME + +Koha::Objects - Koha Object set base class + +=head1 SYNOPSIS + + use Koha::Objects; + my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber}); + +=head1 DESCRIPTION + +This class must be subclassed. + +=head1 API + +=head2 Class Methods + +=cut + +=head3 Koha::Objects->new(); + +my $object = Koha::Object->new(); + +=cut + +sub new { + my ($class) = @_; + my $self = {}; + + bless( $self, $class ); +} + +=head3 Koha::Objects->new_from_dbic(); + +my $object = Koha::Object->new_from_dbic( $resultset ); + +=cut + +sub new_from_dbic { + my ( $class, $resultset ) = @_; + my $self = { _resultset => $resultset }; + + bless( $self, $class ); +} + +=head3 Koha::Objects->find(); + +my $object = Koha::Object->find($id); +my $object = Koha::Object->find( { keypart1 => $keypart1, keypart2 => $keypart2 } ); + +=cut + +sub find { + my ( $self, $id ) = @_; + + my $result = $self->_resultset()->find($id); + + my $object = $self->object_class()->new_from_dbic( $result ); + + return $object; +} + +=head3 Koha::Objects->search(); + +my @objects = Koha::Object->search($params); + +=cut + +sub search { + my ( $self, $params ) = @_; + + if (wantarray) { + my @dbic_rows = $self->_resultset()->search($params); + + return $self->_wrap(@dbic_rows); + + } + else { + my $class = ref( $self ); + my $rs = $self->_resultset()->search($params); + + return $class->new_from_dbic($rs); + } +} + +=head3 Koha::Objects->count(); + +my @objects = Koha::Object->count($params); + +=cut + +sub count { + my ( $self, $params ) = @_; + + return $self->_resultset()->count($params); +} + +=head3 Koha::Objects->next(); + +my $object = Koha::Object->next(); + +Returns the next object that is part of this set. +Returns undef if there are no more objects to return. + +=cut + +sub next { + my ( $self, $id ) = @_; + + my $result = $self->_resultset()->next(); + return unless $result; + + my $object = $self->object_class()->new_from_dbic( $result ); + + return $object; +} + +=head3 Koha::Objects->reset(); + +Koha::Objects->reset(); + +resets iteration so the next call to next() will start agein +with the first object in a set. + +=cut + +sub reset { + my ( $self, $id ) = @_; + + $self->_resultset()->reset(); + + return $self; +} + +=head3 Koha::Objects->as_list(); + +Koha::Objects->as_list(); + +Returns an arrayref of the objects in this set. + +=cut + +sub as_list { + my ( $self, $id ) = @_; + + my @dbic_rows = $self->_resultset()->all(); + + my @objects = $self->_wrap(@dbic_rows); + + return wantarray ? @objects : \@objects; +} + +=head3 Koha::Objects->_wrap + +wraps the DBIC object in a corrosponding Koha object + +=cut + +sub _wrap { + my ( $self, @dbic_rows ) = @_; + + my @objects = map { $self->object_class()->new_from_dbic( $_ ) } @dbic_rows; + + return @objects; +} + +=head3 Koha::Objects->_resultset + +Returns the internal resultset or creates it if undefined + +=cut + +sub _resultset { + my ($self) = @_; + + $self->{_resultset} ||= + Koha::Database->new()->schema()->resultset( $self->type() ); + + $self->{_resultset}; +} + +=head3 type + +The type method must be set for all child classes. +The value returned by it should be the DBIC resultset name. +For example, for holds, type should return 'Reserve'. + +=cut + +sub type { } + +=head3 object_class + +This method must be set for all child classes. +The value returned by it should be the name of the Koha +object class that is returned by this class. +For example, for holds, object_class should return 'Koha::Hold'. + +=cut + +sub object_class { } + +sub DESTROY { } + +=head1 AUTHOR + +Kyle M Hall + +=cut + +1; diff --git a/t/Borrower.t b/t/Borrower.t new file mode 100755 index 0000000..a1fb190 --- /dev/null +++ b/t/Borrower.t @@ -0,0 +1,57 @@ +#!/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 Koha::Database; + +BEGIN { + use_ok('Koha::Object'); + use_ok('Koha::Borrower'); +} + +my $result = Koha::Database->new()->schema()->resultset('Borrower')->new({ surname => 'Test Borrower' }); +my $object = Koha::Borrower->new_from_dbic( $result ); + +is( $object->surname(), 'Test Borrower', "Accessor returns correct value" ); + +$object->surname('Test Borrower Surname'); +is( $object->surname(), 'Test Borrower Surname', "Accessor returns correct value after set" ); + +my $object2 = Koha::Borrower->new( { surname => 'Test Borrower 2' } ); +is( $object2->surname(), 'Test Borrower 2', "Accessor returns correct value" ); + +$object2->surname('Test Borrower Surname 2'); +is( $object2->surname(), 'Test Borrower Surname 2', "Accessor returns correct value after set" ); + +my $ret; +$ret = $object2->set({ surname => "Test Borrower Surname 3", firstname => "Test Firstname" }); +is( $ret, 1, "Set returns 1 on success" ); +is( $object2->surname(), "Test Borrower Surname 3", "Set sets first field correctly" ); +is( $object2->firstname(), "Test Firstname", "Set sets second field correctly" ); + +$ret = $object->set({ surname => "Test Borrower Surname 4", bork => "bork" }); +is( $object2->surname(), "Test Borrower Surname 3", "Bad Set does not set field" ); +is( $ret, 0, "Set returns 0 when passed a bad property" ); + +ok( ! defined $object->bork(), 'Bad getter returns undef' ); +ok( ! defined $object->bork('bork'), 'Bad setter returns undef' ); + +1; diff --git a/t/db_dependent/Borrower.t b/t/db_dependent/Borrower.t new file mode 100755 index 0000000..620b6ff --- /dev/null +++ b/t/db_dependent/Borrower.t @@ -0,0 +1,70 @@ +#!/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 => 12; +use Test::Warn; + +use C4::Context; +use Koha::Database; + +BEGIN { + use_ok('Koha::Object'); + use_ok('Koha::Borrower'); +} + +# Start transaction +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +my $categorycode = Koha::Database->new()->schema()->resultset('Category')->first()->categorycode(); +my $branchcode = Koha::Database->new()->schema()->resultset('Branch')->first()->branchcode(); + +my $object = Koha::Borrower->new(); + +is( $object->in_storage, 0, "Object is not in storage" ); + +$object->categorycode( $categorycode ); +$object->branchcode( $branchcode ); +$object->surname("Test Surname"); +$object->store(); + +my $borrower = Koha::Database->new()->schema()->resultset('Borrower')->find( $object->borrowernumber() ); +is( $borrower->surname(), "Test Surname", "Object found in database" ); + +is( $object->in_storage, 1, "Object is now stored" ); + +is( $object->is_changed(), 0, "Object is 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(); +$borrower = Koha::Database->new()->schema()->resultset('Borrower')->find( $object->borrowernumber() ); +ok( ! $borrower, "Object no longer found in database" ); +is( $object->in_storage, 0, "Object is not in storage" ); + +1; diff --git a/t/db_dependent/Borrowers.t b/t/db_dependent/Borrowers.t new file mode 100755 index 0000000..8d47ce7 --- /dev/null +++ b/t/db_dependent/Borrowers.t @@ -0,0 +1,93 @@ +#!/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 => 12; +use Test::Warn; + +use C4::Context; +use Koha::Database; + +BEGIN { + use_ok('Koha::Objects'); + use_ok('Koha::Borrowers'); +} + +# Start transaction +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; +$dbh->do("DELETE FROM issues"); +$dbh->do("DELETE FROM borrowers"); + +my $categorycode = + Koha::Database->new()->schema()->resultset('Category')->first() + ->categorycode(); +my $branchcode = + Koha::Database->new()->schema()->resultset('Branch')->first()->branchcode(); + +my $b1 = Koha::Borrower->new( + { + surname => 'Test 1', + branchcode => $branchcode, + categorycode => $categorycode + } +); +$b1->store(); +my $b2 = Koha::Borrower->new( + { + surname => 'Test 2', + branchcode => $branchcode, + categorycode => $categorycode + } +); +$b2->store(); +my $b3 = Koha::Borrower->new( + { + surname => 'Test 3', + branchcode => $branchcode, + categorycode => $categorycode + } +); +$b3->store(); + +my $b1_new = Koha::Borrowers->new()->find( $b1->borrowernumber() ); +is( $b1->surname(), $b1_new->surname(), "Found matching borrower" ); + +my @borrowers = Koha::Borrowers->new()->search( { branchcode => $branchcode } ); +is( @borrowers, 3, "Found 3 borrowers with Search" ); + +my $borrowers = Koha::Borrowers->new()->search( { branchcode => $branchcode } ); +is( $borrowers->count( { branchcode => $branchcode } ), 3, "Counted 3 borrowers with Count" ); + +my $b = $borrowers->next(); +is( $b->surname(), 'Test 1', "Next returns first borrower" ); +$b = $borrowers->next(); +is( $b->surname(), 'Test 2', "Next returns second borrower" ); +$b = $borrowers->next(); +is( $b->surname(), 'Test 3', "Next returns third borrower" ); +$b = $borrowers->next(); +is( $b, undef, "Next returns undef" ); + +# Test Reset and iteration in concert +$borrowers->reset(); +foreach my $b ( $borrowers->as_list() ) { + is( $b->categorycode(), $categorycode, "Iteration returns a borrower object" ); +} + +1; -- 2.1.0