View | Details | Raw Unified | Return to bug 12892
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 (+255 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
my $object = Koha::Object->new($dbic_result);
51
52
=cut
53
54
sub new {
55
    my ($class) = shift;
56
    my $self = {};
57
58
    while ( my $var = shift ) {
59
        if ( ref($var) eq 'HASH' ) {
60
61
            # hashref of attributes
62
            croak "Already passed in a DBIC Row!" if $self->{result};
63
64
            $self->{result} ||=
65
              Koha::Database->new()->schema()->resultset( $class->Type() )
66
              ->new($var);
67
        }
68
        elsif ( ref($var) =~ /^Koha::Schema::Result/ ) {
69
70
            # DBIC result row
71
            croak "Already passed in a hashref of attributes!"
72
              if $self->{result};
73
74
            $self->{result} = $var;
75
        }
76
77
    }
78
79
    croak("No type found! Koha::Object must be subclassed!")
80
      unless $class->Type();
81
82
    # If we don't have a dbic row at this point, we need to create an empty one
83
    $self->{result} ||=
84
      Koha::Database->new()->schema()->resultset( $class->Type() )->new( {} );
85
86
    $self->{columns} = [ $self->{result}->result_source()->columns() ];
87
88
    croak( "DBIC Result type isn't of the type " . $class->Type() )
89
      unless ref( $self->{result} ) eq "Koha::Schema::Result::" . $class->Type();
90
91
    bless( $self, $class );
92
93
}
94
95
=head3 $object->Store();
96
97
Saves the object in storage.
98
If the object is new, it will be created.
99
If the object previously existed, it will be updated.
100
101
Returns:
102
    1  if the store was a success
103
    0  if the store failed
104
    -1 if the object was unchanged from in storage
105
106
=cut
107
108
sub Store {
109
    my ($self) = @_;
110
111
    return -1 if ( $self->{result}->in_storage() && !$self->{result}->is_changed() );
112
113
    return $self->{result}->update_or_insert() ? 1 : 0;
114
}
115
116
=head3 $object->IsStore();
117
118
Returns true if the object has been previously stored.
119
120
=cut
121
122
sub IsStored {
123
    my ($self) = @_;
124
125
    return $self->{result}->in_storage();
126
}
127
128
=head3 $object->IsChanged();
129
130
Returns true if the object has properties that are different from
131
the properties of the object in storage.
132
133
=cut
134
135
sub IsChanged {
136
    my ( $self, @columns ) = @_;
137
138
    return $self->{result}->is_changed(@columns);
139
}
140
141
=head3 $object->Delete();
142
143
Removes the object from storage.
144
145
Returns:
146
    1  if the deletion was a success
147
    0  if the deletion failed
148
    -1 if the object was never in storage
149
150
=cut
151
152
sub Delete {
153
    my ($self) = @_;
154
155
    # Deleting something not in storage thows an exception
156
    return -1 unless $self->{result}->in_storage();
157
158
    # Return a boolean for succcess
159
    return $self->{result}->delete() ? 1 : 0;
160
}
161
162
=head3 $object->Set( $properties_hashref )
163
164
$object->Set(
165
    {
166
        property1 => $property1,
167
        property2 => $property2,
168
        property3 => $propery3,
169
    }
170
);
171
172
Enables multiple properties to be set at once
173
174
Returns:
175
    1      if all properties were set.
176
    0      if one or more properties do not exist.
177
    undef  if all properties exist but a different error
178
           prevents one or more properties from being set.
179
180
If one or more of the properties do not exist,
181
no properties will be set.
182
183
=cut
184
185
sub Set {
186
    my ( $self, $properties ) = @_;
187
188
    foreach my $p ( keys %$properties ) {
189
        unless ( $p ~~ $self->{columns} ) {
190
            carp("No property $p!");
191
            return 0;
192
        }
193
    }
194
195
    return $self->{result}->set_columns($properties) ? 1 : undef;
196
}
197
198
=head3 $object->Id();
199
200
Returns the id of the object if it has one.
201
202
=cut
203
204
sub Id {
205
    my ($self) = @_;
206
207
    my ( $id ) = $self->{result}->id();
208
209
    return $id;
210
}
211
212
=head3 AUTOLOAD
213
214
The autoload method is used only to get and set values for an objects properties.
215
216
=cut
217
218
sub AUTOLOAD {
219
    my $self = shift;
220
221
    my $method = our $AUTOLOAD;
222
    $method =~ s/.*://;
223
224
    # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
225
    if ( $method ~~ $self->{columns} ) {
226
        if ( @_ ) {
227
            return $self->{result}->set_column( $method, @_ );
228
        } else {
229
            my $value = $self->{result}->get_column( $method );
230
            return encode( 'UTF-8', $value );
231
        }
232
    }
233
234
    carp "No method $method!";
235
    return;
236
}
237
238
=head3 Type
239
240
This method must be defined in the child class. The value is the name of the DBIC resultset.
241
For example, for borrowers, the Type method will return "Borrower".
242
243
=cut
244
245
sub Type { }
246
247
sub DESTROY { }
248
249
=head1 AUTHOR
250
251
Kyle M Hall <kyle@bywatersolutions.com>
252
253
=cut
254
255
1;
(-)a/Koha/Objects.pm (+152 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
    $self->{objects} = [];
57
58
    $self->{resultset} =
59
      Koha::Database->new()->schema()->resultset( $class->Type() );
60
61
    bless( $self, $class );
62
}
63
64
=head3 Koha::Objects->Find();
65
66
my $object = Koha::Object->Find($id);
67
my $object = Koha::Object->Find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
68
69
=cut
70
71
sub Find {
72
    my ( $self, $id ) = @_;
73
74
    my $result = $self->{resultset}->find($id);
75
76
    my $object = $self->ObjectClass()->new( $result );
77
78
    return $object;
79
}
80
81
=head3 Koha::Objects->Search();
82
83
my @objects = Koha::Object->Search($params);
84
85
=cut
86
87
sub Search {
88
    my ( $self, $params ) = @_;
89
90
    my @dbic_rows = $self->{resultset}->search($params);
91
92
    my @objects = $self->_Wrap( @dbic_rows );
93
94
    return wantarray ? @objects : \@objects;
95
}
96
97
=head3 Koha::Objects->Count();
98
99
my @objects = Koha::Object->Count($params);
100
101
=cut
102
103
sub Count {
104
    my ( $self, $params ) = @_;
105
106
    return $self->{resultset}->count($params);
107
}
108
109
=head3 Koha::Objects->_Wrap
110
111
Wraps the DBIC object in a corrosponding Koha object
112
113
=cut
114
115
sub _Wrap {
116
    my ( $self, @dbic_rows ) = @_;
117
118
    my @objects = map { $self->ObjectClass()->new( $_ ) } @dbic_rows;
119
120
    return @objects;
121
}
122
123
=head3 Type
124
125
The type method must be set for all child classes.
126
The value returned by it should be the DBIC resultset name.
127
For example, for holds, Type should return 'Reserve'.
128
129
=cut
130
131
sub Type { }
132
133
=head3 ObjectClass
134
135
This method must be set for all child classes.
136
The value returned by it should be the name of the Koha
137
object class that is returned by this class.
138
For example, for holds, ObjectClass should return 'Koha::Hold'.
139
140
=cut
141
142
sub ObjectClass { }
143
144
sub DESTROY { }
145
146
=head1 AUTHOR
147
148
Kyle M Hall <kyle@bywatersolutions.com>
149
150
=cut
151
152
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( $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->IsStored, 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->IsStored, 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->IsStored, 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 12892