Browse Source

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>
3.20.x
Kyle Hall 8 years ago
committed by Tomas Cohen Arazi
parent
commit
6f0316a8d2
  1. 52
      Koha/Borrower.pm
  2. 58
      Koha/Borrowers.pm
  3. 285
      Koha/Object.pm
  4. 240
      Koha/Objects.pm
  5. 57
      t/Borrower.t
  6. 70
      t/db_dependent/Borrower.t
  7. 93
      t/db_dependent/Borrowers.t

52
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;

58
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;

285
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;

240
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;

57
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;

70
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;

93
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;
Loading…
Cancel
Save