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