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