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
  25 use Koha::Database;
  26 use Koha::Exceptions::Object;
  27
  28 =head1 NAME
  29
  30 Koha::Object - Koha Object base class
  31
  32 =head1 SYNOPSIS
  33
  34     use Koha::Object;
  35     my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
  36
  37 =head1 DESCRIPTION
  38
  39 This class must always be subclassed.
  40
  41 =head1 API
  42
  43 =head2 Class Methods
  44
  45 =cut
  46
  47 =head3 Koha::Object->new();
  48
  49 my $object = Koha::Object->new();
  50 my $object = Koha::Object->new($attributes);
  51
  52 Note that this cannot be used to retrieve record from the DB.
  53
  54 =cut
  55
  56 sub new {
  57     my ( $class, $attributes ) = @_;
  58     my $self = {};
  59
  60     if ($attributes) {
  61         my $schema = Koha::Database->new->schema;
  62
  63         # Remove the arguments which exist, are not defined but NOT NULL to use the default value
  64         my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
  65         for my $column_name ( keys %$attributes ) {
  66             my $c_info = $columns_info->{$column_name};
  67             next if $c_info->{is_nullable};
  68             next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
  69             delete $attributes->{$column_name};
  70         }
  71         $self->{_result} = $schema->resultset( $class->_type() )
  72           ->new($attributes);
  73     }
  74
  75     croak("No _type found! Koha::Object must be subclassed!")
  76       unless $class->_type();
  77
  78     bless( $self, $class );
  79
  80 }
  81
  82 =head3 Koha::Object->_new_from_dbic();
  83
  84 my $object = Koha::Object->_new_from_dbic($dbic_row);
  85
  86 =cut
  87
  88 sub _new_from_dbic {
  89     my ( $class, $dbic_row ) = @_;
  90     my $self = {};
  91
  92     # DBIC result row
  93     $self->{_result} = $dbic_row;
  94
  95     croak("No _type found! Koha::Object must be subclassed!")
  96       unless $class->_type();
  97
  98     croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
  99       unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
 100
 101     bless( $self, $class );
 102
 103 }
 104
 105 =head3 $object->store();
 106
 107 Saves the object in storage.
 108 If the object is new, it will be created.
 109 If the object previously existed, it will be updated.
 110
 111 Returns:
 112     $self  if the store was a success
 113     undef  if the store failed
 114
 115 =cut
 116
 117 sub store {
 118     my ($self) = @_;
 119
 120     return $self->_result()->update_or_insert() ? $self : undef;
 121 }
 122
 123 =head3 $object->delete();
 124
 125 Removes the object from storage.
 126
 127 Returns:
 128     1  if the deletion was a success
 129     0  if the deletion failed
 130     -1 if the object was never in storage
 131
 132 =cut
 133
 134 sub delete {
 135     my ($self) = @_;
 136
 137     # Deleting something not in storage throws an exception
 138     return -1 unless $self->_result()->in_storage();
 139
 140     # Return a boolean for succcess
 141     return $self->_result()->delete() ? 1 : 0;
 142 }
 143
 144 =head3 $object->set( $properties_hashref )
 145
 146 $object->set(
 147     {
 148         property1 => $property1,
 149         property2 => $property2,
 150         property3 => $propery3,
 151     }
 152 );
 153
 154 Enables multiple properties to be set at once
 155
 156 Returns:
 157     1      if all properties were set.
 158     0      if one or more properties do not exist.
 159     undef  if all properties exist but a different error
 160            prevents one or more properties from being set.
 161
 162 If one or more of the properties do not exist,
 163 no properties will be set.
 164
 165 =cut
 166
 167 sub set {
 168     my ( $self, $properties ) = @_;
 169
 170     my @columns = @{$self->_columns()};
 171
 172     foreach my $p ( keys %$properties ) {
 173         unless ( grep {/^$p$/} @columns ) {
 174             Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
 175         }
 176     }
 177
 178     return $self->_result()->set_columns($properties) ? $self : undef;
 179 }
 180
 181 =head3 $object->unblessed();
 182
 183 Returns an unblessed representation of object.
 184
 185 =cut
 186
 187 sub unblessed {
 188     my ($self) = @_;
 189
 190     return { $self->_result->get_columns };
 191 }
 192
 193 =head3 $object->_result();
 194
 195 Returns the internal DBIC Row object
 196
 197 =cut
 198
 199 sub _result {
 200     my ($self) = @_;
 201
 202     # If we don't have a dbic row at this point, we need to create an empty one
 203     $self->{_result} ||=
 204       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 205
 206     return $self->{_result};
 207 }
 208
 209 =head3 $object->_columns();
 210
 211 Returns an arrayref of the table columns
 212
 213 =cut
 214
 215 sub _columns {
 216     my ($self) = @_;
 217
 218     # If we don't have a dbic row at this point, we need to create an empty one
 219     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 220
 221     return $self->{_columns};
 222 }
 223
 224 =head3 AUTOLOAD
 225
 226 The autoload method is used only to get and set values for an objects properties.
 227
 228 =cut
 229
 230 sub AUTOLOAD {
 231     my $self = shift;
 232
 233     my $method = our $AUTOLOAD;
 234     $method =~ s/.*://;
 235
 236     my @columns = @{$self->_columns()};
 237     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 238     if ( grep {/^$method$/} @columns ) {
 239         if ( @_ ) {
 240             $self->_result()->set_column( $method, @_ );
 241             return $self;
 242         } else {
 243             my $value = $self->_result()->get_column( $method );
 244             return $value;
 245         }
 246     }
 247
 248     my @known_methods = qw( is_changed id in_storage get_column discard_changes);
 249
 250     Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
 251
 252     my $r = eval { $self->_result->$method(@_) };
 253     if ( $@ ) {
 254         Koha::Exceptions::Object::MethodNotFound->throw( "No method $method for " . ref($self) );
 255     }
 256     return $r;
 257 }
 258
 259 =head3 _type
 260
 261 This method must be defined in the child class. The value is the name of the DBIC resultset.
 262 For example, for borrowers, the _type method will return "Borrower".
 263
 264 =cut
 265
 266 sub _type { }
 267
 268 sub DESTROY { }
 269
 270 =head1 AUTHOR
 271
 272 Kyle M Hall <kyle@bywatersolutions.com>
 273
 274 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 275
 276 =cut
 277
 278 1;