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