Koha/Object.pm

   1 package Koha::Object;
   2
   3 # Copyright ByWater Solutions 2014
   4 # Copyright 2016 Koha Development Team
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24 use Mojo::JSON;
  25 use Scalar::Util qw( blessed looks_like_number );
  26 use Try::Tiny;
  27
  28 use Koha::Database;
  29 use Koha::Exceptions::Object;
  30 use Koha::DateUtils;
  31
  32 =head1 NAME
  33
  34 Koha::Object - Koha Object base class
  35
  36 =head1 SYNOPSIS
  37
  38     use Koha::Object;
  39     my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
  40
  41 =head1 DESCRIPTION
  42
  43 This class must always be subclassed.
  44
  45 =head1 API
  46
  47 =head2 Class Methods
  48
  49 =cut
  50
  51 =head3 Koha::Object->new();
  52
  53 my $object = Koha::Object->new();
  54 my $object = Koha::Object->new($attributes);
  55
  56 Note that this cannot be used to retrieve record from the DB.
  57
  58 =cut
  59
  60 sub new {
  61     my ( $class, $attributes ) = @_;
  62     my $self = {};
  63
  64     if ($attributes) {
  65         my $schema = Koha::Database->new->schema;
  66
  67         # Remove the arguments which exist, are not defined but NOT NULL to use the default value
  68         my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
  69         for my $column_name ( keys %$attributes ) {
  70             my $c_info = $columns_info->{$column_name};
  71             next if $c_info->{is_nullable};
  72             next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
  73             delete $attributes->{$column_name};
  74         }
  75
  76         $self->{_result} =
  77           $schema->resultset( $class->_type() )->new($attributes);
  78     }
  79
  80     croak("No _type found! Koha::Object must be subclassed!")
  81       unless $class->_type();
  82
  83     bless( $self, $class );
  84
  85 }
  86
  87 =head3 Koha::Object->_new_from_dbic();
  88
  89 my $object = Koha::Object->_new_from_dbic($dbic_row);
  90
  91 =cut
  92
  93 sub _new_from_dbic {
  94     my ( $class, $dbic_row ) = @_;
  95     my $self = {};
  96
  97     # DBIC result row
  98     $self->{_result} = $dbic_row;
  99
 100     croak("No _type found! Koha::Object must be subclassed!")
 101       unless $class->_type();
 102
 103     croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
 104       unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
 105
 106     bless( $self, $class );
 107
 108 }
 109
 110 =head3 $object->store();
 111
 112 Saves the object in storage.
 113 If the object is new, it will be created.
 114 If the object previously existed, it will be updated.
 115
 116 Returns:
 117     $self  if the store was a success
 118     undef  if the store failed
 119
 120 =cut
 121
 122 sub store {
 123     my ($self) = @_;
 124
 125     my $columns_info = $self->_result->result_source->columns_info;
 126
 127     # Handle not null and default values for integers and dates
 128     foreach my $col ( keys %{$columns_info} ) {
 129         # Integers
 130         if (   _numeric_column_type( $columns_info->{$col}->{data_type} )
 131             or _decimal_column_type( $columns_info->{$col}->{data_type} )
 132         ) {
 133             # Has been passed but not a number, usually an empty string
 134             my $value = $self->_result()->get_column($col);
 135             if ( defined $value and not looks_like_number( $value ) ) {
 136                 if ( $columns_info->{$col}->{is_nullable} ) {
 137                     # If nullable, default to null
 138                     $self->_result()->set_column($col => undef);
 139                 } else {
 140                     # If cannot be null, get the default value
 141                     # What if cannot be null and does not have a default value? Possible?
 142                     $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 143                 }
 144             }
 145         }
 146         elsif ( _date_or_datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
 147             # Set to null if an empty string (or == 0 but should not happen)
 148             my $value = $self->_result()->get_column($col);
 149             if ( defined $value and not $value ) {
 150                 if ( $columns_info->{$col}->{is_nullable} ) {
 151                     $self->_result()->set_column($col => undef);
 152                 } else {
 153                     $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 154                 }
 155             }
 156             elsif ( not defined $self->$col
 157                   && $columns_info->{$col}->{datetime_undef_if_invalid} )
 158               {
 159                   # timestamp
 160                   $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 161               }
 162         }
 163     }
 164
 165     try {
 166         return $self->_result()->update_or_insert() ? $self : undef;
 167     }
 168     catch {
 169         # Catch problems and raise relevant exceptions
 170         if (ref($_) eq 'DBIx::Class::Exception') {
 171             warn $_->{msg};
 172             if ( $_->{msg} =~ /Cannot add or update a child row: a foreign key constraint fails/ ) {
 173                 # FK constraints
 174                 # FIXME: MySQL error, if we support more DB engines we should implement this for each
 175                 if ( $_->{msg} =~ /FOREIGN KEY \(`(?<column>.*?)`\)/ ) {
 176                     Koha::Exceptions::Object::FKConstraint->throw(
 177                         error     => 'Broken FK constraint',
 178                         broken_fk => $+{column}
 179                     );
 180                 }
 181             }
 182             elsif( $_->{msg} =~ /Duplicate entry '(.*?)' for key '(?<key>.*?)'/ ) {
 183                 Koha::Exceptions::Object::DuplicateID->throw(
 184                     error => 'Duplicate ID',
 185                     duplicate_id => $+{key}
 186                 );
 187             }
 188             elsif( $_->{msg} =~ /Incorrect (?<type>\w+) value: '(?<value>.*)' for column \W?(?<property>\S+)/ ) { # The optional \W in the regex might be a quote or backtick
 189                 my $type = $+{type};
 190                 my $value = $+{value};
 191                 my $property = $+{property};
 192                 $property =~ s/['`]//g;
 193                 Koha::Exceptions::Object::BadValue->throw(
 194                     type     => $type,
 195                     value    => $value,
 196                     property => $property =~ /(\w+\.\w+)$/ ? $1 : $property, # results in table.column without quotes or backtics
 197                 );
 198             }
 199         }
 200         # Catch-all for foreign key breakages. It will help find other use cases
 201         $_->rethrow();
 202     }
 203 }
 204
 205 =head3 $object->update();
 206
 207 A shortcut for set + store in one call.
 208
 209 =cut
 210
 211 sub update {
 212     my ($self, $values) = @_;
 213     Koha::Exceptions::Object::NotInStorage->throw unless $self->in_storage;
 214     $self->set($values)->store();
 215 }
 216
 217 =head3 $object->delete();
 218
 219 Removes the object from storage.
 220
 221 Returns:
 222     1  if the deletion was a success
 223     0  if the deletion failed
 224     -1 if the object was never in storage
 225
 226 =cut
 227
 228 sub delete {
 229     my ($self) = @_;
 230
 231     my $deleted = $self->_result()->delete;
 232     if ( ref $deleted ) {
 233         my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
 234         $deleted = $object_class->_new_from_dbic($deleted);
 235     }
 236     return $deleted;
 237 }
 238
 239 =head3 $object->set( $properties_hashref )
 240
 241 $object->set(
 242     {
 243         property1 => $property1,
 244         property2 => $property2,
 245         property3 => $propery3,
 246     }
 247 );
 248
 249 Enables multiple properties to be set at once
 250
 251 Returns:
 252     1      if all properties were set.
 253     0      if one or more properties do not exist.
 254     undef  if all properties exist but a different error
 255            prevents one or more properties from being set.
 256
 257 If one or more of the properties do not exist,
 258 no properties will be set.
 259
 260 =cut
 261
 262 sub set {
 263     my ( $self, $properties ) = @_;
 264
 265     my @columns = @{$self->_columns()};
 266
 267     foreach my $p ( keys %$properties ) {
 268         unless ( grep { $_ eq $p } @columns ) {
 269             Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
 270         }
 271     }
 272
 273     return $self->_result()->set_columns($properties) ? $self : undef;
 274 }
 275
 276 =head3 $object->set_or_blank( $properties_hashref )
 277
 278 $object->set_or_blank(
 279     {
 280         property1 => $property1,
 281         property2 => $property2,
 282         property3 => $propery3,
 283     }
 284 );
 285
 286 If not listed in $properties_hashref, the property will be set to the default
 287 value defined at DB level, or nulled.
 288
 289 =cut
 290
 291
 292 sub set_or_blank {
 293     my ( $self, $properties ) = @_;
 294
 295     my $columns_info = $self->_result->result_source->columns_info;
 296
 297     foreach my $col ( keys %{$columns_info} ) {
 298
 299         next if exists $properties->{$col};
 300
 301         if ( $columns_info->{$col}->{is_nullable} ) {
 302             $properties->{$col} = undef;
 303         } else {
 304             $properties->{$col} = $columns_info->{$col}->{default_value};
 305         }
 306     }
 307
 308     return $self->set($properties);
 309 }
 310
 311 =head3 $object->unblessed();
 312
 313 Returns an unblessed representation of object.
 314
 315 =cut
 316
 317 sub unblessed {
 318     my ($self) = @_;
 319
 320     return { $self->_result->get_columns };
 321 }
 322
 323 =head3 $object->get_from_storage;
 324
 325 =cut
 326
 327 sub get_from_storage {
 328     my ( $self, $attrs ) = @_;
 329     my $stored_object = $self->_result->get_from_storage($attrs);
 330     return unless $stored_object;
 331     my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
 332     return $object_class->_new_from_dbic($stored_object);
 333 }
 334
 335 =head3 $object->TO_JSON
 336
 337 Returns an unblessed representation of the object, suitable for JSON output.
 338
 339 =cut
 340
 341 sub TO_JSON {
 342
 343     my ($self) = @_;
 344
 345     my $unblessed    = $self->unblessed;
 346     my $columns_info = Koha::Database->new->schema->resultset( $self->_type )
 347         ->result_source->{_columns};
 348
 349     foreach my $col ( keys %{$columns_info} ) {
 350
 351         if ( $columns_info->{$col}->{is_boolean} )
 352         {    # Handle booleans gracefully
 353             $unblessed->{$col}
 354                 = ( $unblessed->{$col} )
 355                 ? Mojo::JSON->true
 356                 : Mojo::JSON->false;
 357         }
 358         elsif ( _numeric_column_type( $columns_info->{$col}->{data_type} )
 359             and looks_like_number( $unblessed->{$col} )
 360         ) {
 361
 362             # TODO: Remove once the solution for
 363             # https://rt.cpan.org/Ticket/Display.html?id=119904
 364             # is ported to whatever distro we support by that time
 365             $unblessed->{$col} += 0;
 366         }
 367         elsif ( _decimal_column_type( $columns_info->{$col}->{data_type} )
 368             and looks_like_number( $unblessed->{$col} )
 369         ) {
 370
 371             # TODO: Remove once the solution for
 372             # https://rt.cpan.org/Ticket/Display.html?id=119904
 373             # is ported to whatever distro we support by that time
 374             $unblessed->{$col} += 0.00;
 375         }
 376         elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
 377             eval {
 378                 return unless $unblessed->{$col};
 379                 $unblessed->{$col} = output_pref({
 380                     dateformat => 'rfc3339',
 381                     dt         => dt_from_string($unblessed->{$col}, 'sql'),
 382                 });
 383             };
 384         }
 385     }
 386     return $unblessed;
 387 }
 388
 389 sub _date_or_datetime_column_type {
 390     my ($column_type) = @_;
 391
 392     my @dt_types = (
 393         'timestamp',
 394         'date',
 395         'datetime'
 396     );
 397
 398     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 399 }
 400 sub _datetime_column_type {
 401     my ($column_type) = @_;
 402
 403     my @dt_types = (
 404         'timestamp',
 405         'datetime'
 406     );
 407
 408     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 409 }
 410
 411 sub _numeric_column_type {
 412     # TODO: Remove once the solution for
 413     # https://rt.cpan.org/Ticket/Display.html?id=119904
 414     # is ported to whatever distro we support by that time
 415     my ($column_type) = @_;
 416
 417     my @numeric_types = (
 418         'bigint',
 419         'integer',
 420         'int',
 421         'mediumint',
 422         'smallint',
 423         'tinyint',
 424     );
 425
 426     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 427 }
 428
 429 sub _decimal_column_type {
 430     # TODO: Remove once the solution for
 431     # https://rt.cpan.org/Ticket/Display.html?id=119904
 432     # is ported to whatever distro we support by that time
 433     my ($column_type) = @_;
 434
 435     my @decimal_types = (
 436         'decimal',
 437         'double precision',
 438         'float'
 439     );
 440
 441     return ( grep { $column_type eq $_ } @decimal_types) ? 1 : 0;
 442 }
 443
 444 =head3 prefetch_whitelist
 445
 446     my $whitelist = $object->prefetch_whitelist()
 447
 448 Returns a hash of prefetchable subs and the type they return.
 449
 450 =cut
 451
 452 sub prefetch_whitelist {
 453     my ( $self ) = @_;
 454
 455     my $whitelist = {};
 456     my $relations = $self->_result->result_source->_relationships;
 457
 458     foreach my $key (keys %{$relations}) {
 459         if($self->can($key)) {
 460             my $result_class = $relations->{$key}->{class};
 461             my $obj = $result_class->new;
 462             try {
 463                 $whitelist->{$key} = Koha::Object::_get_object_class( $obj->result_class );
 464             } catch {
 465                 $whitelist->{$key} = undef;
 466             }
 467         }
 468     }
 469
 470     return $whitelist;
 471 }
 472
 473 =head3 to_api
 474
 475     my $object_for_api = $object->to_api(
 476         {
 477           [ embed => {
 478                 items => {
 479                     children => {
 480                         holds => {,
 481                             children => {
 482                               ...
 483                             }
 484                         }
 485                     }
 486                 },
 487                 library => {
 488                     ...
 489                 }
 490             },
 491             ...
 492          ]
 493         }
 494     );
 495
 496 Returns a representation of the object, suitable for API output.
 497
 498 =cut
 499
 500 sub to_api {
 501     my ( $self, $params ) = @_;
 502     my $json_object = $self->TO_JSON;
 503
 504     my $to_api_mapping = $self->to_api_mapping;
 505
 506     # Rename attributes if there's a mapping
 507     if ( $self->can('to_api_mapping') ) {
 508         foreach my $column ( keys %{ $self->to_api_mapping } ) {
 509             my $mapped_column = $self->to_api_mapping->{$column};
 510             if ( exists $json_object->{$column}
 511                 && defined $mapped_column )
 512             {
 513                 # key != undef
 514                 $json_object->{$mapped_column} = delete $json_object->{$column};
 515             }
 516             elsif ( exists $json_object->{$column}
 517                 && !defined $mapped_column )
 518             {
 519                 # key == undef
 520                 delete $json_object->{$column};
 521             }
 522         }
 523     }
 524
 525     my $embeds = $params->{embed};
 526
 527     if ($embeds) {
 528         foreach my $embed ( keys %{$embeds} ) {
 529             if ( $embed =~ m/^(?<relation>.*)_count$/
 530                 and $embeds->{$embed}->{is_count} ) {
 531
 532                 my $relation = $+{relation};
 533                 $json_object->{$embed} = $self->$relation->count;
 534             }
 535             else {
 536                 my $curr = $embed;
 537                 my $next = $embeds->{$curr}->{children};
 538
 539                 my $children = $self->$curr;
 540
 541                 if ( defined $children and ref($children) eq 'ARRAY' ) {
 542                     my @list = map {
 543                         $self->_handle_to_api_child(
 544                             { child => $_, next => $next, curr => $curr } )
 545                     } @{$children};
 546                     $json_object->{$curr} = \@list;
 547                 }
 548                 else {
 549                     $json_object->{$curr} = $self->_handle_to_api_child(
 550                         { child => $children, next => $next, curr => $curr } );
 551                 }
 552             }
 553         }
 554     }
 555
 556
 557
 558     return $json_object;
 559 }
 560
 561 =head3 to_api_mapping
 562
 563     my $mapping = $object->to_api_mapping;
 564
 565 Generic method that returns the attribute name mappings required to
 566 render the object on the API.
 567
 568 Note: this only returns an empty I<hashref>. Each class should have its
 569 own mapping returned.
 570
 571 =cut
 572
 573 sub to_api_mapping {
 574     return {};
 575 }
 576
 577 =head3 from_api_mapping
 578
 579     my $mapping = $object->from_api_mapping;
 580
 581 Generic method that returns the attribute name mappings so the data that
 582 comes from the API is correctly renamed to match what is required for the DB.
 583
 584 =cut
 585
 586 sub from_api_mapping {
 587     my ( $self ) = @_;
 588
 589     my $to_api_mapping = $self->to_api_mapping;
 590
 591     unless ( $self->{_from_api_mapping} ) {
 592         while (my ($key, $value) = each %{ $to_api_mapping } ) {
 593             $self->{_from_api_mapping}->{$value} = $key
 594                 if defined $value;
 595         }
 596     }
 597
 598     return $self->{_from_api_mapping};
 599 }
 600
 601 =head3 new_from_api
 602
 603     my $object = Koha::Object->new_from_api;
 604     my $object = Koha::Object->new_from_api( $attrs );
 605
 606 Creates a new object, mapping the API attribute names to the ones on the DB schema.
 607
 608 =cut
 609
 610 sub new_from_api {
 611     my ( $class, $params ) = @_;
 612
 613     my $self = $class->new;
 614     return $self->set_from_api( $params );
 615 }
 616
 617 =head3 set_from_api
 618
 619     my $object = Koha::Object->new(...);
 620     $object->set_from_api( $attrs )
 621
 622 Sets the object's attributes mapping API attribute names to the ones on the DB schema.
 623
 624 =cut
 625
 626 sub set_from_api {
 627     my ( $self, $from_api_params ) = @_;
 628
 629     return $self->set( $self->attributes_from_api( $from_api_params ) );
 630 }
 631
 632 =head3 attributes_from_api
 633
 634     my $attributes = attributes_from_api( $params );
 635
 636 Returns the passed params, converted from API naming into the model.
 637
 638 =cut
 639
 640 sub attributes_from_api {
 641     my ( $self, $from_api_params ) = @_;
 642
 643     my $from_api_mapping = $self->from_api_mapping;
 644
 645     my $params;
 646     my $columns_info = $self->_result->result_source->columns_info;
 647
 648     while (my ($key, $value) = each %{ $from_api_params } ) {
 649         my $koha_field_name =
 650           exists $from_api_mapping->{$key}
 651           ? $from_api_mapping->{$key}
 652           : $key;
 653
 654         if ( $columns_info->{$koha_field_name}->{is_boolean} ) {
 655             # TODO: Remove when D8 is formally deprecated
 656             # Handle booleans gracefully
 657             $value = ( $value ) ? 1 : 0;
 658         }
 659         elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
 660             try {
 661                 $value = dt_from_string($value, 'rfc3339');
 662             }
 663             catch {
 664                 Koha::Exceptions::BadParameter->throw( parameter => $key );
 665             };
 666         }
 667
 668         $params->{$koha_field_name} = $value;
 669     }
 670
 671     return $params;
 672 }
 673
 674 =head3 $object->unblessed_all_relateds
 675
 676 my $everything_into_one_hashref = $object->unblessed_all_relateds
 677
 678 The unblessed method only retrieves column' values for the column of the object.
 679 In a *few* cases we want to retrieve the information of all the prefetched data.
 680
 681 =cut
 682
 683 sub unblessed_all_relateds {
 684     my ($self) = @_;
 685
 686     my %data;
 687     my $related_resultsets = $self->_result->{related_resultsets} || {};
 688     my $rs = $self->_result;
 689     while ( $related_resultsets and %$related_resultsets ) {
 690         my @relations = keys %{ $related_resultsets };
 691         if ( @relations ) {
 692             my $relation = $relations[0];
 693             $rs = $rs->related_resultset($relation)->get_cache;
 694             $rs = $rs->[0]; # Does it makes sense to have several values here?
 695             my $object_class = Koha::Object::_get_object_class( $rs->result_class );
 696             my $koha_object = $object_class->_new_from_dbic( $rs );
 697             $related_resultsets = $rs->{related_resultsets};
 698             %data = ( %data, %{ $koha_object->unblessed } );
 699         }
 700     }
 701     %data = ( %data, %{ $self->unblessed } );
 702     return \%data;
 703 }
 704
 705 =head3 $object->_result();
 706
 707 Returns the internal DBIC Row object
 708
 709 =cut
 710
 711 sub _result {
 712     my ($self) = @_;
 713
 714     # If we don't have a dbic row at this point, we need to create an empty one
 715     $self->{_result} ||=
 716       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 717
 718     return $self->{_result};
 719 }
 720
 721 =head3 $object->_columns();
 722
 723 Returns an arrayref of the table columns
 724
 725 =cut
 726
 727 sub _columns {
 728     my ($self) = @_;
 729
 730     # If we don't have a dbic row at this point, we need to create an empty one
 731     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 732
 733     return $self->{_columns};
 734 }
 735
 736 sub _get_object_class {
 737     my ( $type ) = @_;
 738     return unless $type;
 739
 740     if( $type->can('koha_object_class') ) {
 741         return $type->koha_object_class;
 742     }
 743     $type =~ s|Schema::Result::||;
 744     return ${type};
 745 }
 746
 747 =head3 AUTOLOAD
 748
 749 The autoload method is used only to get and set values for an objects properties.
 750
 751 =cut
 752
 753 sub AUTOLOAD {
 754     my $self = shift;
 755
 756     my $method = our $AUTOLOAD;
 757     $method =~ s/.*://;
 758
 759     my @columns = @{$self->_columns()};
 760     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 761     if ( grep { $_ eq $method } @columns ) {
 762         if ( @_ ) {
 763             $self->_result()->set_column( $method, @_ );
 764             return $self;
 765         } else {
 766             my $value = $self->_result()->get_column( $method );
 767             return $value;
 768         }
 769     }
 770
 771     my @known_methods = qw( is_changed id in_storage get_column discard_changes make_column_dirty );
 772
 773     Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
 774         error      => sprintf("The method %s->%s is not covered by tests!", ref($self), $method),
 775         show_trace => 1
 776     ) unless grep { $_ eq $method } @known_methods;
 777
 778
 779     my $r = eval { $self->_result->$method(@_) };
 780     if ( $@ ) {
 781         Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
 782     }
 783     return $r;
 784 }
 785
 786 =head3 _type
 787
 788 This method must be defined in the child class. The value is the name of the DBIC resultset.
 789 For example, for borrowers, the _type method will return "Borrower".
 790
 791 =cut
 792
 793 sub _type { }
 794
 795 =head3 _handle_to_api_child
 796
 797 =cut
 798
 799 sub _handle_to_api_child {
 800     my ($self, $args ) = @_;
 801
 802     my $child = $args->{child};
 803     my $next  = $args->{next};
 804     my $curr  = $args->{curr};
 805
 806     my $res;
 807
 808     if ( defined $child ) {
 809
 810         Koha::Exceptions::Exception->throw( "Asked to embed $curr but its return value doesn't implement to_api" )
 811             if defined $next and blessed $child and !$child->can('to_api');
 812
 813         if ( blessed $child ) {
 814             $res = $child->to_api({ embed => $next });
 815         }
 816         else {
 817             $res = $child;
 818         }
 819     }
 820
 821     return $res;
 822 }
 823
 824 sub DESTROY { }
 825
 826 =head1 AUTHOR
 827
 828 Kyle M Hall <kyle@bywatersolutions.com>
 829
 830 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 831
 832 =cut
 833
 834 1;