3 # Copyright ByWater Solutions 2014
4 # Copyright 2016 Koha Development Team
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
27 use Koha::Exceptions::Object;
32 Koha::Object - Koha Object base class
37 my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
41 This class must always be subclassed.
49 =head3 Koha::Object->new();
51 my $object = Koha::Object->new();
52 my $object = Koha::Object->new($attributes);
54 Note that this cannot be used to retrieve record from the DB.
59 my ( $class, $attributes ) = @_;
63 my $schema = Koha::Database->new->schema;
65 # Remove the arguments which exist, are not defined but NOT NULL to use the default value
66 my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
67 for my $column_name ( keys %$attributes ) {
68 my $c_info = $columns_info->{$column_name};
69 next if $c_info->{is_nullable};
70 next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
71 delete $attributes->{$column_name};
73 $self->{_result} = $schema->resultset( $class->_type() )
77 croak("No _type found! Koha::Object must be subclassed!")
78 unless $class->_type();
80 bless( $self, $class );
84 =head3 Koha::Object->_new_from_dbic();
86 my $object = Koha::Object->_new_from_dbic($dbic_row);
91 my ( $class, $dbic_row ) = @_;
95 $self->{_result} = $dbic_row;
97 croak("No _type found! Koha::Object must be subclassed!")
98 unless $class->_type();
100 croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
101 unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
103 bless( $self, $class );
107 =head3 $object->store();
109 Saves the object in storage.
110 If the object is new, it will be created.
111 If the object previously existed, it will be updated.
114 $self if the store was a success
115 undef if the store failed
122 return $self->_result()->update_or_insert() ? $self : undef;
125 =head3 $object->delete();
127 Removes the object from storage.
130 1 if the deletion was a success
131 0 if the deletion failed
132 -1 if the object was never in storage
139 # Deleting something not in storage throws an exception
140 return -1 unless $self->_result()->in_storage();
142 # Return a boolean for succcess
143 return $self->_result()->delete() ? 1 : 0;
146 =head3 $object->set( $properties_hashref )
150 property1 => $property1,
151 property2 => $property2,
152 property3 => $propery3,
156 Enables multiple properties to be set at once
159 1 if all properties were set.
160 0 if one or more properties do not exist.
161 undef if all properties exist but a different error
162 prevents one or more properties from being set.
164 If one or more of the properties do not exist,
165 no properties will be set.
170 my ( $self, $properties ) = @_;
172 my @columns = @{$self->_columns()};
174 foreach my $p ( keys %$properties ) {
175 unless ( grep {/^$p$/} @columns ) {
176 Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
180 return $self->_result()->set_columns($properties) ? $self : undef;
183 =head3 $object->unblessed();
185 Returns an unblessed representation of object.
192 return { $self->_result->get_columns };
195 =head3 $object->TO_JSON
197 Returns an unblessed representation of the object, suitable for JSON output.
205 my $unblessed = $self->unblessed;
206 my $columns_info = Koha::Database->new->schema->resultset( $self->_type )
207 ->result_source->{_columns};
209 foreach my $col ( keys %{$columns_info} ) {
211 if ( $columns_info->{$col}->{is_boolean} )
212 { # Handle booleans gracefully
214 = ( $unblessed->{$col} )
218 elsif ( _numeric_column_type( $columns_info->{$col}->{data_type} ) ) {
220 # TODO: Remove once the solution for
221 # https://rt.cpan.org/Ticket/Display.html?id=119904
222 # is ported to whatever distro we support by that time
223 $unblessed->{$col} += 0;
225 elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
227 return undef unless $unblessed->{$col};
228 $unblessed->{$col} = output_pref({
229 dateformat => 'rfc3339',
230 dt => dt_from_string($unblessed->{$col}, 'sql'),
238 sub _datetime_column_type {
239 my ($column_type) = @_;
246 return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
249 sub _numeric_column_type {
250 # TODO: Remove once the solution for
251 # https://rt.cpan.org/Ticket/Display.html?id=119904
252 # is ported to whatever distro we support by that time
253 my ($column_type) = @_;
255 my @numeric_types = (
267 return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
270 =head3 $object->_result();
272 Returns the internal DBIC Row object
279 # If we don't have a dbic row at this point, we need to create an empty one
281 Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
283 return $self->{_result};
286 =head3 $object->_columns();
288 Returns an arrayref of the table columns
295 # If we don't have a dbic row at this point, we need to create an empty one
296 $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
298 return $self->{_columns};
303 The autoload method is used only to get and set values for an objects properties.
310 my $method = our $AUTOLOAD;
313 my @columns = @{$self->_columns()};
314 # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
315 if ( grep {/^$method$/} @columns ) {
317 $self->_result()->set_column( $method, @_ );
320 my $value = $self->_result()->get_column( $method );
325 my @known_methods = qw( is_changed id in_storage get_column discard_changes update );
326 Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
328 my $r = eval { $self->_result->$method(@_) };
330 Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
337 This method must be defined in the child class. The value is the name of the DBIC resultset.
338 For example, for borrowers, the _type method will return "Borrower".
348 Kyle M Hall <kyle@bywatersolutions.com>
350 Jonathan Druart <jonathan.druart@bugs.koha-community.org>