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

(-)a/Koha/Borrower.pm (+52 lines)
Line 0 Link Here
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;
(-)a/Koha/Borrowers.pm (+58 lines)
Line 0 Link Here
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;
(-)a/Koha/Object.pm (+285 lines)
Line 0 Link Here
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;
(-)a/Koha/Objects.pm (+240 lines)
Line 0 Link Here
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;
(-)a/t/Borrower.t (+57 lines)
Line 0 Link Here
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;
(-)a/t/db_dependent/Borrower.t (+70 lines)
Line 0 Link Here
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;
(-)a/t/db_dependent/Borrowers.t (-1 / +93 lines)
Line 0 Link Here
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;

Return to bug 10363