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