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 (+286 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 isn't of the type " . $class->Type() )
87
      unless ref( $self->{_result} ) eq "Koha::Schema::Result::"
88
      . $class->Type();
89
90
    bless( $self, $class );
91
92
}
93
94
=head3 $object->Store();
95
96
Saves the object in storage.
97
If the object is new, it will be created.
98
If the object previously existed, it will be updated.
99
100
Returns:
101
    1  if the store was a success
102
    0  if the store failed
103
104
=cut
105
106
sub Store {
107
    my ($self) = @_;
108
109
    return $self->_Result()->update_or_insert() ? 1 : 0;
110
}
111
112
=head3 $object->IsStore();
113
114
Returns true if the object has been previously stored.
115
116
=cut
117
118
sub InStorage {
119
    my ($self) = @_;
120
121
    return $self->_Result()->in_storage();
122
}
123
124
=head3 $object->IsChanged();
125
126
Returns true if the object has properties that are different from
127
the properties of the object in storage.
128
129
=cut
130
131
sub IsChanged {
132
    my ( $self, @columns ) = @_;
133
134
    return $self->_Result()->is_changed(@columns);
135
}
136
137
=head3 $object->Delete();
138
139
Removes the object from storage.
140
141
Returns:
142
    1  if the deletion was a success
143
    0  if the deletion failed
144
    -1 if the object was never in storage
145
146
=cut
147
148
sub Delete {
149
    my ($self) = @_;
150
151
    # Deleting something not in storage thows an exception
152
    return -1 unless $self->_Result()->in_storage();
153
154
    # Return a boolean for succcess
155
    return $self->_Result()->delete() ? 1 : 0;
156
}
157
158
=head3 $object->Set( $properties_hashref )
159
160
$object->Set(
161
    {
162
        property1 => $property1,
163
        property2 => $property2,
164
        property3 => $propery3,
165
    }
166
);
167
168
Enables multiple properties to be set at once
169
170
Returns:
171
    1      if all properties were set.
172
    0      if one or more properties do not exist.
173
    undef  if all properties exist but a different error
174
           prevents one or more properties from being set.
175
176
If one or more of the properties do not exist,
177
no properties will be set.
178
179
=cut
180
181
sub Set {
182
    my ( $self, $properties ) = @_;
183
184
    my @columns = @{$self->_Columns()};
185
186
    foreach my $p ( keys %$properties ) {
187
        unless ( $p ~~ @columns ) {
188
            carp("No property $p!");
189
            return 0;
190
        }
191
    }
192
193
    return $self->_Result()->set_columns($properties) ? 1 : undef;
194
}
195
196
=head3 $object->Id();
197
198
Returns the id of the object if it has one.
199
200
=cut
201
202
sub Id {
203
    my ($self) = @_;
204
205
    my ( $id ) = $self->_Result()->id();
206
207
    return $id;
208
}
209
210
=head3 $object->_Result();
211
212
Returns the internal DBIC Row object
213
214
=cut
215
216
sub _Result {
217
    my ($self) = @_;
218
219
    # If we don't have a dbic row at this point, we need to create an empty one
220
    $self->{_result} ||=
221
      Koha::Database->new()->schema()->resultset( $self->Type() )->new({});
222
223
    return $self->{_result};
224
}
225
226
=head3 $object->_Columns();
227
228
Returns an arrayref of the table columns
229
230
=cut
231
232
sub _Columns {
233
    my ($self) = @_;
234
235
    # If we don't have a dbic row at this point, we need to create an empty one
236
    $self->{_columns} ||= [ $self->_Result()->result_source()->columns() ];
237
238
    return $self->{_columns};
239
}
240
241
242
=head3 AUTOLOAD
243
244
The autoload method is used only to get and set values for an objects properties.
245
246
=cut
247
248
sub AUTOLOAD {
249
    my $self = shift;
250
251
    my $method = our $AUTOLOAD;
252
    $method =~ s/.*://;
253
254
    my @columns = @{$self->_Columns()};
255
    # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
256
    if ( $method ~~ @columns ) {
257
        if ( @_ ) {
258
            return $self->_Result()->set_column( $method, @_ );
259
        } else {
260
            my $value = $self->_Result()->get_column( $method );
261
            return encode( 'UTF-8', $value );
262
        }
263
    }
264
265
    carp "No method $method!";
266
    return;
267
}
268
269
=head3 Type
270
271
This method must be defined in the child class. The value is the name of the DBIC resultset.
272
For example, for borrowers, the Type method will return "Borrower".
273
274
=cut
275
276
sub Type { }
277
278
sub DESTROY { }
279
280
=head1 AUTHOR
281
282
Kyle M Hall <kyle@bywatersolutions.com>
283
284
=cut
285
286
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