X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FObject.pm;h=102d7154dbeafb52e45bf9f3e5ffa66d2c4945ff;hb=04736dd0bafbef608e56e8cd4dae63bb4eb93fe6;hp=0093ed14309fba1e96625ae705d80d458c15118e;hpb=3107975ba95f5853ea1084afa01db598e4adeeea;p=koha-ffzg.git diff --git a/Koha/Object.pm b/Koha/Object.pm index 0093ed1430..102d7154db 100644 --- a/Koha/Object.pm +++ b/Koha/Object.pm @@ -1,28 +1,35 @@ package Koha::Object; # Copyright ByWater Solutions 2014 +# Copyright 2016 Koha Development Team # # 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 Encode qw{encode}; +use Carp qw( croak ); +use Mojo::JSON; +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 qw( dt_from_string output_pref ); +use Koha::Object::Message; =head1 NAME @@ -57,36 +64,48 @@ sub new { my $self = {}; if ($attributes) { + 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} = - Koha::Database->new()->schema()->resultset( $class->type() ) - ->new($attributes); + $schema->resultset( $class->_type() )->new($attributes); } - croak("No type found! Koha::Object must be subclassed!") - unless $class->type(); + $self->{_messages} = []; + + croak("No _type found! Koha::Object must be subclassed!") + unless $class->_type(); bless( $self, $class ); } -=head3 Koha::Object->new_from_dbic(); +=head3 Koha::Object->_new_from_dbic(); -my $object = Koha::Object->new_from_dbic($dbic_row); +my $object = Koha::Object->_new_from_dbic($dbic_row); =cut -sub new_from_dbic { +sub _new_from_dbic { my ( $class, $dbic_row ) = @_; my $self = {}; # 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 ); @@ -99,40 +118,104 @@ If the object is new, it will be created. If the object previously existed, it will be updated. Returns: - 1 if the store was a success - 0 if the store failed + $self if the store was a success + undef if the store failed =cut sub store { my ($self) = @_; - return $self->_result()->update_or_insert() ? 1 : 0; -} - -=head3 $object->in_storage(); - -Returns true if the object has been previously stored. - -=cut - -sub in_storage { - 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} ) + or _decimal_column_type( $columns_info->{$col}->{data_type} ) + ) { + # Has been passed but not a number, usually an empty string + 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->_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->_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) + my $value = $self->_result()->get_column($col); + if ( defined $value and not $value ) { + if ( $columns_info->{$col}->{is_nullable} ) { + $self->_result()->set_column($col => undef); + } else { + $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}); + } + } + } - return $self->_result()->in_storage(); + try { + return $self->_result()->update_or_insert() ? $self : undef; + } + 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 + if ( $_->{msg} =~ /FOREIGN KEY \(`(?.*?)`\)/ ) { + Koha::Exceptions::Object::FKConstraint->throw( + error => 'Broken FK constraint', + broken_fk => $+{column} + ); + } + } + elsif( $_->{msg} =~ /Duplicate entry '(.*?)' for key '(?.*?)'/ ) { + Koha::Exceptions::Object::DuplicateID->throw( + error => 'Duplicate ID', + duplicate_id => $+{key} + ); + } + elsif( $_->{msg} =~ /Incorrect (?\w+) value: '(?.*)' for column \W?(?\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->is_changed(); +=head3 $object->update(); -Returns true if the object has properties that are different from -the properties of the object in storage. +A shortcut for set + store in one call. =cut -sub is_changed { - my ( $self, @columns ) = @_; - - return $self->_result()->is_changed(@columns); +sub update { + my ($self, $values) = @_; + Koha::Exceptions::Object::NotInStorage->throw unless $self->in_storage; + $self->set($values)->store(); } =head3 $object->delete(); @@ -140,20 +223,20 @@ sub is_changed { 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 sub delete { my ($self) = @_; - # Deleting something not in storage thows 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 ) @@ -185,27 +268,588 @@ sub set { my @columns = @{$self->_columns()}; foreach my $p ( keys %$properties ) { - unless ( grep {/^$p$/} @columns ) { - carp("No property $p!"); - return 0; + unless ( grep { $_ eq $p } @columns ) { + Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) ); } } - return $self->_result()->set_columns($properties) ? 1 : undef; + return $self->_result()->set_columns($properties) ? $self : undef; } -=head3 $object->id(); +=head3 $object->set_or_blank( $properties_hashref ) -Returns the id of the object if it has one. +$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 id { + +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. + +=cut + +sub unblessed { my ($self) = @_; - my ( $id ) = $self->_result()->id(); + return { $self->_result->get_columns }; +} + +=head3 $object->get_from_storage; + +=cut + +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 { + + } + 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. + +=cut + +sub TO_JSON { + + my ($self) = @_; + + my $unblessed = $self->unblessed; + my $columns_info = Koha::Database->new->schema->resultset( $self->_type ) + ->result_source->{_columns}; + + foreach my $col ( keys %{$columns_info} ) { + + if ( $columns_info->{$col}->{is_boolean} ) + { # Handle booleans gracefully + $unblessed->{$col} + = ( $unblessed->{$col} ) + ? Mojo::JSON->true + : Mojo::JSON->false; + } + elsif ( _numeric_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; + } + 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}; + $unblessed->{$col} = output_pref({ + dateformat => 'rfc3339', + dt => dt_from_string($unblessed->{$col}, 'sql'), + }); + }; + } + } + 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) = @_; + + my @dt_types = ( + 'timestamp', + 'datetime' + ); + + return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0; +} + +sub _numeric_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 @numeric_types = ( + 'bigint', + 'integer', + 'int', + '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 $_ } @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( + { + [ 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, $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}; - return $id; + # 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 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}; + } + } + } + + $json_object->{_strings} = $avs + if $strings; + + if ($embeds) { + foreach my $embed ( keys %{$embeds} ) { + if ( $embed =~ m/^(?.*)_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 + } + ); + } + } + } + } + + 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. Each class should have its +own mapping returned. + +=cut + +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. 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. Each class should have its +own implementation. + +=cut + +sub public_read_list + { + 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 ( 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; + } + } + + 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; + my $dtf = $self->_result->result_source->storage->datetime_parser; + + 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 { + 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; +} + +=head3 $object->unblessed_all_relateds + +my $everything_into_one_hashref = $object->unblessed_all_relateds + +The unblessed method only retrieves column' values for the column of the object. +In a *few* cases we want to retrieve the information of all the prefetched data. + +=cut + +sub unblessed_all_relateds { + my ($self) = @_; + + my %data; + my $related_resultsets = $self->_result->{related_resultsets} || {}; + my $rs = $self->_result; + while ( $related_resultsets and %$related_resultsets ) { + my @relations = keys %{ $related_resultsets }; + if ( @relations ) { + my $relation = $relations[0]; + $rs = $rs->related_resultset($relation)->get_cache; + $rs = $rs->[0]; # Does it makes sense to have several values here? + my $object_class = Koha::Object::_get_object_class( $rs->result_class ); + my $koha_object = $object_class->_new_from_dbic( $rs ); + $related_resultsets = $rs->{related_resultsets}; + %data = ( %data, %{ $koha_object->unblessed } ); + } + } + %data = ( %data, %{ $self->unblessed } ); + return \%data; } =head3 $object->_result(); @@ -219,7 +863,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}; } @@ -239,6 +883,16 @@ sub _columns { return $self->{_columns}; } +sub _get_object_class { + my ( $type ) = @_; + return unless $type; + + if( $type->can('koha_object_class') ) { + return $type->koha_object_class; + } + $type =~ s|Schema::Result::||; + return ${type}; +} =head3 AUTOLOAD @@ -254,27 +908,70 @@ 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 ( @_ ) { - return $self->_result()->set_column( $method, @_ ); + $self->_result()->set_column( $method, @_ ); + return $self; } else { my $value = $self->_result()->get_column( $method ); - return encode( 'UTF-8', $value ); + return $value; } } - carp "No method $method!"; - return; + 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 { $_ eq $method } @known_methods; + + + my $r = eval { $self->_result->$method(@_) }; + if ( $@ ) { + Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ ); + } + 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 { } + +=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 { } @@ -282,6 +979,8 @@ sub DESTROY { } Kyle M Hall +Jonathan Druart + =cut 1;