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