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