Bug 33161: (follow-up) Consistent use of db fields throughout
[koha-ffzg.git] / Koha / Object.pm
index 4eff45c..102d715 100644 (file)
@@ -5,29 +5,31 @@ 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 <http://www.gnu.org/licenses>.
 
 use Modern::Perl;
 
-use Carp;
+use Carp qw( croak );
 use Mojo::JSON;
-use Scalar::Util qw( looks_like_number );
-use Try::Tiny;
+use Scalar::Util qw( blessed looks_like_number );
+use Try::Tiny qw( catch try );
+use List::MoreUtils qw( any );
 
 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 +79,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 +131,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 +172,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 +214,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 +223,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
 
@@ -253,7 +268,7 @@ sub set {
     my @columns = @{$self->_columns()};
 
     foreach my $p ( keys %$properties ) {
-        unless ( grep {/^$p$/} @columns ) {
+        unless ( grep { $_ eq $p } @columns ) {
             Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
         }
     }
@@ -261,6 +276,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.
@@ -280,10 +330,55 @@ sub unblessed {
 sub get_from_storage {
     my ( $self, $attrs ) = @_;
     my $stored_object = $self->_result->get_from_storage($attrs);
+    return unless $stored_object;
     my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
     return $object_class->_new_from_dbic($stored_object);
 }
 
+=head3 $object->object_messages
+
+    my @messages = @{ $object->object_messages };
+
+Returns the (probably non-fatal) messages that were recorded on the object.
+
+=cut
+
+sub object_messages {
+    my ( $self ) = @_;
+
+    $self->{_messages} = []
+        unless defined $self->{_messages};
+
+    return $self->{_messages};
+}
+
+=head3 $object->add_message
+
+    try {
+        <some action that might fail>
+    }
+    catch {
+        if ( <fatal condition> ) {
+            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.
@@ -312,10 +407,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};
@@ -353,8 +459,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 = (
@@ -364,42 +471,189 @@ 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
 
-    my $object_for_api = $object->to_api;
+    my $object_for_api = $object->to_api(
+        {
+          [ embed => {
+                items => {
+                    children => {
+                        holds => {,
+                            children => {
+                              ...
+                            }
+                        }
+                    }
+                },
+                library => {
+                    ...
+                }
+            },
+            public => 0|1,
+            ...
+         ]
+        }
+    );
 
 Returns a representation of the object, suitable for API output.
 
 =cut
 
 sub to_api {
-    my ( $self ) = @_;
+    my ( $self, $params ) = @_;
     my $json_object = $self->TO_JSON;
 
+    # Make sure we duplicate the $params variable to avoid
+    # breaking calls in a loop (Koha::Objects->to_api)
+    $params = defined $params ? {%$params} : {};
+
+    # children should be able to handle without
+    my $embeds  = delete $params->{embed};
+    my $strings = delete $params->{strings};
+
+    # coded values handling
+    my $avs = {};
+    if ( $strings and $self->can('api_strings_mapping') ) {
+        $avs = $self->api_strings_mapping($params);
+    }
+
+    # Remove forbidden attributes if required (including their coded values)
+    if ( $params->{public} ) {
+        for my $field ( keys %{$json_object} ) {
+            delete $json_object->{$field}
+              unless any { $_ eq $field } @{ $self->public_read_list };
+        }
+
+        if ($strings) {
+            foreach my $field ( keys %{$avs} ) {
+                delete $avs->{$field}
+                  unless any { $_ eq $field } @{ $self->public_read_list };
+            }
+        }
+    }
+
     my $to_api_mapping = $self->to_api_mapping;
 
-    # Rename attributes if there's a mapping
-    foreach my $column ( keys %{$to_api_mapping} ) {
-        my $mapped_column = $to_api_mapping->{$column};
-        if ( exists $json_object->{$column}
-            && defined $mapped_column )
-        {
-            # key != undef
-            $json_object->{$mapped_column} = delete $json_object->{$column};
+    # Rename attributes and coded values if there's a mapping
+    if ( $self->can('to_api_mapping') ) {
+        foreach my $column ( keys %{ $self->to_api_mapping } ) {
+            my $mapped_column = $self->to_api_mapping->{$column};
+            if ( exists $json_object->{$column}
+                && defined $mapped_column )
+            {
+
+                # key != undef
+                $json_object->{$mapped_column} = delete $json_object->{$column};
+                $avs->{$mapped_column}         = delete $avs->{$column}
+                  if exists $avs->{$column};
+
+            }
+            elsif ( exists $json_object->{$column}
+                && !defined $mapped_column )
+            {
+
+                # key == undef
+                delete $json_object->{$column};
+                delete $avs->{$column};
+            }
         }
-        elsif ( exists $json_object->{$column}
-            && !defined $mapped_column )
-        {
-            # key == undef
-            delete $json_object->{$column};
+    }
+
+    $json_object->{_strings} = $avs
+      if $strings;
+
+    if ($embeds) {
+        foreach my $embed ( keys %{$embeds} ) {
+            if (    $embed =~ m/^(?<relation>.*)_count$/
+                and $embeds->{$embed}->{is_count} )
+            {
+
+                my $relation = $+{relation};
+                $json_object->{$embed} = $self->$relation->count;
+            }
+            else {
+                my $curr = $embed;
+                my $next = $embeds->{$curr}->{children};
+
+                $params->{strings} = 1
+                  if $embeds->{$embed}->{strings};
+
+                my $children = $self->$curr;
+
+                if ( defined $children and ref($children) eq 'ARRAY' ) {
+                    my @list = map {
+                        $self->_handle_to_api_child(
+                            {
+                                child  => $_,
+                                next   => $next,
+                                curr   => $curr,
+                                params => $params
+                            }
+                        )
+                    } @{$children};
+                    $json_object->{$curr} = \@list;
+                }
+                else {
+                    $json_object->{$curr} = $self->_handle_to_api_child(
+                        {
+                            child  => $children,
+                            next   => $next,
+                            curr   => $curr,
+                            params => $params
+                        }
+                    );
+                }
+            }
         }
     }
 
@@ -422,6 +676,45 @@ sub to_api_mapping {
     return {};
 }
 
+=head3 api_strings_mapping
+
+    my $params = { is_public => 1 };
+    my $string_map = $object->api_strings_mapping($params);
+
+Generic method that returns the string map for coded attributes.
+
+Return should be a hashref keyed on database field name with the values
+being hashrefs containing 'str', 'type' and optionally 'category'.
+
+This is then use in to_api to render the _strings embed when requested.
+
+Note: this only returns an empty I<hashref>. Each class should have its
+own mapping returned.
+
+=cut
+
+sub api_strings_mapping {
+    return {};
+}
+
+=head3 public_read_list
+
+
+    my @public_read_list = @{$object->public_read_list};
+
+Generic method that returns the list of database columns that are allowed to
+be passed to render objects on the public API.
+
+Note: this only returns an empty I<arrayref>. Each class should have its
+own implementation.
+
+=cut
+
+sub public_read_list
+ {
+    return [];
+}
+
 =head3 from_api_mapping
 
     my $mapping = $object->from_api_mapping;
@@ -436,7 +729,8 @@ sub from_api_mapping {
 
     my $to_api_mapping = $self->to_api_mapping;
 
-    unless ( $self->{_from_api_mapping} ) {
+    unless ( defined $self->{_from_api_mapping} ) {
+        $self->{_from_api_mapping} = {};
         while (my ($key, $value) = each %{ $to_api_mapping } ) {
             $self->{_from_api_mapping}->{$value} = $key
                 if defined $value;
@@ -491,14 +785,37 @@ sub attributes_from_api {
     my $from_api_mapping = $self->from_api_mapping;
 
     my $params;
+    my $columns_info = $self->_result->result_source->columns_info;
+    my $dtf          = $self->_result->result_source->storage->datetime_parser;
 
     while (my ($key, $value) = each %{ $from_api_params } ) {
-        if ( exists $from_api_mapping->{$key} ) {
-            $params->{$from_api_mapping->{$key}} = $value;
+        my $koha_field_name =
+          exists $from_api_mapping->{$key}
+          ? $from_api_mapping->{$key}
+          : $key;
+
+        if ( $columns_info->{$koha_field_name}->{is_boolean} ) {
+            # TODO: Remove when D8 is formally deprecated
+            # Handle booleans gracefully
+            $value = ( $value ) ? 1 : 0;
         }
-        else {
-            $params->{$key} = $value;
+        elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
+            try {
+                if ( $columns_info->{$koha_field_name}->{data_type} eq 'date' ) {
+                    $value = $dtf->format_date(dt_from_string($value, 'iso'))
+                        if defined $value;
+                }
+                else {
+                    $value = $dtf->format_datetime(dt_from_string($value, 'rfc3339'))
+                        if defined $value;
+                }
+            }
+            catch {
+                Koha::Exceptions::BadParameter->throw( parameter => $key );
+            };
         }
+
+        $params->{$koha_field_name} = $value;
     }
 
     return $params;
@@ -591,7 +908,7 @@ sub AUTOLOAD {
 
     my @columns = @{$self->_columns()};
     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
-    if ( grep {/^$method$/} @columns ) {
+    if ( grep { $_ eq $method } @columns ) {
         if ( @_ ) {
             $self->_result()->set_column( $method, @_ );
             return $self;
@@ -606,7 +923,7 @@ sub AUTOLOAD {
     Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
         error      => sprintf("The method %s->%s is not covered by tests!", ref($self), $method),
         show_trace => 1
-    ) unless grep { /^$method$/ } @known_methods;
+    ) unless grep { $_ eq $method } @known_methods;
 
 
     my $r = eval { $self->_result->$method(@_) };
@@ -625,6 +942,37 @@ For example, for borrowers, the _type method will return "Borrower".
 
 sub _type { }
 
+=head3 _handle_to_api_child
+
+=cut
+
+sub _handle_to_api_child {
+    my ($self, $args ) = @_;
+
+    my $child  = $args->{child};
+    my $next   = $args->{next};
+    my $curr   = $args->{curr};
+    my $params = $args->{params};
+
+    my $res;
+
+    if ( defined $child ) {
+
+        Koha::Exception->throw( "Asked to embed $curr but its return value doesn't implement to_api" )
+            if defined $next and blessed $child and !$child->can('to_api');
+
+        if ( blessed $child ) {
+            $params->{embed} = $next;
+            $res = $child->to_api($params);
+        }
+        else {
+            $res = $child;
+        }
+    }
+
+    return $res;
+}
+
 sub DESTROY { }
 
 =head1 AUTHOR