Attachment #33416 for bug #10363

View | Details | Raw Unified | Return to bug 10363
Collapse All | Expand All




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;




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;




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;




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;




#!/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;




#!/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;




#!/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;

Return to bug 10363

Line 0 Link Here

(-)a/Koha/Borrower.pm (+52 lines)
	1	package Koha::Borrower;
	2
	3	# Copyright ByWater Solutions 2014
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha is free software; you can redistribute it and/or modify it under the
	8	# terms of the GNU General Public License as published by the Free Software
	9	# Foundation; either version 3 of the License, or (at your option) any later
	10	# version.
	11	#
	12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	15	#
	16	# You should have received a copy of the GNU General Public License along
	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	19
	20	use Modern::Perl;
	21
	22	use Carp;
	23
	24	use Koha::Database;
	25
	26	use base qw(Koha::Object);
	27
	28	=head1 NAME
	29
	30	Koha::Borrower - Koha Borrower Object class
	31
	32	=head1 API
	33
	34	=head2 Class Methods
	35
	36	=cut
	37
	38	=head3 type
	39
	40	=cut
	41
	42	sub type {
	43	return 'Borrower';
	44	}
	45
	46	=head1 AUTHOR
	47
	48	Kyle M Hall <kyle@bywatersolutions.com>
	49
	50	=cut
	51
	52	1;

Line 0 Link Here

(-)a/Koha/Borrowers.pm (+58 lines)
	1	package Koha::Borrowers;
	2
	3	# Copyright ByWater Solutions 2014
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha is free software; you can redistribute it and/or modify it under the
	8	# terms of the GNU General Public License as published by the Free Software
	9	# Foundation; either version 3 of the License, or (at your option) any later
	10	# version.
	11	#
	12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	15	#
	16	# You should have received a copy of the GNU General Public License along
	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	19
	20	use Modern::Perl;
	21
	22	use Carp;
	23
	24	use Koha::Database;
	25
	26	use Koha::Borrower;
	27
	28	use base qw(Koha::Objects);
	29
	30	=head1 NAME
	31
	32	Koha::Borrower - Koha Borrower Object class
	33
	34	=head1 API
	35
	36	=head2 Class Methods
	37
	38	=cut
	39
	40	=head3 type
	41
	42	=cut
	43
	44	sub type {
	45	return 'Borrower';
	46	}
	47
	48	sub object_class {
	49	return 'Koha::Borrower';
	50	}
	51
	52	=head1 AUTHOR
	53
	54	Kyle M Hall <kyle@bywatersolutions.com>
	55
	56	=cut
	57
	58	1;

Line 0 Link Here

(-)a/Koha/Object.pm (+285 lines)
		1	package Koha::Object;
		2
		3	# Copyright ByWater Solutions 2014
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21
		22	use Carp;
		23	use Encode qw{encode};
		24
		25	use Koha::Database;
		26
		27	=head1 NAME
		28
		29	Koha::Object - Koha Object base class
		30
		31	=head1 SYNOPSIS
		32
		33	use Koha::Object;
		34	my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
		35
		36	=head1 DESCRIPTION
		37
		38	This class must always be subclassed.
		39
		40	=head1 API
		41
		42	=head2 Class Methods
		43
		44	=cut
		45
		46	=head3 Koha::Object->new();
		47
		48	my $object = Koha::Object->new();
		49	my $object = Koha::Object->new($attributes);
		50
		51	=cut
		52
		53	sub new {
		54	my ( $class, $attributes ) = @_;
		55	my $self = {};
		56
		57	if ($attributes) {
		58	$self->{_result} =
		59	Koha::Database->new()->schema()->resultset( $class->type() )
		60	->new($attributes);
		61	}
		62
		63	croak("No type found! Koha::Object must be subclassed!")
		64	unless $class->type();
65
66	bless( $self, $class );
67
68	}
69
70	=head3 Koha::Object->new_from_dbic();
71
72	my $object = Koha::Object->new_from_dbic($dbic_row);
73
74	=cut
75
76	sub new_from_dbic {
77	my ( $class, $dbic_row ) = @_;
78	my $self = {};
79
80	# DBIC result row
81	$self->{_result} = $dbic_row;
82
83	croak("No type found! Koha::Object must be subclassed!")
84	unless $class->type();
85
86	croak( "DBIC result type " . ref( $self->{_result} ) . " isn't of the type " . $class->type() )
87	unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->type();
88
89	bless( $self, $class );
90
91	}
92
93	=head3 $object->store();
94
95	Saves the object in storage.
96	If the object is new, it will be created.
97	If the object previously existed, it will be updated.
98
99	Returns:
100	1 if the store was a success
101	0 if the store failed
102
103	=cut
104
105	sub store {
106	my ($self) = @_;
107
108	return $self->_result()->update_or_insert() ? 1 : 0;
109	}
110
111	=head3 $object->in_storage();
112
113	Returns true if the object has been previously stored.
114
115	=cut
116
117	sub in_storage {
118	my ($self) = @_;
119
120	return $self->_result()->in_storage();
121	}
122
123	=head3 $object->is_changed();
124
125	Returns true if the object has properties that are different from
126	the properties of the object in storage.
127
128	=cut
129
130	sub is_changed {
131	my ( $self, @columns ) = @_;
132
133	return $self->_result()->is_changed(@columns);
134	}
135
136	=head3 $object->delete();
137
138	Removes the object from storage.
139
140	Returns:
141	1 if the deletion was a success
142	0 if the deletion failed
143	-1 if the object was never in storage
144
145	=cut
146
147	sub delete {
148	my ($self) = @_;
149
150	# Deleting something not in storage thows an exception
151	return -1 unless $self->_result()->in_storage();
152
153	# Return a boolean for succcess
154	return $self->_result()->delete() ? 1 : 0;
155	}
156
157	=head3 $object->set( $properties_hashref )
158
159	$object->set(
160	{
161	property1 => $property1,
162	property2 => $property2,
163	property3 => $propery3,
164	}
165	);
166
167	Enables multiple properties to be set at once
168
169	Returns:
170	1 if all properties were set.
171	0 if one or more properties do not exist.
172	undef if all properties exist but a different error
173	prevents one or more properties from being set.
174
175	If one or more of the properties do not exist,
176	no properties will be set.
177
178	=cut
179
180	sub set {
181	my ( $self, $properties ) = @_;
182
183	my @columns = @{$self->_columns()};
184
185	foreach my $p ( keys %$properties ) {
186	unless ( $p ~~ @columns ) {
187	carp("No property $p!");
188	return 0;
189	}
190	}
191
192	return $self->_result()->set_columns($properties) ? 1 : undef;
193	}
194
195	=head3 $object->id();
196
197	Returns the id of the object if it has one.
198
199	=cut
200
201	sub id {
202	my ($self) = @_;
203
204	my ( $id ) = $self->_result()->id();
205
206	return $id;
207	}
208
209	=head3 $object->_result();
210
211	Returns the internal DBIC Row object
212
213	=cut
214
215	sub _result {
216	my ($self) = @_;
217
218	# If we don't have a dbic row at this point, we need to create an empty one
219	$self->{_result} \|\|=
220	Koha::Database->new()->schema()->resultset( $self->type() )->new({});
221
222	return $self->{_result};
223	}
224
225	=head3 $object->_columns();
226
227	Returns an arrayref of the table columns
228
229	=cut
230
231	sub _columns {
232	my ($self) = @_;
233
234	# If we don't have a dbic row at this point, we need to create an empty one
235	$self->{_columns} \|\|= [ $self->_result()->result_source()->columns() ];
236
237	return $self->{_columns};
238	}
239
240
241	=head3 AUTOLOAD
242
243	The autoload method is used only to get and set values for an objects properties.
244
245	=cut
246
247	sub AUTOLOAD {
248	my $self = shift;
249
250	my $method = our $AUTOLOAD;
251	$method =~ s/.*://;
252
253	my @columns = @{$self->_columns()};
254	# Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
255	if ( $method ~~ @columns ) {
256	if ( @_ ) {
257	return $self->_result()->set_column( $method, @_ );
258	} else {
259	my $value = $self->_result()->get_column( $method );
260	return encode( 'UTF-8', $value );
261	}
262	}
263
264	carp "No method $method!";
265	return;
266	}
267
268	=head3 type
269
270	This method must be defined in the child class. The value is the name of the DBIC resultset.
271	For example, for borrowers, the type method will return "Borrower".
272
273	=cut
274
275	sub type { }
276
277	sub DESTROY { }
278
279	=head1 AUTHOR
280
281	Kyle M Hall <kyle@bywatersolutions.com>
282
283	=cut
284
285	1;

Line 0 Link Here

(-)a/Koha/Objects.pm (+240 lines)
		1	package Koha::Objects;
		2
		3	# Copyright ByWater Solutions 2014
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use overload "0+" => "count", "<>" => "next", fallback => 1;
		21
		22	use Modern::Perl;
		23
		24	use Carp;
		25
		26	use Koha::Database;
		27
		28	our $type;
		29
		30	=head1 NAME
		31
		32	Koha::Objects - Koha Object set base class
		33
		34	=head1 SYNOPSIS
		35
		36	use Koha::Objects;
		37	my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
		38
		39	=head1 DESCRIPTION
		40
		41	This class must be subclassed.
		42
		43	=head1 API
		44
		45	=head2 Class Methods
		46
		47	=cut
		48
		49	=head3 Koha::Objects->new();
		50
		51	my $object = Koha::Object->new();
		52
		53	=cut
		54
		55	sub new {
		56	my ($class) = @_;
		57	my $self = {};
		58
		59	bless( $self, $class );
		60	}
		61
		62	=head3 Koha::Objects->new_from_dbic();
		63
		64	my $object = Koha::Object->new_from_dbic( $resultset );
65
66	=cut
67
68	sub new_from_dbic {
69	my ( $class, $resultset ) = @_;
70	my $self = { _resultset => $resultset };
71
72	bless( $self, $class );
73	}
74
75	=head3 Koha::Objects->find();
76
77	my $object = Koha::Object->find($id);
78	my $object = Koha::Object->find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
79
80	=cut
81
82	sub find {
83	my ( $self, $id ) = @_;
84
85	my $result = $self->_resultset()->find($id);
86
87	my $object = $self->object_class()->new_from_dbic( $result );
88
89	return $object;
90	}
91
92	=head3 Koha::Objects->search();
93
94	my @objects = Koha::Object->search($params);
95
96	=cut
97
98	sub search {
99	my ( $self, $params ) = @_;
100
101	if (wantarray) {
102	my @dbic_rows = $self->_resultset()->search($params);
103
104	return $self->_wrap(@dbic_rows);
105
106	}
107	else {
108	my $class = ref( $self );
109	my $rs = $self->_resultset()->search($params);
110
111	return $class->new_from_dbic($rs);
112	}
113	}
114
115	=head3 Koha::Objects->count();
116
117	my @objects = Koha::Object->count($params);
118
119	=cut
120
121	sub count {
122	my ( $self, $params ) = @_;
123
124	return $self->_resultset()->count($params);
125	}
126
127	=head3 Koha::Objects->next();
128
129	my $object = Koha::Object->next();
130
131	Returns the next object that is part of this set.
132	Returns undef if there are no more objects to return.
133
134	=cut
135
136	sub next {
137	my ( $self, $id ) = @_;
138
139	my $result = $self->_resultset()->next();
140	return unless $result;
141
142	my $object = $self->object_class()->new_from_dbic( $result );
143
144	return $object;
145	}
146
147	=head3 Koha::Objects->reset();
148
149	Koha::Objects->reset();
150
151	resets iteration so the next call to next() will start agein
152	with the first object in a set.
153
154	=cut
155
156	sub reset {
157	my ( $self, $id ) = @_;
158
159	$self->_resultset()->reset();
160
161	return $self;
162	}
163
164	=head3 Koha::Objects->as_list();
165
166	Koha::Objects->as_list();
167
168	Returns an arrayref of the objects in this set.
169
170	=cut
171
172	sub as_list {
173	my ( $self, $id ) = @_;
174
175	my @dbic_rows = $self->_resultset()->all();
176
177	my @objects = $self->_wrap(@dbic_rows);
178
179	return wantarray ? @objects : \@objects;
180	}
181
182	=head3 Koha::Objects->_wrap
183
184	wraps the DBIC object in a corrosponding Koha object
185
186	=cut
187
188	sub _wrap {
189	my ( $self, @dbic_rows ) = @_;
190
191	my @objects = map { $self->object_class()->new_from_dbic( $_ ) } @dbic_rows;
192
193	return @objects;
194	}
195
196	=head3 Koha::Objects->_resultset
197
198	Returns the internal resultset or creates it if undefined
199
200	=cut
201
202	sub _resultset {
203	my ($self) = @_;
204
205	$self->{_resultset} \|\|=
206	Koha::Database->new()->schema()->resultset( $self->type() );
207
208	$self->{_resultset};
209	}
210
211	=head3 type
212
213	The type method must be set for all child classes.
214	The value returned by it should be the DBIC resultset name.
215	For example, for holds, type should return 'Reserve'.
216
217	=cut
218
219	sub type { }
220
221	=head3 object_class
222
223	This method must be set for all child classes.
224	The value returned by it should be the name of the Koha
225	object class that is returned by this class.
226	For example, for holds, object_class should return 'Koha::Hold'.
227
228	=cut
229
230	sub object_class { }
231
232	sub DESTROY { }
233
234	=head1 AUTHOR
235
236	Kyle M Hall <kyle@bywatersolutions.com>
237
238	=cut
239
240	1;

Line 0 Link Here

(-)a/t/Borrower.t (+57 lines)
	1	#!/usr/bin/perl
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20	use Test::More tests => 13;
	21	use Test::Warn;
	22
	23	use Koha::Database;
	24
	25	BEGIN {
	26	use_ok('Koha::Object');
	27	use_ok('Koha::Borrower');
	28	}
	29
	30	my $result = Koha::Database->new()->schema()->resultset('Borrower')->new({ surname => 'Test Borrower' });
	31	my $object = Koha::Borrower->new_from_dbic( $result );
	32
	33	is( $object->surname(), 'Test Borrower', "Accessor returns correct value" );
	34
	35	$object->surname('Test Borrower Surname');
	36	is( $object->surname(), 'Test Borrower Surname', "Accessor returns correct value after set" );
	37
	38	my $object2 = Koha::Borrower->new( { surname => 'Test Borrower 2' } );
	39	is( $object2->surname(), 'Test Borrower 2', "Accessor returns correct value" );
	40
	41	$object2->surname('Test Borrower Surname 2');
	42	is( $object2->surname(), 'Test Borrower Surname 2', "Accessor returns correct value after set" );
	43
	44	my $ret;
	45	$ret = $object2->set({ surname => "Test Borrower Surname 3", firstname => "Test Firstname" });
	46	is( $ret, 1, "Set returns 1 on success" );
	47	is( $object2->surname(), "Test Borrower Surname 3", "Set sets first field correctly" );
	48	is( $object2->firstname(), "Test Firstname", "Set sets second field correctly" );
	49
	50	$ret = $object->set({ surname => "Test Borrower Surname 4", bork => "bork" });
	51	is( $object2->surname(), "Test Borrower Surname 3", "Bad Set does not set field" );
	52	is( $ret, 0, "Set returns 0 when passed a bad property" );
	53
	54	ok( ! defined $object->bork(), 'Bad getter returns undef' );
	55	ok( ! defined $object->bork('bork'), 'Bad setter returns undef' );
	56
	57	1;

Line 0 Link Here

(-)a/t/db_dependent/Borrower.t (+70 lines)
		1	#!/usr/bin/perl
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use Test::More tests => 12;
		21	use Test::Warn;
		22
		23	use C4::Context;
		24	use Koha::Database;
		25
		26	BEGIN {
		27	use_ok('Koha::Object');
		28	use_ok('Koha::Borrower');
		29	}
		30
		31	# Start transaction
		32	my $dbh = C4::Context->dbh;
		33	$dbh->{AutoCommit} = 0;
		34	$dbh->{RaiseError} = 1;
		35
		36	my $categorycode = Koha::Database->new()->schema()->resultset('Category')->first()->categorycode();
		37	my $branchcode = Koha::Database->new()->schema()->resultset('Branch')->first()->branchcode();
		38
		39	my $object = Koha::Borrower->new();
		40
		41	is( $object->in_storage, 0, "Object is not in storage" );
		42
		43	$object->categorycode( $categorycode );
		44	$object->branchcode( $branchcode );
		45	$object->surname("Test Surname");
		46	$object->store();
		47
		48	my $borrower = Koha::Database->new()->schema()->resultset('Borrower')->find( $object->borrowernumber() );
		49	is( $borrower->surname(), "Test Surname", "Object found in database" );
		50
		51	is( $object->in_storage, 1, "Object is now stored" );
		52
		53	is( $object->is_changed(), 0, "Object is unchanged" );
		54	$object->surname("Test Surname 2");
		55	is( $object->is_changed(), 1, "Object is changed" );
		56
		57	$object->store();
		58	is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
		59
		60	$object->set({ firstname => 'Test Firstname' });
		61	is( $object->is_changed(), 1, "Object is changed after Set" );
		62	$object->store();
		63	is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
		64
65	$object->delete();
66	$borrower = Koha::Database->new()->schema()->resultset('Borrower')->find( $object->borrowernumber() );
67	ok( ! $borrower, "Object no longer found in database" );
68	is( $object->in_storage, 0, "Object is not in storage" );
69
70	1;

Line 0 Link Here

(-)a/t/db_dependent/Borrowers.t (-1 / +93 lines)
0	-	1	#!/usr/bin/perl
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use Test::More tests => 12;
		21	use Test::Warn;
		22
		23	use C4::Context;
		24	use Koha::Database;
		25
		26	BEGIN {
		27	use_ok('Koha::Objects');
		28	use_ok('Koha::Borrowers');
		29	}
		30
		31	# Start transaction
		32	my $dbh = C4::Context->dbh;
		33	$dbh->{AutoCommit} = 0;
		34	$dbh->{RaiseError} = 1;
		35	$dbh->do("DELETE FROM issues");
		36	$dbh->do("DELETE FROM borrowers");
		37
		38	my $categorycode =
		39	Koha::Database->new()->schema()->resultset('Category')->first()
		40	->categorycode();
		41	my $branchcode =
		42	Koha::Database->new()->schema()->resultset('Branch')->first()->branchcode();
		43
		44	my $b1 = Koha::Borrower->new(
		45	{
		46	surname => 'Test 1',
		47	branchcode => $branchcode,
		48	categorycode => $categorycode
		49	}
		50	);
		51	$b1->store();
		52	my $b2 = Koha::Borrower->new(
		53	{
		54	surname => 'Test 2',
		55	branchcode => $branchcode,
		56	categorycode => $categorycode
		57	}
		58	);
		59	$b2->store();
		60	my $b3 = Koha::Borrower->new(
		61	{
		62	surname => 'Test 3',
		63	branchcode => $branchcode,
		64	categorycode => $categorycode
		65	}
66	);
67	$b3->store();
68
69	my $b1_new = Koha::Borrowers->new()->find( $b1->borrowernumber() );
70	is( $b1->surname(), $b1_new->surname(), "Found matching borrower" );
71
72	my @borrowers = Koha::Borrowers->new()->search( { branchcode => $branchcode } );
73	is( @borrowers, 3, "Found 3 borrowers with Search" );
74
75	my $borrowers = Koha::Borrowers->new()->search( { branchcode => $branchcode } );
76	is( $borrowers->count( { branchcode => $branchcode } ), 3, "Counted 3 borrowers with Count" );
77
78	my $b = $borrowers->next();
79	is( $b->surname(), 'Test 1', "Next returns first borrower" );
80	$b = $borrowers->next();
81	is( $b->surname(), 'Test 2', "Next returns second borrower" );
82	$b = $borrowers->next();
83	is( $b->surname(), 'Test 3', "Next returns third borrower" );
84	$b = $borrowers->next();
85	is( $b, undef, "Next returns undef" );
86
87	# Test Reset and iteration in concert
88	$borrowers->reset();
89	foreach my $b ( $borrowers->as_list() ) {
90	is( $b->categorycode(), $categorycode, "Iteration returns a borrower object" );
91	}
92
93	1;