Bug 5670 - DBRev 16.06.00.036

[koha.git] / Koha / Object.pm

diff --git a/Koha/Object.pm b/Koha/Object.pm
index d8f2b42..b5e11af 100644 (file)
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -1,6 +1,7 @@
 package Koha::Object;
 
 # Copyright ByWater Solutions 2014
+# Copyright 2016 Koha Development Team
 #
 # This file is part of Koha.
 #
@@ -22,6 +23,7 @@ use Modern::Perl;
 use Carp;
 
 use Koha::Database;
+use Koha::Exceptions::Object;
 
 =head1 NAME
 
@@ -56,13 +58,22 @@ sub new {
     my $self = {};
 
     if ($attributes) {
-        $self->{_result} =
-          Koha::Database->new()->schema()->resultset( $class->type() )
+        my $schema = Koha::Database->new->schema;
+
+        # Remove the arguments which exist, are not defined but NOT NULL to use the default value
+        my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
+        for my $column_name ( keys %$attributes ) {
+            my $c_info = $columns_info->{$column_name};
+            next if $c_info->{is_nullable};
+            next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
+            delete $attributes->{$column_name};
+        }
+        $self->{_result} = $schema->resultset( $class->_type() )
           ->new($attributes);
     }
 
-    croak("No type found! Koha::Object must be subclassed!")
-      unless $class->type();
+    croak("No _type found! Koha::Object must be subclassed!")
+      unless $class->_type();
 
     bless( $self, $class );
 
@@ -81,11 +92,11 @@ sub _new_from_dbic {
     # DBIC result row
     $self->{_result} = $dbic_row;
 
-    croak("No type found! Koha::Object must be subclassed!")
-      unless $class->type();
+    croak("No _type found! Koha::Object must be subclassed!")
+      unless $class->_type();
 
-    croak( "DBIC result type " . ref( $self->{_result} ) . " isn't of the type " . $class->type() )
-      unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->type();
+    croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
+      unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
 
     bless( $self, $class );
 
@@ -109,31 +120,6 @@ sub store {
     return $self->_result()->update_or_insert() ? $self : undef;
 }
 
-=head3 $object->in_storage();
-
-Returns true if the object has been previously stored.
-
-=cut
-
-sub in_storage {
-    my ($self) = @_;
-
-    return $self->_result()->in_storage();
-}
-
-=head3 $object->is_changed();
-
-Returns true if the object has properties that are different from
-the properties of the object in storage.
-
-=cut
-
-sub is_changed {
-    my ( $self, @columns ) = @_;
-
-    return $self->_result()->is_changed(@columns);
-}
-
 =head3 $object->delete();
 
 Removes the object from storage.
@@ -185,26 +171,23 @@ sub set {
 
     foreach my $p ( keys %$properties ) {
         unless ( grep {/^$p$/} @columns ) {
-            carp("No property $p!");
-            return 0;
+            Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
         }
     }
 
     return $self->_result()->set_columns($properties) ? $self : undef;
 }
 
-=head3 $object->id();
+=head3 $object->unblessed();
 
-Returns the id of the object if it has one.
+Returns an unblessed representation of object.
 
 =cut
 
-sub id {
+sub unblessed {
     my ($self) = @_;
 
-    my ( $id ) = $self->_result()->id();
-
-    return $id;
+    return { $self->_result->get_columns };
 }
 
 =head3 $object->_result();
@@ -218,7 +201,7 @@ sub _result {
 
     # If we don't have a dbic row at this point, we need to create an empty one
     $self->{_result} ||=
-      Koha::Database->new()->schema()->resultset( $self->type() )->new({});
+      Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 
     return $self->{_result};
 }
@@ -255,25 +238,33 @@ sub AUTOLOAD {
     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
     if ( grep {/^$method$/} @columns ) {
         if ( @_ ) {
-            return $self->_result()->set_column( $method, @_ );
+            $self->_result()->set_column( $method, @_ );
+            return $self;
         } else {
             my $value = $self->_result()->get_column( $method );
             return $value;
         }
     }
 
-    carp "No method $method!";
-    return;
+    my @known_methods = qw( is_changed id in_storage get_column );
+
+    Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
+
+    my $r = eval { $self->_result->$method(@_) };
+    if ( $@ ) {
+        Koha::Exceptions::Object::MethodNotFound->throw( "No method $method for " . ref($self) );
+    }
+    return $r;
 }
 
-=head3 type
+=head3 _type
 
 This method must be defined in the child class. The value is the name of the DBIC resultset.
-For example, for borrowers, the type method will return "Borrower".
+For example, for borrowers, the _type method will return "Borrower".
 
 =cut
 
-sub type { }
+sub _type { }
 
 sub DESTROY { }
 
@@ -281,6 +272,8 @@ sub DESTROY { }
 
 Kyle M Hall <kyle@bywatersolutions.com>
 
+Jonathan Druart <jonathan.druart@bugs.koha-community.org>
+
 =cut
 
 1;