View | Details | Raw Unified | Return to bug 13019
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 ObjectClass {
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->IsStore();
112
113
Returns true if the object has been previously stored.
114
115
=cut
116
117
sub InStorage {
118
    my ($self) = @_;
119
120
    return $self->_Result()->in_storage();
121
}
122
123
=head3 $object->IsChanged();
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 IsChanged {
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 (+183 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 Modern::Perl;
21
22
use Carp;
23
24
use Koha::Database;
25
26
our $type;
27
28
=head1 NAME
29
30
Koha::Objects - Koha Object set base class
31
32
=head1 SYNOPSIS
33
34
    use Koha::Objects;
35
    my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
36
37
=head1 DESCRIPTION
38
39
This class must be subclassed.
40
41
=head1 API
42
43
=head2 Class Methods
44
45
=cut
46
47
=head3 Koha::Objects->new();
48
49
my $object = Koha::Object->new();
50
51
=cut
52
53
sub new {
54
    my ($class) = shift;
55
    my $self = {};
56
57
    bless( $self, $class );
58
}
59
60
=head3 Koha::Objects->new_from_dbic();
61
62
my $object = Koha::Object->new_from_dbic( $resultset );
63
64
=cut
65
66
sub new_from_dbic {
67
    my ( $class, $resultset ) = shift;
68
    my $self = { _resultset => $resultset };
69
70
    bless( $self, $class );
71
}
72
73
=head3 Koha::Objects->Find();
74
75
my $object = Koha::Object->Find($id);
76
my $object = Koha::Object->Find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
77
78
=cut
79
80
sub Find {
81
    my ( $self, $id ) = @_;
82
83
    my $result = $self->_ResultSet()->find($id);
84
85
    my $object = $self->ObjectClass()->new_from_dbic( $result );
86
87
    return $object;
88
}
89
90
=head3 Koha::Objects->Search();
91
92
my @objects = Koha::Object->Search($params);
93
94
=cut
95
96
sub Search {
97
    my ( $self, $params ) = @_;
98
99
    if (wantarray) {
100
        my @dbic_rows = $self->_ResultSet()->search($params);
101
102
        return $self->_Wrap(@dbic_rows);
103
104
    }
105
    else {
106
        my $class = ref( $self );
107
        my $rs = $self->_ResultSet()->search($params);
108
109
        return $class->new_from_dbic($rs);
110
    }
111
}
112
113
=head3 Koha::Objects->Count();
114
115
my @objects = Koha::Object->Count($params);
116
117
=cut
118
119
sub Count {
120
    my ( $self, $params ) = @_;
121
122
    return $self->_ResultSet()->count($params);
123
}
124
125
=head3 Koha::Objects->_Wrap
126
127
Wraps the DBIC object in a corrosponding Koha object
128
129
=cut
130
131
sub _Wrap {
132
    my ( $self, @dbic_rows ) = @_;
133
134
    my @objects = map { $self->ObjectClass()->new_from_dbic( $_ ) } @dbic_rows;
135
136
    return @objects;
137
}
138
139
=head3 Koha::Objects->_ResultSet
140
141
Returns the internal resultset or creates it if undefined
142
143
=cut
144
145
sub _ResultSet {
146
    my ($self) = @_;
147
148
    $self->{_resultset} ||=
149
      Koha::Database->new()->schema()->resultset( $self->Type() );
150
151
    $self->{_resultset};
152
}
153
154
=head3 Type
155
156
The type method must be set for all child classes.
157
The value returned by it should be the DBIC resultset name.
158
For example, for holds, Type should return 'Reserve'.
159
160
=cut
161
162
sub Type { }
163
164
=head3 ObjectClass
165
166
This method must be set for all child classes.
167
The value returned by it should be the name of the Koha
168
object class that is returned by this class.
169
For example, for holds, ObjectClass should return 'Koha::Hold'.
170
171
=cut
172
173
sub ObjectClass { }
174
175
sub DESTROY { }
176
177
=head1 AUTHOR
178
179
Kyle M Hall <kyle@bywatersolutions.com>
180
181
=cut
182
183
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->InStorage, 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->InStorage, 1, "Object is now stored" );
52
53
is( $object->IsChanged(), 0, "Object is unchanged" );
54
$object->surname("Test Surname 2");
55
is( $object->IsChanged(), 1, "Object is changed" );
56
57
$object->Store();
58
is( $object->IsChanged(), 0, "Object no longer marked as changed after being stored" );
59
60
$object->Set({ firstname => 'Test Firstname' });
61
is( $object->IsChanged(), 1, "Object is changed after Set" );
62
$object->Store();
63
is( $object->IsChanged(), 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->InStorage, 0, "Object is not in storage" );
69
70
1;
(-)a/t/db_dependent/Borrowers.t (-1 / +77 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 => 5;
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
is( Koha::Borrowers->new()->Count( { branchcode => $branchcode } ), 3, "Counted 3 borrowers with Count" );
76
77
1;

Return to bug 13019