Bug 26157: Hide expected DBI warnings from tests

[srvgit] / Koha / Object.pm

diff --git a/Koha/Object.pm b/Koha/Object.pm
index dae52ac..bb2a5d8 100644 (file)
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -127,28 +127,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 +168,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 +210,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();
@@ -261,6 +273,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.
@@ -313,10 +360,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 +412,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 +424,25 @@ 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
@@ -392,7 +464,7 @@ sub prefetch_whitelist {
             my $result_class = $relations->{$key}->{class};
             my $obj = $result_class->new;
             try {
-                $whitelist->{$key} = $obj->koha_object_class;
+                $whitelist->{$key} = Koha::Object::_get_object_class( $obj->result_class );
             } catch {
                 $whitelist->{$key} = undef;
             }