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