Bug 24269: Adjust C4::Heading to generate headings from auth tags
[srvgit] / Koha / Object.pm
index e62af3e..0ef9866 100644 (file)
@@ -22,7 +22,7 @@ use Modern::Perl;
 
 use Carp;
 use Mojo::JSON;
-use Scalar::Util qw( looks_like_number );
+use Scalar::Util qw( blessed looks_like_number );
 use Try::Tiny;
 
 use Koha::Database;
@@ -72,8 +72,9 @@ sub new {
             next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
             delete $attributes->{$column_name};
         }
-        $self->{_result} = $schema->resultset( $class->_type() )
-          ->new($attributes);
+
+        $self->{_result} =
+          $schema->resultset( $class->_type() )->new($attributes);
     }
 
     croak("No _type found! Koha::Object must be subclassed!")
@@ -121,6 +122,36 @@ Returns:
 sub store {
     my ($self) = @_;
 
+    my $columns_info = $self->_result->result_source->columns_info;
+
+    # 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} ) ) {
+            # Has been passed but not a number, usually an empty string
+            if ( defined $self->$col and not looks_like_number( $self->$col ) ) {
+                if ( $columns_info->{$col}->{is_nullable} ) {
+                    # If nullable, default to null
+                    $self->$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});
+                }
+            }
+        }
+        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 ) {
+                if ( $columns_info->{$col}->{is_nullable} ) {
+                    $self->$col(undef);
+                } else {
+                    $self->$col($columns_info->{$col}->{default_value});
+                }
+            }
+        }
+    }
+
     try {
         return $self->_result()->update_or_insert() ? $self : undef;
     }
@@ -143,12 +174,34 @@ sub store {
                     duplicate_id => $+{key}
                 );
             }
+            elsif( $_->{msg} =~ /Incorrect (?<type>\w+) value: '(?<value>.*)' for column \W?(?<property>\S+)/ ) { # The optional \W in the regex might be a quote or backtick
+                my $type = $+{type};
+                my $value = $+{value};
+                my $property = $+{property};
+                $property =~ s/['`]//g;
+                Koha::Exceptions::Object::BadValue->throw(
+                    type     => $type,
+                    value    => $value,
+                    property => $property =~ /(\w+\.\w+)$/ ? $1 : $property, # results in table.column without quotes or backtics
+                );
+            }
         }
         # Catch-all for foreign key breakages. It will help find other use cases
         $_->rethrow();
     }
 }
 
+=head3 $object->update();
+
+A shortcut for set + store in one call.
+
+=cut
+
+sub update {
+    my ($self, $values) = @_;
+    return $self->set($values)->store();
+}
+
 =head3 $object->delete();
 
 Removes the object from storage.
@@ -163,11 +216,12 @@ Returns:
 sub delete {
     my ($self) = @_;
 
-    # Deleting something not in storage throws an exception
-    return -1 unless $self->_result()->in_storage();
-
-    # Return a boolean for succcess
-    return $self->_result()->delete() ? 1 : 0;
+    my $deleted = $self->_result()->delete;
+    if ( ref $deleted ) {
+        my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
+        $deleted = $object_class->_new_from_dbic($deleted);
+    }
+    return $deleted;
 }
 
 =head3 $object->set( $properties_hashref )
@@ -199,7 +253,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) );
         }
     }
@@ -226,6 +280,7 @@ 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);
 }
@@ -275,6 +330,17 @@ sub TO_JSON {
     return $unblessed;
 }
 
+sub _date_or_datetime_column_type {
+    my ($column_type) = @_;
+
+    my @dt_types = (
+        'timestamp',
+        'date',
+        'datetime'
+    );
+
+    return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
+}
 sub _datetime_column_type {
     my ($column_type) = @_;
 
@@ -307,6 +373,207 @@ sub _numeric_column_type {
     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 }
 
+=head3 to_api
+
+    my $object_for_api = $object->to_api(
+        {
+          [ embed => {
+                items => {
+                    children => {
+                        holds => {,
+                            children => {
+                              ...
+                            }
+                        }
+                    }
+                },
+                library => {
+                    ...
+                }
+            },
+            ...
+         ]
+        }
+    );
+
+Returns a representation of the object, suitable for API output.
+
+=cut
+
+sub to_api {
+    my ( $self, $params ) = @_;
+    my $json_object = $self->TO_JSON;
+
+    my $to_api_mapping = $self->to_api_mapping;
+
+    # Rename attributes 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};
+            }
+            elsif ( exists $json_object->{$column}
+                && !defined $mapped_column )
+            {
+                # key == undef
+                delete $json_object->{$column};
+            }
+        }
+    }
+
+    my $embeds = $params->{embed};
+
+    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};
+
+                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 } )
+                    } @{$children};
+                    $json_object->{$curr} = \@list;
+                }
+                else {
+                    $json_object->{$curr} = $self->_handle_to_api_child(
+                        { child => $children, next => $next, curr => $curr } );
+                }
+            }
+        }
+    }
+
+
+
+    return $json_object;
+}
+
+=head3 to_api_mapping
+
+    my $mapping = $object->to_api_mapping;
+
+Generic method that returns the attribute name mappings required to
+render the object on the API.
+
+Note: this only returns an empty I<hashref>. Each class should have its
+own mapping returned.
+
+=cut
+
+sub to_api_mapping {
+    return {};
+}
+
+=head3 from_api_mapping
+
+    my $mapping = $object->from_api_mapping;
+
+Generic method that returns the attribute name mappings so the data that
+comes from the API is correctly renamed to match what is required for the DB.
+
+=cut
+
+sub from_api_mapping {
+    my ( $self ) = @_;
+
+    my $to_api_mapping = $self->to_api_mapping;
+
+    unless ( $self->{_from_api_mapping} ) {
+        while (my ($key, $value) = each %{ $to_api_mapping } ) {
+            $self->{_from_api_mapping}->{$value} = $key
+                if defined $value;
+        }
+    }
+
+    return $self->{_from_api_mapping};
+}
+
+=head3 new_from_api
+
+    my $object = Koha::Object->new_from_api;
+    my $object = Koha::Object->new_from_api( $attrs );
+
+Creates a new object, mapping the API attribute names to the ones on the DB schema.
+
+=cut
+
+sub new_from_api {
+    my ( $class, $params ) = @_;
+
+    my $self = $class->new;
+    return $self->set_from_api( $params );
+}
+
+=head3 set_from_api
+
+    my $object = Koha::Object->new(...);
+    $object->set_from_api( $attrs )
+
+Sets the object's attributes mapping API attribute names to the ones on the DB schema.
+
+=cut
+
+sub set_from_api {
+    my ( $self, $from_api_params ) = @_;
+
+    return $self->set( $self->attributes_from_api( $from_api_params ) );
+}
+
+=head3 attributes_from_api
+
+    my $attributes = attributes_from_api( $params );
+
+Returns the passed params, converted from API naming into the model.
+
+=cut
+
+sub attributes_from_api {
+    my ( $self, $from_api_params ) = @_;
+
+    my $from_api_mapping = $self->from_api_mapping;
+
+    my $params;
+    my $columns_info = $self->_result->result_source->columns_info;
+
+    while (my ($key, $value) = each %{ $from_api_params } ) {
+        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;
+        }
+        elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
+            try {
+                $value = dt_from_string($value, 'rfc3339');
+            }
+            catch {
+                Koha::Exceptions::BadParameter->throw( parameter => $key );
+            };
+        }
+
+        $params->{$koha_field_name} = $value;
+    }
+
+    return $params;
+}
+
 =head3 $object->unblessed_all_relateds
 
 my $everything_into_one_hashref = $object->unblessed_all_relateds
@@ -321,7 +588,7 @@ sub unblessed_all_relateds {
 
     my %data;
     my $related_resultsets = $self->_result->{related_resultsets} || {};
-    my $rs = $self;
+    my $rs = $self->_result;
     while ( $related_resultsets and %$related_resultsets ) {
         my @relations = keys %{ $related_resultsets };
         if ( @relations ) {
@@ -394,7 +661,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;
@@ -404,12 +671,12 @@ sub AUTOLOAD {
         }
     }
 
-    my @known_methods = qw( is_changed id in_storage get_column discard_changes update related_resultset make_column_dirty );
+    my @known_methods = qw( is_changed id in_storage get_column discard_changes make_column_dirty );
 
     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(@_) };
@@ -428,6 +695,35 @@ 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 $res;
+
+    if ( defined $child ) {
+
+        Koha::Exceptions::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 ) {
+            $res = $child->to_api({ embed => $next });
+        }
+        else {
+            $res = $child;
+        }
+    }
+
+    return $res;
+}
+
 sub DESTROY { }
 
 =head1 AUTHOR