Koha/Object.pm

   1 package Koha::Object;
   2
   3 # Copyright ByWater Solutions 2014
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Modern::Perl;
  21
  22 use Carp;
  23 use Encode qw{encode};
  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     1  if the store was a success
 103     0  if the store failed
 104
 105 =cut
 106
 107 sub store {
 108     my ($self) = @_;
 109
 110     return $self->_result()->update_or_insert() ? 1 : 0;
 111 }
 112
 113 =head3 $object->in_storage();
 114
 115 Returns true if the object has been previously stored.
 116
 117 =cut
 118
 119 sub in_storage {
 120     my ($self) = @_;
 121
 122     return $self->_result()->in_storage();
 123 }
 124
 125 =head3 $object->is_changed();
 126
 127 Returns true if the object has properties that are different from
 128 the properties of the object in storage.
 129
 130 =cut
 131
 132 sub is_changed {
 133     my ( $self, @columns ) = @_;
 134
 135     return $self->_result()->is_changed(@columns);
 136 }
 137
 138 =head3 $object->delete();
 139
 140 Removes the object from storage.
 141
 142 Returns:
 143     1  if the deletion was a success
 144     0  if the deletion failed
 145     -1 if the object was never in storage
 146
 147 =cut
 148
 149 sub delete {
 150     my ($self) = @_;
 151
 152     # Deleting something not in storage thows an exception
 153     return -1 unless $self->_result()->in_storage();
 154
 155     # Return a boolean for succcess
 156     return $self->_result()->delete() ? 1 : 0;
 157 }
 158
 159 =head3 $object->set( $properties_hashref )
 160
 161 $object->set(
 162     {
 163         property1 => $property1,
 164         property2 => $property2,
 165         property3 => $propery3,
 166     }
 167 );
 168
 169 Enables multiple properties to be set at once
 170
 171 Returns:
 172     1      if all properties were set.
 173     0      if one or more properties do not exist.
 174     undef  if all properties exist but a different error
 175            prevents one or more properties from being set.
 176
 177 If one or more of the properties do not exist,
 178 no properties will be set.
 179
 180 =cut
 181
 182 sub set {
 183     my ( $self, $properties ) = @_;
 184
 185     my @columns = @{$self->_columns()};
 186
 187     foreach my $p ( keys %$properties ) {
 188         unless ( grep {/^$p$/} @columns ) {
 189             carp("No property $p!");
 190             return 0;
 191         }
 192     }
 193
 194     return $self->_result()->set_columns($properties) ? 1 : undef;
 195 }
 196
 197 =head3 $object->id();
 198
 199 Returns the id of the object if it has one.
 200
 201 =cut
 202
 203 sub id {
 204     my ($self) = @_;
 205
 206     my ( $id ) = $self->_result()->id();
 207
 208     return $id;
 209 }
 210
 211 =head3 $object->_result();
 212
 213 Returns the internal DBIC Row object
 214
 215 =cut
 216
 217 sub _result {
 218     my ($self) = @_;
 219
 220     # If we don't have a dbic row at this point, we need to create an empty one
 221     $self->{_result} ||=
 222       Koha::Database->new()->schema()->resultset( $self->type() )->new({});
 223
 224     return $self->{_result};
 225 }
 226
 227 =head3 $object->_columns();
 228
 229 Returns an arrayref of the table columns
 230
 231 =cut
 232
 233 sub _columns {
 234     my ($self) = @_;
 235
 236     # If we don't have a dbic row at this point, we need to create an empty one
 237     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 238
 239     return $self->{_columns};
 240 }
 241
 242
 243 =head3 AUTOLOAD
 244
 245 The autoload method is used only to get and set values for an objects properties.
 246
 247 =cut
 248
 249 sub AUTOLOAD {
 250     my $self = shift;
 251
 252     my $method = our $AUTOLOAD;
 253     $method =~ s/.*://;
 254
 255     my @columns = @{$self->_columns()};
 256     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 257     if ( grep {/^$method$/} @columns ) {
 258         if ( @_ ) {
 259             return $self->_result()->set_column( $method, @_ );
 260         } else {
 261             my $value = $self->_result()->get_column( $method );
 262             return encode( 'UTF-8', $value );
 263         }
 264     }
 265
 266     carp "No method $method!";
 267     return;
 268 }
 269
 270 =head3 type
 271
 272 This method must be defined in the child class. The value is the name of the DBIC resultset.
 273 For example, for borrowers, the type method will return "Borrower".
 274
 275 =cut
 276
 277 sub type { }
 278
 279 sub DESTROY { }
 280
 281 =head1 AUTHOR
 282
 283 Kyle M Hall <kyle@bywatersolutions.com>
 284
 285 =cut
 286
 287 1;