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; |