Koha/Objects.pm

   1 package Koha::Objects;
   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::Objects - Koha Object set base class
  29
  30 =head1 SYNOPSIS
  31
  32     use Koha::Objects;
  33     my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
  34
  35 =head1 DESCRIPTION
  36
  37 This class must be subclassed.
  38
  39 =head1 API
  40
  41 =head2 Class Methods
  42
  43 =cut
  44
  45 =head3 Koha::Objects->new();
  46
  47 my $object = Koha::Objects->new();
  48
  49 =cut
  50
  51 sub new {
  52     my ($class) = @_;
  53     my $self = {};
  54
  55     bless( $self, $class );
  56 }
  57
  58 =head3 Koha::Objects->_new_from_dbic();
  59
  60 my $object = Koha::Objects->_new_from_dbic( $resultset );
  61
  62 =cut
  63
  64 sub _new_from_dbic {
  65     my ( $class, $resultset ) = @_;
  66     my $self = { _resultset => $resultset };
  67
  68     bless( $self, $class );
  69 }
  70
  71 =head3 Koha::Objects->find();
  72
  73 my $object = Koha::Objects->find($id);
  74 my $object = Koha::Objects->find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
  75
  76 =cut
  77
  78 sub find {
  79     my ( $self, $id ) = @_;
  80
  81     return unless defined($id);
  82
  83     my $result = $self->_resultset()->find($id);
  84
  85     return unless $result;
  86
  87     my $object = $self->object_class()->_new_from_dbic( $result );
  88
  89     return $object;
  90 }
  91
  92 =head3 Koha::Objects->find_or_create();
  93
  94 my $object = Koha::Objects->find_or_create( $attrs );
  95
  96 =cut
  97
  98 sub find_or_create {
  99     my ( $self, $params ) = @_;
 100
 101     my $result = $self->_resultset->find_or_create($params);
 102
 103     return unless $result;
 104
 105     my $object = $self->object_class->_new_from_dbic($result);
 106
 107     return $object;
 108 }
 109
 110 =head3 Koha::Objects->search();
 111
 112 my @objects = Koha::Objects->search($params);
 113
 114 =cut
 115
 116 sub search {
 117     my ( $self, $params, $attributes ) = @_;
 118
 119     if (wantarray) {
 120         my @dbic_rows = $self->_resultset()->search($params, $attributes);
 121
 122         return $self->_wrap(@dbic_rows);
 123
 124     }
 125     else {
 126         my $class = ref($self) ? ref($self) : $self;
 127         my $rs = $self->_resultset()->search($params, $attributes);
 128
 129         return $class->_new_from_dbic($rs);
 130     }
 131 }
 132
 133 =head3 Koha::Objects->next();
 134
 135 my $object = Koha::Objects->next();
 136
 137 Returns the next object that is part of this set.
 138 Returns undef if there are no more objects to return.
 139
 140 =cut
 141
 142 sub next {
 143     my ( $self ) = @_;
 144
 145     my $result = $self->_resultset()->next();
 146     return unless $result;
 147
 148     my $object = $self->object_class()->_new_from_dbic( $result );
 149
 150     return $object;
 151 }
 152
 153 =head3 Koha::Objects->as_list();
 154
 155 Koha::Objects->as_list();
 156
 157 Returns an arrayref of the objects in this set.
 158
 159 =cut
 160
 161 sub as_list {
 162     my ( $self ) = @_;
 163
 164     my @dbic_rows = $self->_resultset()->all();
 165
 166     my @objects = $self->_wrap(@dbic_rows);
 167
 168     return wantarray ? @objects : \@objects;
 169 }
 170
 171 =head3 Koha::Objects->unblessed
 172
 173 Returns an unblessed representation of objects.
 174
 175 =cut
 176
 177 sub unblessed {
 178     my ($self) = @_;
 179
 180     return [ map { $_->unblessed } $self->as_list ];
 181 }
 182
 183 =head3 Koha::Objects->_wrap
 184
 185 wraps the DBIC object in a corresponding Koha object
 186
 187 =cut
 188
 189 sub _wrap {
 190     my ( $self, @dbic_rows ) = @_;
 191
 192     my @objects = map { $self->object_class()->_new_from_dbic( $_ ) } @dbic_rows;
 193
 194     return @objects;
 195 }
 196
 197 =head3 Koha::Objects->_resultset
 198
 199 Returns the internal resultset or creates it if undefined
 200
 201 =cut
 202
 203 sub _resultset {
 204     my ($self) = @_;
 205
 206     if ( ref($self) ) {
 207         $self->{_resultset} ||=
 208           Koha::Database->new()->schema()->resultset( $self->_type() );
 209
 210         return $self->{_resultset};
 211     }
 212     else {
 213         return Koha::Database->new()->schema()->resultset( $self->_type() );
 214     }
 215 }
 216
 217 =head3 columns
 218
 219 my @columns = Koha::Objects->columns
 220
 221 Return the table columns
 222
 223 =cut
 224
 225 sub columns {
 226     my ( $class ) = @_;
 227     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 228 }
 229
 230 =head3 AUTOLOAD
 231
 232 The autoload method is used call DBIx::Class method on a resultset.
 233
 234 Important: If you plan to use one of the DBIx::Class methods you must provide
 235 relevant tests in t/db_dependent/Koha/Objects.t
 236 Currently count, pager, reset, update and delete are covered.
 237
 238 =cut
 239
 240 sub AUTOLOAD {
 241     my ( $self, @params ) = @_;
 242
 243     my @known_methods = qw( count pager reset update delete );
 244     my $method = our $AUTOLOAD;
 245     $method =~ s/.*:://;
 246
 247     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 248     my $r = eval { $self->_resultset->$method(@params) };
 249     if ( $@ ) {
 250         carp "No method $method found for " . ref($self) . " " . $@;
 251         return
 252     }
 253     return $r;
 254 }
 255
 256 =head3 _type
 257
 258 The _type method must be set for all child classes.
 259 The value returned by it should be the DBIC resultset name.
 260 For example, for holds, _type should return 'Reserve'.
 261
 262 =cut
 263
 264 sub _type { }
 265
 266 =head3 object_class
 267
 268 This method must be set for all child classes.
 269 The value returned by it should be the name of the Koha
 270 object class that is returned by this class.
 271 For example, for holds, object_class should return 'Koha::Hold'.
 272
 273 =cut
 274
 275 sub object_class { }
 276
 277 sub DESTROY { }
 278
 279 =head1 AUTHOR
 280
 281 Kyle M Hall <kyle@bywatersolutions.com>
 282
 283 =cut
 284
 285 1;