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