X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FObject.pm;h=08602da67f9a27418b325fc8ae8e2deff1b41a94;hb=96adb7373ab3b39a42dc3a8304f050ee81c991c4;hp=0ef986686dfbfc3a68c0464916aef71f304d31d4;hpb=82716a01727f143ba2c167cd86233a531f330390;p=koha-ffzg.git diff --git a/Koha/Object.pm b/Koha/Object.pm index 0ef986686d..08602da67f 100644 --- a/Koha/Object.pm +++ b/Koha/Object.pm @@ -5,29 +5,30 @@ package Koha::Object; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 3 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . use Modern::Perl; -use Carp; +use Carp qw( croak ); use Mojo::JSON; use Scalar::Util qw( blessed looks_like_number ); -use Try::Tiny; +use Try::Tiny qw( catch try ); use Koha::Database; use Koha::Exceptions::Object; -use Koha::DateUtils; +use Koha::DateUtils qw( dt_from_string output_pref ); +use Koha::Object::Message; =head1 NAME @@ -77,6 +78,8 @@ sub new { $schema->resultset( $class->_type() )->new($attributes); } + $self->{_messages} = []; + croak("No _type found! Koha::Object must be subclassed!") unless $class->_type(); @@ -127,28 +130,38 @@ sub store { # Handle not null and default values for integers and dates foreach my $col ( keys %{$columns_info} ) { # Integers - if ( _numeric_column_type( $columns_info->{$col}->{data_type} ) ) { + if ( _numeric_column_type( $columns_info->{$col}->{data_type} ) + or _decimal_column_type( $columns_info->{$col}->{data_type} ) + ) { # Has been passed but not a number, usually an empty string - if ( defined $self->$col and not looks_like_number( $self->$col ) ) { + my $value = $self->_result()->get_column($col); + if ( defined $value and not looks_like_number( $value ) ) { if ( $columns_info->{$col}->{is_nullable} ) { # If nullable, default to null - $self->$col(undef); + $self->_result()->set_column($col => undef); } else { # If cannot be null, get the default value # What if cannot be null and does not have a default value? Possible? - $self->$col($columns_info->{$col}->{default_value}); + $self->_result()->set_column($col => $columns_info->{$col}->{default_value}); } } } elsif ( _date_or_datetime_column_type( $columns_info->{$col}->{data_type} ) ) { # Set to null if an empty string (or == 0 but should not happen) - if ( defined $self->$col and not $self->$col ) { + my $value = $self->_result()->get_column($col); + if ( defined $value and not $value ) { if ( $columns_info->{$col}->{is_nullable} ) { - $self->$col(undef); + $self->_result()->set_column($col => undef); } else { - $self->$col($columns_info->{$col}->{default_value}); + $self->_result()->set_column($col => $columns_info->{$col}->{default_value}); } } + elsif ( not defined $self->$col + && $columns_info->{$col}->{datetime_undef_if_invalid} ) + { + # timestamp + $self->_result()->set_column($col => $columns_info->{$col}->{default_value}); + } } } @@ -158,6 +171,7 @@ sub store { catch { # Catch problems and raise relevant exceptions if (ref($_) eq 'DBIx::Class::Exception') { + warn $_->{msg}; if ( $_->{msg} =~ /Cannot add or update a child row: a foreign key constraint fails/ ) { # FK constraints # FIXME: MySQL error, if we support more DB engines we should implement this for each @@ -199,7 +213,8 @@ A shortcut for set + store in one call. sub update { my ($self, $values) = @_; - return $self->set($values)->store(); + Koha::Exceptions::Object::NotInStorage->throw unless $self->in_storage; + $self->set($values)->store(); } =head3 $object->delete(); @@ -207,9 +222,8 @@ sub update { Removes the object from storage. Returns: - 1 if the deletion was a success - 0 if the deletion failed - -1 if the object was never in storage + The item object if deletion was a success + The DBIX::Class error if deletion failed =cut @@ -261,6 +275,41 @@ sub set { return $self->_result()->set_columns($properties) ? $self : undef; } +=head3 $object->set_or_blank( $properties_hashref ) + +$object->set_or_blank( + { + property1 => $property1, + property2 => $property2, + property3 => $propery3, + } +); + +If not listed in $properties_hashref, the property will be set to the default +value defined at DB level, or nulled. + +=cut + + +sub set_or_blank { + my ( $self, $properties ) = @_; + + my $columns_info = $self->_result->result_source->columns_info; + + foreach my $col ( keys %{$columns_info} ) { + + next if exists $properties->{$col}; + + if ( $columns_info->{$col}->{is_nullable} ) { + $properties->{$col} = undef; + } else { + $properties->{$col} = $columns_info->{$col}->{default_value}; + } + } + + return $self->set($properties); +} + =head3 $object->unblessed(); Returns an unblessed representation of object. @@ -285,6 +334,50 @@ sub get_from_storage { return $object_class->_new_from_dbic($stored_object); } +=head3 $object->messages + + my @messages = @{ $object->messages }; + +Returns the (probably non-fatal) messages that were recorded on the object. + +=cut + +sub messages { + my ( $self ) = @_; + + $self->{_messages} = [] + unless defined $self->{_messages}; + + return $self->{_messages}; +} + +=head3 $object->add_message + + try { + + } + catch { + if ( ) { + Koha::Exception->throw... + } + + # This is a non fatal error, notify the caller + $self->add_message({ message => $error, type => 'error' }); + } + return $self; + +Adds a message. + +=cut + +sub add_message { + my ( $self, $params ) = @_; + + push @{ $self->{_messages} }, Koha::Object::Message->new($params); + + return $self; +} + =head3 $object->TO_JSON Returns an unblessed representation of the object, suitable for JSON output. @@ -313,10 +406,21 @@ sub TO_JSON { ) { # TODO: Remove once the solution for - # https://rt.cpan.org/Ticket/Display.html?id=119904 + # https://github.com/perl5-dbi/DBD-mysql/issues/212 # is ported to whatever distro we support by that time + # or we move to DBD::MariaDB $unblessed->{$col} += 0; } + elsif ( _decimal_column_type( $columns_info->{$col}->{data_type} ) + and looks_like_number( $unblessed->{$col} ) + ) { + + # TODO: Remove once the solution for + # https://github.com/perl5-dbi/DBD-mysql/issues/212 + # is ported to whatever distro we support by that time + # or we move to DBD::MariaDB + $unblessed->{$col} += 0.00; + } elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) { eval { return unless $unblessed->{$col}; @@ -354,8 +458,9 @@ sub _datetime_column_type { sub _numeric_column_type { # TODO: Remove once the solution for - # https://rt.cpan.org/Ticket/Display.html?id=119904 + # https://github.com/perl5-dbi/DBD-mysql/issues/212 # is ported to whatever distro we support by that time + # or we move to DBD::MariaDB my ($column_type) = @_; my @numeric_types = ( @@ -365,12 +470,54 @@ sub _numeric_column_type { 'mediumint', 'smallint', 'tinyint', + ); + + return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0; +} + +sub _decimal_column_type { + # TODO: Remove once the solution for + # https://github.com/perl5-dbi/DBD-mysql/issues/212 + # is ported to whatever distro we support by that time + # or we move to DBD::MariaDB + my ($column_type) = @_; + + my @decimal_types = ( 'decimal', 'double precision', 'float' ); - return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0; + return ( grep { $column_type eq $_ } @decimal_types) ? 1 : 0; +} + +=head3 prefetch_whitelist + + my $whitelist = $object->prefetch_whitelist() + +Returns a hash of prefetchable subs and the type they return. + +=cut + +sub prefetch_whitelist { + my ( $self ) = @_; + + my $whitelist = {}; + my $relations = $self->_result->result_source->_relationships; + + foreach my $key (keys %{$relations}) { + if($self->can($key)) { + my $result_class = $relations->{$key}->{class}; + my $obj = $result_class->new; + try { + $whitelist->{$key} = Koha::Object::_get_object_class( $obj->result_class ); + } catch { + $whitelist->{$key} = undef; + } + } + } + + return $whitelist; } =head3 to_api