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 search_related
 134
 135     my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 136     my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 137
 138 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
 139
 140 =cut
 141
 142 sub search_related {
 143     my ( $self, $rel_name, @params ) = @_;
 144
 145     return if !$rel_name;
 146     if (wantarray) {
 147         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
 148         return if !@dbic_rows;
 149         my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
 150
 151         eval "require $object_class";
 152         return _wrap( $object_class, @dbic_rows );
 153
 154     } else {
 155         my $rs = $self->_resultset()->search_related($rel_name, @params);
 156         return if !$rs;
 157         my $object_class = _get_objects_class( $rs->result_class );
 158
 159         eval "require $object_class";
 160         return _new_from_dbic( $object_class, $rs );
 161     }
 162 }
 163
 164 =head3 Koha::Objects->next();
 165
 166 my $object = Koha::Objects->next();
 167
 168 Returns the next object that is part of this set.
 169 Returns undef if there are no more objects to return.
 170
 171 =cut
 172
 173 sub next {
 174     my ( $self ) = @_;
 175
 176     my $result = $self->_resultset()->next();
 177     return unless $result;
 178
 179     my $object = $self->object_class()->_new_from_dbic( $result );
 180
 181     return $object;
 182 }
 183
 184 =head3 Koha::Objects->reset();
 185
 186 Koha::Objects->reset();
 187
 188 resets iteration so the next call to next() will start agein
 189 with the first object in a set.
 190
 191 =cut
 192
 193 sub reset {
 194     my ( $self ) = @_;
 195
 196     $self->_resultset()->reset();
 197
 198     return $self;
 199 }
 200
 201 =head3 Koha::Objects->as_list();
 202
 203 Koha::Objects->as_list();
 204
 205 Returns an arrayref of the objects in this set.
 206
 207 =cut
 208
 209 sub as_list {
 210     my ( $self ) = @_;
 211
 212     my @dbic_rows = $self->_resultset()->all();
 213
 214     my @objects = $self->_wrap(@dbic_rows);
 215
 216     return wantarray ? @objects : \@objects;
 217 }
 218
 219 =head3 Koha::Objects->unblessed
 220
 221 Returns an unblessed representation of objects.
 222
 223 =cut
 224
 225 sub unblessed {
 226     my ($self) = @_;
 227
 228     return [ map { $_->unblessed } $self->as_list ];
 229 }
 230
 231 =head3 Koha::Objects->_wrap
 232
 233 wraps the DBIC object in a corresponding Koha object
 234
 235 =cut
 236
 237 sub _wrap {
 238     my ( $self, @dbic_rows ) = @_;
 239
 240     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 241
 242     return @objects;
 243 }
 244
 245 =head3 Koha::Objects->_resultset
 246
 247 Returns the internal resultset or creates it if undefined
 248
 249 =cut
 250
 251 sub _resultset {
 252     my ($self) = @_;
 253
 254     if ( ref($self) ) {
 255         $self->{_resultset} ||=
 256           Koha::Database->new()->schema()->resultset( $self->_type() );
 257
 258         return $self->{_resultset};
 259     }
 260     else {
 261         return Koha::Database->new()->schema()->resultset( $self->_type() );
 262     }
 263 }
 264
 265 sub _get_objects_class {
 266     my ( $type ) = @_;
 267     return unless $type;
 268
 269     if( $type->can('koha_objects_class') ) {
 270         return $type->koha_objects_class;
 271     }
 272     $type =~ s|Schema::Result::||;
 273     return "${type}s";
 274 }
 275
 276 =head3 columns
 277
 278 my @columns = Koha::Objects->columns
 279
 280 Return the table columns
 281
 282 =cut
 283
 284 sub columns {
 285     my ( $class ) = @_;
 286     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 287 }
 288
 289 =head3 AUTOLOAD
 290
 291 The autoload method is used call DBIx::Class method on a resultset.
 292
 293 Important: If you plan to use one of the DBIx::Class methods you must provide
 294 relevant tests in t/db_dependent/Koha/Objects.t
 295 Currently count, pager, reset, update and delete are covered.
 296
 297 =cut
 298
 299 sub AUTOLOAD {
 300     my ( $self, @params ) = @_;
 301
 302     my @known_methods = qw( count pager reset update delete result_class );
 303     my $method = our $AUTOLOAD;
 304     $method =~ s/.*:://;
 305
 306     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 307     my $r = eval { $self->_resultset->$method(@params) };
 308     if ( $@ ) {
 309         carp "No method $method found for " . ref($self) . " " . $@;
 310         return
 311     }
 312     return $r;
 313 }
 314
 315 =head3 _type
 316
 317 The _type method must be set for all child classes.
 318 The value returned by it should be the DBIC resultset name.
 319 For example, for holds, _type should return 'Reserve'.
 320
 321 =cut
 322
 323 sub _type { }
 324
 325 =head3 object_class
 326
 327 This method must be set for all child classes.
 328 The value returned by it should be the name of the Koha
 329 object class that is returned by this class.
 330 For example, for holds, object_class should return 'Koha::Hold'.
 331
 332 =cut
 333
 334 sub object_class { }
 335
 336 sub DESTROY { }
 337
 338 =head1 AUTHOR
 339
 340 Kyle M Hall <kyle@bywatersolutions.com>
 341
 342 =cut
 343
 344 1;