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 under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 3 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24 use Mojo::JSON;
  25
  26 use Koha::Database;
  27 use Koha::Exceptions::Object;
  28
  29 =head1 NAME
  30
  31 Koha::Object - Koha Object base class
  32
  33 =head1 SYNOPSIS
  34
  35     use Koha::Object;
  36     my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
  37
  38 =head1 DESCRIPTION
  39
  40 This class must always be subclassed.
  41
  42 =head1 API
  43
  44 =head2 Class Methods
  45
  46 =cut
  47
  48 =head3 Koha::Object->new();
  49
  50 my $object = Koha::Object->new();
  51 my $object = Koha::Object->new($attributes);
  52
  53 Note that this cannot be used to retrieve record from the DB.
  54
  55 =cut
  56
  57 sub new {
  58     my ( $class, $attributes ) = @_;
  59     my $self = {};
  60
  61     if ($attributes) {
  62         my $schema = Koha::Database->new->schema;
  63
  64         # Remove the arguments which exist, are not defined but NOT NULL to use the default value
  65         my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
  66         for my $column_name ( keys %$attributes ) {
  67             my $c_info = $columns_info->{$column_name};
  68             next if $c_info->{is_nullable};
  69             next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
  70             delete $attributes->{$column_name};
  71         }
  72         $self->{_result} = $schema->resultset( $class->_type() )
  73           ->new($attributes);
  74     }
  75
  76     croak("No _type found! Koha::Object must be subclassed!")
  77       unless $class->_type();
  78
  79     bless( $self, $class );
  80
  81 }
  82
  83 =head3 Koha::Object->_new_from_dbic();
  84
  85 my $object = Koha::Object->_new_from_dbic($dbic_row);
  86
  87 =cut
  88
  89 sub _new_from_dbic {
  90     my ( $class, $dbic_row ) = @_;
  91     my $self = {};
  92
  93     # DBIC result row
  94     $self->{_result} = $dbic_row;
  95
  96     croak("No _type found! Koha::Object must be subclassed!")
  97       unless $class->_type();
  98
  99     croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
 100       unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
 101
 102     bless( $self, $class );
 103
 104 }
 105
 106 =head3 $object->store();
 107
 108 Saves the object in storage.
 109 If the object is new, it will be created.
 110 If the object previously existed, it will be updated.
 111
 112 Returns:
 113     $self  if the store was a success
 114     undef  if the store failed
 115
 116 =cut
 117
 118 sub store {
 119     my ($self) = @_;
 120
 121     return $self->_result()->update_or_insert() ? $self : undef;
 122 }
 123
 124 =head3 $object->delete();
 125
 126 Removes the object from storage.
 127
 128 Returns:
 129     1  if the deletion was a success
 130     0  if the deletion failed
 131     -1 if the object was never in storage
 132
 133 =cut
 134
 135 sub delete {
 136     my ($self) = @_;
 137
 138     # Deleting something not in storage throws an exception
 139     return -1 unless $self->_result()->in_storage();
 140
 141     # Return a boolean for succcess
 142     return $self->_result()->delete() ? 1 : 0;
 143 }
 144
 145 =head3 $object->set( $properties_hashref )
 146
 147 $object->set(
 148     {
 149         property1 => $property1,
 150         property2 => $property2,
 151         property3 => $propery3,
 152     }
 153 );
 154
 155 Enables multiple properties to be set at once
 156
 157 Returns:
 158     1      if all properties were set.
 159     0      if one or more properties do not exist.
 160     undef  if all properties exist but a different error
 161            prevents one or more properties from being set.
 162
 163 If one or more of the properties do not exist,
 164 no properties will be set.
 165
 166 =cut
 167
 168 sub set {
 169     my ( $self, $properties ) = @_;
 170
 171     my @columns = @{$self->_columns()};
 172
 173     foreach my $p ( keys %$properties ) {
 174         unless ( grep {/^$p$/} @columns ) {
 175             Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
 176         }
 177     }
 178
 179     return $self->_result()->set_columns($properties) ? $self : undef;
 180 }
 181
 182 =head3 $object->unblessed();
 183
 184 Returns an unblessed representation of object.
 185
 186 =cut
 187
 188 sub unblessed {
 189     my ($self) = @_;
 190
 191     return { $self->_result->get_columns };
 192 }
 193
 194 =head3 $object->TO_JSON
 195
 196 Returns an unblessed representation of the object, suitable for JSON output.
 197
 198 =cut
 199
 200 sub TO_JSON {
 201
 202     my ($self) = @_;
 203
 204     my $unblessed    = $self->unblessed;
 205     my $columns_info = Koha::Database->new->schema->resultset( $self->_type )
 206         ->result_source->{_columns};
 207
 208     foreach my $col ( keys %{$columns_info} ) {
 209
 210         if ( $columns_info->{$col}->{is_boolean} )
 211         {    # Handle booleans gracefully
 212             $unblessed->{$col}
 213                 = ( $unblessed->{$col} )
 214                 ? Mojo::JSON->true
 215                 : Mojo::JSON->false;
 216         }
 217         elsif ( _numeric_column_type( $columns_info->{$col}->{data_type} ) ) {
 218
 219             # TODO: Remove once the solution for
 220             # https://rt.cpan.org/Ticket/Display.html?id=119904
 221             # is ported to whatever distro we support by that time
 222             $unblessed->{$col} += 0;
 223         }
 224     }
 225     return $unblessed;
 226 }
 227
 228 sub _numeric_column_type {
 229     # TODO: Remove once the solution for
 230     # https://rt.cpan.org/Ticket/Display.html?id=119904
 231     # is ported to whatever distro we support by that time
 232     my ($column_type) = @_;
 233
 234     my @numeric_types = (
 235         'bigint',
 236         'integer',
 237         'int',
 238         'mediumint',
 239         'smallint',
 240         'tinyint',
 241         'decimal',
 242         'double precision',
 243         'float'
 244     );
 245
 246     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 247 }
 248
 249 =head3 $object->_result();
 250
 251 Returns the internal DBIC Row object
 252
 253 =cut
 254
 255 sub _result {
 256     my ($self) = @_;
 257
 258     # If we don't have a dbic row at this point, we need to create an empty one
 259     $self->{_result} ||=
 260       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 261
 262     return $self->{_result};
 263 }
 264
 265 =head3 $object->_columns();
 266
 267 Returns an arrayref of the table columns
 268
 269 =cut
 270
 271 sub _columns {
 272     my ($self) = @_;
 273
 274     # If we don't have a dbic row at this point, we need to create an empty one
 275     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 276
 277     return $self->{_columns};
 278 }
 279
 280 =head3 AUTOLOAD
 281
 282 The autoload method is used only to get and set values for an objects properties.
 283
 284 =cut
 285
 286 sub AUTOLOAD {
 287     my $self = shift;
 288
 289     my $method = our $AUTOLOAD;
 290     $method =~ s/.*://;
 291
 292     my @columns = @{$self->_columns()};
 293     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 294     if ( grep {/^$method$/} @columns ) {
 295         if ( @_ ) {
 296             $self->_result()->set_column( $method, @_ );
 297             return $self;
 298         } else {
 299             my $value = $self->_result()->get_column( $method );
 300             return $value;
 301         }
 302     }
 303
 304     my @known_methods = qw( is_changed id in_storage get_column discard_changes update );
 305     Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
 306
 307     my $r = eval { $self->_result->$method(@_) };
 308     if ( $@ ) {
 309         Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
 310     }
 311     return $r;
 312 }
 313
 314 =head3 _type
 315
 316 This method must be defined in the child class. The value is the name of the DBIC resultset.
 317 For example, for borrowers, the _type method will return "Borrower".
 318
 319 =cut
 320
 321 sub _type { }
 322
 323 sub DESTROY { }
 324
 325 =head1 AUTHOR
 326
 327 Kyle M Hall <kyle@bywatersolutions.com>
 328
 329 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 330
 331 =cut
 332
 333 1;