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 (+163 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->Find();
61
62
my $object = Koha::Object->Find($id);
63
my $object = Koha::Object->Find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
64
65
=cut
66
67
sub Find {
68
    my ( $self, $id ) = @_;
69
70
    my $result = $self->_ResultSet()->find($id);
71
72
    my $object = $self->ObjectClass()->new_from_dbic( $result );
73
74
    return $object;
75
}
76
77
=head3 Koha::Objects->Search();
78
79
my @objects = Koha::Object->Search($params);
80
81
=cut
82
83
sub Search {
84
    my ( $self, $params ) = @_;
85
86
    my @dbic_rows = $self->_ResultSet()->search($params);
87
88
    my @objects = $self->_Wrap( @dbic_rows );
89
90
    return wantarray ? @objects : \@objects;
91
}
92
93
=head3 Koha::Objects->Count();
94
95
my @objects = Koha::Object->Count($params);
96
97
=cut
98
99
sub Count {
100
    my ( $self, $params ) = @_;
101
102
    return $self->_ResultSet()->count($params);
103
}
104
105
=head3 Koha::Objects->_Wrap
106
107
Wraps the DBIC object in a corrosponding Koha object
108
109
=cut
110
111
sub _Wrap {
112
    my ( $self, @dbic_rows ) = @_;
113
114
    my @objects = map { $self->ObjectClass()->new_from_dbic( $_ ) } @dbic_rows;
115
116
    return @objects;
117
}
118
119
=head3 Koha::Objects->_ResultSet
120
121
Returns the internal resultset or creates it if undefined
122
123
=cut
124
125
sub _ResultSet {
126
    my ($self) = @_;
127
128
    $self->{_resultset} ||=
129
      Koha::Database->new()->schema()->resultset( $self->Type() );
130
131
    $self->{_resultset};
132
}
133
134
=head3 Type
135
136
The type method must be set for all child classes.
137
The value returned by it should be the DBIC resultset name.
138
For example, for holds, Type should return 'Reserve'.
139
140
=cut
141
142
sub Type { }
143
144
=head3 ObjectClass
145
146
This method must be set for all child classes.
147
The value returned by it should be the name of the Koha
148
object class that is returned by this class.
149
For example, for holds, ObjectClass should return 'Koha::Hold'.
150
151
=cut
152
153
sub ObjectClass { }
154
155
sub DESTROY { }
156
157
=head1 AUTHOR
158
159
Kyle M Hall <kyle@bywatersolutions.com>
160
161
=cut
162
163
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