From c0f6d04c54c30a20ad921d5982292c414445cb62 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Tue, 30 Sep 2014 15:05:30 -0400 Subject: [PATCH] Bug 12892 - Add Koha::Object, Koha::Objects and unit tests This patch adds the base classes upon which we can build new Koha classes to give us smarter, simpler code. Test Plan: 1) Apply this patch 2) prove t/Object.t t/db_dependent/Object.t t/db_dependent/Objects.t --- Koha/Borrower.pm | 52 ++++++++++ Koha/Borrowers.pm | 58 +++++++++++ Koha/Object.pm | 255 ++++++++++++++++++++++++++++++++++++++++++++++ Koha/Objects.pm | 152 +++++++++++++++++++++++++++ t/Object.t | 57 ++++++++++ t/db_dependent/Object.t | 70 +++++++++++++ t/db_dependent/Objects.t | 77 ++++++++++++++ 7 files changed, 721 insertions(+), 0 deletions(-) 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/Object.t create mode 100755 t/db_dependent/Object.t create mode 100755 t/db_dependent/Objects.t diff --git a/Koha/Borrower.pm b/Koha/Borrower.pm new file mode 100644 index 0000000..a266e82 --- /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..41efdb6 --- /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 ObjectClass { + 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..3e6fced --- /dev/null +++ b/Koha/Object.pm @@ -0,0 +1,255 @@ +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); +my $object = Koha::Object->new($dbic_result); + +=cut + +sub new { + my ($class) = shift; + my $self = {}; + + while ( my $var = shift ) { + if ( ref($var) eq 'HASH' ) { + + # hashref of attributes + croak "Already passed in a DBIC Row!" if $self->{result}; + + $self->{result} ||= + Koha::Database->new()->schema()->resultset( $class->Type() ) + ->new($var); + } + elsif ( ref($var) =~ /^Koha::Schema::Result/ ) { + + # DBIC result row + croak "Already passed in a hashref of attributes!" + if $self->{result}; + + $self->{result} = $var; + } + + } + + croak("No type found! Koha::Object must be subclassed!") + unless $class->Type(); + + # 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( $class->Type() )->new( {} ); + + $self->{columns} = [ $self->{result}->result_source()->columns() ]; + + croak( "DBIC Result type 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 + -1 if the object was unchanged from in storage + +=cut + +sub Store { + my ($self) = @_; + + return -1 if ( $self->{result}->in_storage() && !$self->{result}->is_changed() ); + + return $self->{result}->update_or_insert() ? 1 : 0; +} + +=head3 $object->IsStore(); + +Returns true if the object has been previously stored. + +=cut + +sub IsStored { + my ($self) = @_; + + return $self->{result}->in_storage(); +} + +=head3 $object->IsChanged(); + +Returns true if the object has properties that are different from +the properties of the object in storage. + +=cut + +sub IsChanged { + 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 ) = @_; + + foreach my $p ( keys %$properties ) { + unless ( $p ~~ $self->{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 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/.*://; + + # Using direct setter/getter like $item->barcode() or $item->barcode($barcode); + if ( $method ~~ $self->{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..37d898b --- /dev/null +++ b/Koha/Objects.pm @@ -0,0 +1,152 @@ +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 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) = shift; + my $self = {}; + $self->{objects} = []; + + $self->{resultset} = + Koha::Database->new()->schema()->resultset( $class->Type() ); + + 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->ObjectClass()->new( $result ); + + return $object; +} + +=head3 Koha::Objects->Search(); + +my @objects = Koha::Object->Search($params); + +=cut + +sub Search { + my ( $self, $params ) = @_; + + my @dbic_rows = $self->{resultset}->search($params); + + my @objects = $self->_Wrap( @dbic_rows ); + + return wantarray ? @objects : \@objects; +} + +=head3 Koha::Objects->Count(); + +my @objects = Koha::Object->Count($params); + +=cut + +sub Count { + my ( $self, $params ) = @_; + + return $self->{resultset}->count($params); +} + +=head3 Koha::Objects->_Wrap + +Wraps the DBIC object in a corrosponding Koha object + +=cut + +sub _Wrap { + my ( $self, @dbic_rows ) = @_; + + my @objects = map { $self->ObjectClass()->new( $_ ) } @dbic_rows; + + return @objects; +} + +=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 ObjectClass + +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, ObjectClass should return 'Koha::Hold'. + +=cut + +sub ObjectClass { } + +sub DESTROY { } + +=head1 AUTHOR + +Kyle M Hall + +=cut + +1; diff --git a/t/Object.t b/t/Object.t new file mode 100755 index 0000000..ec3fcab --- /dev/null +++ b/t/Object.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( $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/Object.t b/t/db_dependent/Object.t new file mode 100755 index 0000000..95cac1a --- /dev/null +++ b/t/db_dependent/Object.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->IsStored, 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->IsStored, 1, "Object is now stored" ); + +is( $object->IsChanged(), 0, "Object is unchanged" ); +$object->surname("Test Surname 2"); +is( $object->IsChanged(), 1, "Object is changed" ); + +$object->Store(); +is( $object->IsChanged(), 0, "Object no longer marked as changed after being stored" ); + +$object->Set({ firstname => 'Test Firstname' }); +is( $object->IsChanged(), 1, "Object is changed after Set" ); +$object->Store(); +is( $object->IsChanged(), 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->IsStored, 0, "Object is not in storage" ); + +1; diff --git a/t/db_dependent/Objects.t b/t/db_dependent/Objects.t new file mode 100755 index 0000000..24ecb0d --- /dev/null +++ b/t/db_dependent/Objects.t @@ -0,0 +1,77 @@ +#!/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::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" ); + +is( Koha::Borrowers->new()->Count( { branchcode => $branchcode } ), 3, "Counted 3 borrowers with Count" ); + +1; -- 1.7.2.5