--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
projects / koha_ffzg / commitdiff