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 <jonathan.druart@biblibre.com> Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
10 years ago · 6f0316a8d2
7 changed files with 855 additions and 0 deletions
--- a/Koha/Borrower.pm
+++ 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 <kyle@bywatersolutions.com>
+
+=cut
+
+1;
--- a/Koha/Borrowers.pm
+++ 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 <kyle@bywatersolutions.com>
+
+=cut
+
+1;
--- a/Koha/Object.pm
+++ 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 <kyle@bywatersolutions.com>
+
+=cut
+
+1;
--- a/Koha/Objects.pm
+++ 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 <kyle@bywatersolutions.com>
+
+=cut
+
+1;
--- a/t/Borrower.t
+++ 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 <http://www.gnu.org/licenses>.
+
+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;
--- a/t/db_dependent/Borrower.t
+++ 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 <http://www.gnu.org/licenses>.
+
+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;
--- a/t/db_dependent/Borrowers.t
+++ 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 <http://www.gnu.org/licenses>.
+
+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;