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
    $self->{_result} =
58
      Koha::Database->new()->schema()->resultset( $class->Type() )
59
      ->new($attributes)
60
      if $attributes;
61
62
    croak("No type found! Koha::Object must be subclassed!")
63
      unless $class->Type();
64
65
    bless( $self, $class );
66
67
}
68
69
=head3 Koha::Object->new_from_dbic();
70
71
my $object = Koha::Object->new_from_dbic($dbic_row);
72
73
=cut
74
75
sub new_from_dbic {
76
    my ( $class, $dbic_row ) = @_;
77
    my $self = {};
78
79
    # DBIC result row
80
    $self->{_result} = $dbic_row;
81
82
    croak("No type found! Koha::Object must be subclassed!")
83
      unless $class->Type();
84
85
    croak( "DBIC Result type isn't of the type " . $class->Type() )
86
      unless ref( $self->{_result} ) eq "Koha::Schema::Result::"
87
      . $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 (+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( $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( $_ ) } @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/Object.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/Object.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/Objects.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