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