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     $self  if the store was a success
 102     undef  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->unblessed();
 211
 212 Returns an unblessed representation of object.
 213
 214 =cut
 215
 216 sub unblessed {
 217     my ($self) = @_;
 218
 219     return { $self->_result->get_columns };
 220 }
 221
 222 =head3 $object->_result();
 223
 224 Returns the internal DBIC Row object
 225
 226 =cut
 227
 228 sub _result {
 229     my ($self) = @_;
 230
 231     # If we don't have a dbic row at this point, we need to create an empty one
 232     $self->{_result} ||=
 233       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 234
 235     return $self->{_result};
 236 }
 237
 238 =head3 $object->_columns();
 239
 240 Returns an arrayref of the table columns
 241
 242 =cut
 243
 244 sub _columns {
 245     my ($self) = @_;
 246
 247     # If we don't have a dbic row at this point, we need to create an empty one
 248     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 249
 250     return $self->{_columns};
 251 }
 252
 253
 254 =head3 AUTOLOAD
 255
 256 The autoload method is used only to get and set values for an objects properties.
 257
 258 =cut
 259
 260 sub AUTOLOAD {
 261     my $self = shift;
 262
 263     my $method = our $AUTOLOAD;
 264     $method =~ s/.*://;
 265
 266     my @columns = @{$self->_columns()};
 267     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 268     if ( grep {/^$method$/} @columns ) {
 269         if ( @_ ) {
 270             $self->_result()->set_column( $method, @_ );
 271             return $self;
 272         } else {
 273             my $value = $self->_result()->get_column( $method );
 274             return $value;
 275         }
 276     }
 277
 278     carp "No method $method!";
 279     return;
 280 }
 281
 282 =head3 _type
 283
 284 This method must be defined in the child class. The value is the name of the DBIC resultset.
 285 For example, for borrowers, the _type method will return "Borrower".
 286
 287 =cut
 288
 289 sub _type { }
 290
 291 sub DESTROY { }
 292
 293 =head1 AUTHOR
 294
 295 Kyle M Hall <kyle@bywatersolutions.com>
 296
 297 =cut
 298
 299 1;