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://github.com/perl5-dbi/DBD-mysql/issues/212
 364             # is ported to whatever distro we support by that time
 365             # or we move to DBD::MariaDB
 366             $unblessed->{$col} += 0;
 367         }
 368         elsif ( _decimal_column_type( $columns_info->{$col}->{data_type} )
 369             and looks_like_number( $unblessed->{$col} )
 370         ) {
 371
 372             # TODO: Remove once the solution for
 373             # https://github.com/perl5-dbi/DBD-mysql/issues/212
 374             # is ported to whatever distro we support by that time
 375             # or we move to DBD::MariaDB
 376             $unblessed->{$col} += 0.00;
 377         }
 378         elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
 379             eval {
 380                 return unless $unblessed->{$col};
 381                 $unblessed->{$col} = output_pref({
 382                     dateformat => 'rfc3339',
 383                     dt         => dt_from_string($unblessed->{$col}, 'sql'),
 384                 });
 385             };
 386         }
 387     }
 388     return $unblessed;
 389 }
 390
 391 sub _date_or_datetime_column_type {
 392     my ($column_type) = @_;
 393
 394     my @dt_types = (
 395         'timestamp',
 396         'date',
 397         'datetime'
 398     );
 399
 400     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 401 }
 402 sub _datetime_column_type {
 403     my ($column_type) = @_;
 404
 405     my @dt_types = (
 406         'timestamp',
 407         'datetime'
 408     );
 409
 410     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 411 }
 412
 413 sub _numeric_column_type {
 414     # TODO: Remove once the solution for
 415     # https://github.com/perl5-dbi/DBD-mysql/issues/212
 416     # is ported to whatever distro we support by that time
 417     # or we move to DBD::MariaDB
 418     my ($column_type) = @_;
 419
 420     my @numeric_types = (
 421         'bigint',
 422         'integer',
 423         'int',
 424         'mediumint',
 425         'smallint',
 426         'tinyint',
 427     );
 428
 429     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 430 }
 431
 432 sub _decimal_column_type {
 433     # TODO: Remove once the solution for
 434     # https://github.com/perl5-dbi/DBD-mysql/issues/212
 435     # is ported to whatever distro we support by that time
 436     # or we move to DBD::MariaDB
 437     my ($column_type) = @_;
 438
 439     my @decimal_types = (
 440         'decimal',
 441         'double precision',
 442         'float'
 443     );
 444
 445     return ( grep { $column_type eq $_ } @decimal_types) ? 1 : 0;
 446 }
 447
 448 =head3 prefetch_whitelist
 449
 450     my $whitelist = $object->prefetch_whitelist()
 451
 452 Returns a hash of prefetchable subs and the type they return.
 453
 454 =cut
 455
 456 sub prefetch_whitelist {
 457     my ( $self ) = @_;
 458
 459     my $whitelist = {};
 460     my $relations = $self->_result->result_source->_relationships;
 461
 462     foreach my $key (keys %{$relations}) {
 463         if($self->can($key)) {
 464             my $result_class = $relations->{$key}->{class};
 465             my $obj = $result_class->new;
 466             try {
 467                 $whitelist->{$key} = Koha::Object::_get_object_class( $obj->result_class );
 468             } catch {
 469                 $whitelist->{$key} = undef;
 470             }
 471         }
 472     }
 473
 474     return $whitelist;
 475 }
 476
 477 =head3 to_api
 478
 479     my $object_for_api = $object->to_api(
 480         {
 481           [ embed => {
 482                 items => {
 483                     children => {
 484                         holds => {,
 485                             children => {
 486                               ...
 487                             }
 488                         }
 489                     }
 490                 },
 491                 library => {
 492                     ...
 493                 }
 494             },
 495             ...
 496          ]
 497         }
 498     );
 499
 500 Returns a representation of the object, suitable for API output.
 501
 502 =cut
 503
 504 sub to_api {
 505     my ( $self, $params ) = @_;
 506     my $json_object = $self->TO_JSON;
 507
 508     my $to_api_mapping = $self->to_api_mapping;
 509
 510     # Rename attributes if there's a mapping
 511     if ( $self->can('to_api_mapping') ) {
 512         foreach my $column ( keys %{ $self->to_api_mapping } ) {
 513             my $mapped_column = $self->to_api_mapping->{$column};
 514             if ( exists $json_object->{$column}
 515                 && defined $mapped_column )
 516             {
 517                 # key != undef
 518                 $json_object->{$mapped_column} = delete $json_object->{$column};
 519             }
 520             elsif ( exists $json_object->{$column}
 521                 && !defined $mapped_column )
 522             {
 523                 # key == undef
 524                 delete $json_object->{$column};
 525             }
 526         }
 527     }
 528
 529     my $embeds = $params->{embed};
 530
 531     if ($embeds) {
 532         foreach my $embed ( keys %{$embeds} ) {
 533             if ( $embed =~ m/^(?<relation>.*)_count$/
 534                 and $embeds->{$embed}->{is_count} ) {
 535
 536                 my $relation = $+{relation};
 537                 $json_object->{$embed} = $self->$relation->count;
 538             }
 539             else {
 540                 my $curr = $embed;
 541                 my $next = $embeds->{$curr}->{children};
 542
 543                 my $children = $self->$curr;
 544
 545                 if ( defined $children and ref($children) eq 'ARRAY' ) {
 546                     my @list = map {
 547                         $self->_handle_to_api_child(
 548                             { child => $_, next => $next, curr => $curr } )
 549                     } @{$children};
 550                     $json_object->{$curr} = \@list;
 551                 }
 552                 else {
 553                     $json_object->{$curr} = $self->_handle_to_api_child(
 554                         { child => $children, next => $next, curr => $curr } );
 555                 }
 556             }
 557         }
 558     }
 559
 560
 561
 562     return $json_object;
 563 }
 564
 565 =head3 to_api_mapping
 566
 567     my $mapping = $object->to_api_mapping;
 568
 569 Generic method that returns the attribute name mappings required to
 570 render the object on the API.
 571
 572 Note: this only returns an empty I<hashref>. Each class should have its
 573 own mapping returned.
 574
 575 =cut
 576
 577 sub to_api_mapping {
 578     return {};
 579 }
 580
 581 =head3 from_api_mapping
 582
 583     my $mapping = $object->from_api_mapping;
 584
 585 Generic method that returns the attribute name mappings so the data that
 586 comes from the API is correctly renamed to match what is required for the DB.
 587
 588 =cut
 589
 590 sub from_api_mapping {
 591     my ( $self ) = @_;
 592
 593     my $to_api_mapping = $self->to_api_mapping;
 594
 595     unless ( $self->{_from_api_mapping} ) {
 596         while (my ($key, $value) = each %{ $to_api_mapping } ) {
 597             $self->{_from_api_mapping}->{$value} = $key
 598                 if defined $value;
 599         }
 600     }
 601
 602     return $self->{_from_api_mapping};
 603 }
 604
 605 =head3 new_from_api
 606
 607     my $object = Koha::Object->new_from_api;
 608     my $object = Koha::Object->new_from_api( $attrs );
 609
 610 Creates a new object, mapping the API attribute names to the ones on the DB schema.
 611
 612 =cut
 613
 614 sub new_from_api {
 615     my ( $class, $params ) = @_;
 616
 617     my $self = $class->new;
 618     return $self->set_from_api( $params );
 619 }
 620
 621 =head3 set_from_api
 622
 623     my $object = Koha::Object->new(...);
 624     $object->set_from_api( $attrs )
 625
 626 Sets the object's attributes mapping API attribute names to the ones on the DB schema.
 627
 628 =cut
 629
 630 sub set_from_api {
 631     my ( $self, $from_api_params ) = @_;
 632
 633     return $self->set( $self->attributes_from_api( $from_api_params ) );
 634 }
 635
 636 =head3 attributes_from_api
 637
 638     my $attributes = attributes_from_api( $params );
 639
 640 Returns the passed params, converted from API naming into the model.
 641
 642 =cut
 643
 644 sub attributes_from_api {
 645     my ( $self, $from_api_params ) = @_;
 646
 647     my $from_api_mapping = $self->from_api_mapping;
 648
 649     my $params;
 650     my $columns_info = $self->_result->result_source->columns_info;
 651
 652     while (my ($key, $value) = each %{ $from_api_params } ) {
 653         my $koha_field_name =
 654           exists $from_api_mapping->{$key}
 655           ? $from_api_mapping->{$key}
 656           : $key;
 657
 658         if ( $columns_info->{$koha_field_name}->{is_boolean} ) {
 659             # TODO: Remove when D8 is formally deprecated
 660             # Handle booleans gracefully
 661             $value = ( $value ) ? 1 : 0;
 662         }
 663         elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
 664             try {
 665                 $value = dt_from_string($value, 'rfc3339');
 666             }
 667             catch {
 668                 Koha::Exceptions::BadParameter->throw( parameter => $key );
 669             };
 670         }
 671
 672         $params->{$koha_field_name} = $value;
 673     }
 674
 675     return $params;
 676 }
 677
 678 =head3 $object->unblessed_all_relateds
 679
 680 my $everything_into_one_hashref = $object->unblessed_all_relateds
 681
 682 The unblessed method only retrieves column' values for the column of the object.
 683 In a *few* cases we want to retrieve the information of all the prefetched data.
 684
 685 =cut
 686
 687 sub unblessed_all_relateds {
 688     my ($self) = @_;
 689
 690     my %data;
 691     my $related_resultsets = $self->_result->{related_resultsets} || {};
 692     my $rs = $self->_result;
 693     while ( $related_resultsets and %$related_resultsets ) {
 694         my @relations = keys %{ $related_resultsets };
 695         if ( @relations ) {
 696             my $relation = $relations[0];
 697             $rs = $rs->related_resultset($relation)->get_cache;
 698             $rs = $rs->[0]; # Does it makes sense to have several values here?
 699             my $object_class = Koha::Object::_get_object_class( $rs->result_class );
 700             my $koha_object = $object_class->_new_from_dbic( $rs );
 701             $related_resultsets = $rs->{related_resultsets};
 702             %data = ( %data, %{ $koha_object->unblessed } );
 703         }
 704     }
 705     %data = ( %data, %{ $self->unblessed } );
 706     return \%data;
 707 }
 708
 709 =head3 $object->_result();
 710
 711 Returns the internal DBIC Row object
 712
 713 =cut
 714
 715 sub _result {
 716     my ($self) = @_;
 717
 718     # If we don't have a dbic row at this point, we need to create an empty one
 719     $self->{_result} ||=
 720       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 721
 722     return $self->{_result};
 723 }
 724
 725 =head3 $object->_columns();
 726
 727 Returns an arrayref of the table columns
 728
 729 =cut
 730
 731 sub _columns {
 732     my ($self) = @_;
 733
 734     # If we don't have a dbic row at this point, we need to create an empty one
 735     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 736
 737     return $self->{_columns};
 738 }
 739
 740 sub _get_object_class {
 741     my ( $type ) = @_;
 742     return unless $type;
 743
 744     if( $type->can('koha_object_class') ) {
 745         return $type->koha_object_class;
 746     }
 747     $type =~ s|Schema::Result::||;
 748     return ${type};
 749 }
 750
 751 =head3 AUTOLOAD
 752
 753 The autoload method is used only to get and set values for an objects properties.
 754
 755 =cut
 756
 757 sub AUTOLOAD {
 758     my $self = shift;
 759
 760     my $method = our $AUTOLOAD;
 761     $method =~ s/.*://;
 762
 763     my @columns = @{$self->_columns()};
 764     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 765     if ( grep { $_ eq $method } @columns ) {
 766         if ( @_ ) {
 767             $self->_result()->set_column( $method, @_ );
 768             return $self;
 769         } else {
 770             my $value = $self->_result()->get_column( $method );
 771             return $value;
 772         }
 773     }
 774
 775     my @known_methods = qw( is_changed id in_storage get_column discard_changes make_column_dirty );
 776
 777     Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
 778         error      => sprintf("The method %s->%s is not covered by tests!", ref($self), $method),
 779         show_trace => 1
 780     ) unless grep { $_ eq $method } @known_methods;
 781
 782
 783     my $r = eval { $self->_result->$method(@_) };
 784     if ( $@ ) {
 785         Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
 786     }
 787     return $r;
 788 }
 789
 790 =head3 _type
 791
 792 This method must be defined in the child class. The value is the name of the DBIC resultset.
 793 For example, for borrowers, the _type method will return "Borrower".
 794
 795 =cut
 796
 797 sub _type { }
 798
 799 =head3 _handle_to_api_child
 800
 801 =cut
 802
 803 sub _handle_to_api_child {
 804     my ($self, $args ) = @_;
 805
 806     my $child = $args->{child};
 807     my $next  = $args->{next};
 808     my $curr  = $args->{curr};
 809
 810     my $res;
 811
 812     if ( defined $child ) {
 813
 814         Koha::Exceptions::Exception->throw( "Asked to embed $curr but its return value doesn't implement to_api" )
 815             if defined $next and blessed $child and !$child->can('to_api');
 816
 817         if ( blessed $child ) {
 818             $res = $child->to_api({ embed => $next });
 819         }
 820         else {
 821             $res = $child;
 822         }
 823     }
 824
 825     return $res;
 826 }
 827
 828 sub DESTROY { }
 829
 830 =head1 AUTHOR
 831
 832 Kyle M Hall <kyle@bywatersolutions.com>
 833
 834 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 835
 836 =cut
 837
 838 1;