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 use List::MoreUtils qw( none );
  24
  25 use Koha::Database;
  26
  27 =head1 NAME
  28
  29 Koha::Objects - Koha Object set base class
  30
  31 =head1 SYNOPSIS
  32
  33     use Koha::Objects;
  34     my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
  35
  36 =head1 DESCRIPTION
  37
  38 This class must be subclassed.
  39
  40 =head1 API
  41
  42 =head2 Class Methods
  43
  44 =cut
  45
  46 =head3 Koha::Objects->new();
  47
  48 my $object = Koha::Objects->new();
  49
  50 =cut
  51
  52 sub new {
  53     my ($class) = @_;
  54     my $self = {};
  55
  56     bless( $self, $class );
  57 }
  58
  59 =head3 Koha::Objects->_new_from_dbic();
  60
  61 my $object = Koha::Objects->_new_from_dbic( $resultset );
  62
  63 =cut
  64
  65 sub _new_from_dbic {
  66     my ( $class, $resultset ) = @_;
  67     my $self = { _resultset => $resultset };
  68
  69     bless( $self, $class );
  70 }
  71
  72 =head3 Koha::Objects->find();
  73
  74 Similar to DBIx::Class::ResultSet->find this method accepts:
  75     \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
  76 Strictly speaking, columns_values should only refer to columns under an
  77 unique constraint.
  78
  79 my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
  80 my $object = Koha::Objects->find( $id );
  81 my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
  82
  83 =cut
  84
  85 sub find {
  86     my ( $self, @pars ) = @_;
  87
  88     croak 'Cannot use "->find" in list context' if wantarray;
  89
  90     return if !@pars || none { defined($_) } @pars;
  91
  92     my $result = $self->_resultset()->find( @pars );
  93
  94     return unless $result;
  95
  96     my $object = $self->object_class()->_new_from_dbic( $result );
  97
  98     return $object;
  99 }
 100
 101 =head3 Koha::Objects->find_or_create();
 102
 103 my $object = Koha::Objects->find_or_create( $attrs );
 104
 105 =cut
 106
 107 sub find_or_create {
 108     my ( $self, $params ) = @_;
 109
 110     my $result = $self->_resultset->find_or_create($params);
 111
 112     return unless $result;
 113
 114     my $object = $self->object_class->_new_from_dbic($result);
 115
 116     return $object;
 117 }
 118
 119 =head3 Koha::Objects->search();
 120
 121 my @objects = Koha::Objects->search($params);
 122
 123 =cut
 124
 125 sub search {
 126     my ( $self, $params, $attributes ) = @_;
 127
 128     if (wantarray) {
 129         my @dbic_rows = $self->_resultset()->search($params, $attributes);
 130
 131         return $self->_wrap(@dbic_rows);
 132
 133     }
 134     else {
 135         my $class = ref($self) ? ref($self) : $self;
 136         my $rs = $self->_resultset()->search($params, $attributes);
 137
 138         return $class->_new_from_dbic($rs);
 139     }
 140 }
 141
 142 =head3 search_related
 143
 144     my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 145     my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 146
 147 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
 148
 149 =cut
 150
 151 sub search_related {
 152     my ( $self, $rel_name, @params ) = @_;
 153
 154     return if !$rel_name;
 155     if (wantarray) {
 156         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
 157         return if !@dbic_rows;
 158         my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
 159
 160         eval "require $object_class";
 161         return _wrap( $object_class, @dbic_rows );
 162
 163     } else {
 164         my $rs = $self->_resultset()->search_related($rel_name, @params);
 165         return if !$rs;
 166         my $object_class = _get_objects_class( $rs->result_class );
 167
 168         eval "require $object_class";
 169         return _new_from_dbic( $object_class, $rs );
 170     }
 171 }
 172
 173 =head3 Koha::Objects->next();
 174
 175 my $object = Koha::Objects->next();
 176
 177 Returns the next object that is part of this set.
 178 Returns undef if there are no more objects to return.
 179
 180 =cut
 181
 182 sub next {
 183     my ( $self ) = @_;
 184
 185     my $result = $self->_resultset()->next();
 186     return unless $result;
 187
 188     my $object = $self->object_class()->_new_from_dbic( $result );
 189
 190     return $object;
 191 }
 192
 193 =head3 Koha::Objects->reset();
 194
 195 Koha::Objects->reset();
 196
 197 resets iteration so the next call to next() will start agein
 198 with the first object in a set.
 199
 200 =cut
 201
 202 sub reset {
 203     my ( $self ) = @_;
 204
 205     $self->_resultset()->reset();
 206
 207     return $self;
 208 }
 209
 210 =head3 Koha::Objects->as_list();
 211
 212 Koha::Objects->as_list();
 213
 214 Returns an arrayref of the objects in this set.
 215
 216 =cut
 217
 218 sub as_list {
 219     my ( $self ) = @_;
 220
 221     my @dbic_rows = $self->_resultset()->all();
 222
 223     my @objects = $self->_wrap(@dbic_rows);
 224
 225     return wantarray ? @objects : \@objects;
 226 }
 227
 228 =head3 Koha::Objects->unblessed
 229
 230 Returns an unblessed representation of objects.
 231
 232 =cut
 233
 234 sub unblessed {
 235     my ($self) = @_;
 236
 237     return [ map { $_->unblessed } $self->as_list ];
 238 }
 239
 240 =head3 Koha::Objects->_wrap
 241
 242 wraps the DBIC object in a corresponding Koha object
 243
 244 =cut
 245
 246 sub _wrap {
 247     my ( $self, @dbic_rows ) = @_;
 248
 249     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 250
 251     return @objects;
 252 }
 253
 254 =head3 Koha::Objects->_resultset
 255
 256 Returns the internal resultset or creates it if undefined
 257
 258 =cut
 259
 260 sub _resultset {
 261     my ($self) = @_;
 262
 263     if ( ref($self) ) {
 264         $self->{_resultset} ||=
 265           Koha::Database->new()->schema()->resultset( $self->_type() );
 266
 267         return $self->{_resultset};
 268     }
 269     else {
 270         return Koha::Database->new()->schema()->resultset( $self->_type() );
 271     }
 272 }
 273
 274 sub _get_objects_class {
 275     my ( $type ) = @_;
 276     return unless $type;
 277
 278     if( $type->can('koha_objects_class') ) {
 279         return $type->koha_objects_class;
 280     }
 281     $type =~ s|Schema::Result::||;
 282     return "${type}s";
 283 }
 284
 285 =head3 columns
 286
 287 my @columns = Koha::Objects->columns
 288
 289 Return the table columns
 290
 291 =cut
 292
 293 sub columns {
 294     my ( $class ) = @_;
 295     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 296 }
 297
 298 =head3 AUTOLOAD
 299
 300 The autoload method is used call DBIx::Class method on a resultset.
 301
 302 Important: If you plan to use one of the DBIx::Class methods you must provide
 303 relevant tests in t/db_dependent/Koha/Objects.t
 304 Currently count, pager, update and delete are covered.
 305
 306 =cut
 307
 308 sub AUTOLOAD {
 309     my ( $self, @params ) = @_;
 310
 311     my @known_methods = qw( count pager update delete result_class );
 312     my $method = our $AUTOLOAD;
 313     $method =~ s/.*:://;
 314
 315     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 316     my $r = eval { $self->_resultset->$method(@params) };
 317     if ( $@ ) {
 318         carp "No method $method found for " . ref($self) . " " . $@;
 319         return
 320     }
 321     return $r;
 322 }
 323
 324 =head3 _type
 325
 326 The _type method must be set for all child classes.
 327 The value returned by it should be the DBIC resultset name.
 328 For example, for holds, _type should return 'Reserve'.
 329
 330 =cut
 331
 332 sub _type { }
 333
 334 =head3 object_class
 335
 336 This method must be set for all child classes.
 337 The value returned by it should be the name of the Koha
 338 object class that is returned by this class.
 339 For example, for holds, object_class should return 'Koha::Hold'.
 340
 341 =cut
 342
 343 sub object_class { }
 344
 345 sub DESTROY { }
 346
 347 =head1 AUTHOR
 348
 349 Kyle M Hall <kyle@bywatersolutions.com>
 350
 351 =cut
 352
 353 1;