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 use Koha::Exceptions;
  27
  28 =head1 NAME
  29
  30 Koha::Objects - Koha Object set base class
  31
  32 =head1 SYNOPSIS
  33
  34     use Koha::Objects;
  35     my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
  36
  37 =head1 DESCRIPTION
  38
  39 This class must be subclassed.
  40
  41 =head1 API
  42
  43 =head2 Class Methods
  44
  45 =cut
  46
  47 =head3 Koha::Objects->new();
  48
  49 my $object = Koha::Objects->new();
  50
  51 =cut
  52
  53 sub new {
  54     my ($class) = @_;
  55     my $self = {};
  56
  57     bless( $self, $class );
  58 }
  59
  60 =head3 Koha::Objects->_new_from_dbic();
  61
  62 my $object = Koha::Objects->_new_from_dbic( $resultset );
  63
  64 =cut
  65
  66 sub _new_from_dbic {
  67     my ( $class, $resultset ) = @_;
  68     my $self = { _resultset => $resultset };
  69
  70     bless( $self, $class );
  71 }
  72
  73 =head3 Koha::Objects->find();
  74
  75 Similar to DBIx::Class::ResultSet->find this method accepts:
  76     \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
  77 Strictly speaking, columns_values should only refer to columns under an
  78 unique constraint.
  79
  80 my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
  81 my $object = Koha::Objects->find( $id );
  82 my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
  83
  84 =cut
  85
  86 sub find {
  87     my ( $self, @pars ) = @_;
  88
  89     croak 'Cannot use "->find" in list context' if wantarray;
  90
  91     return if !@pars || none { defined($_) } @pars;
  92
  93     my $result = $self->_resultset()->find( @pars );
  94
  95     return unless $result;
  96
  97     my $object = $self->object_class()->_new_from_dbic( $result );
  98
  99     return $object;
 100 }
 101
 102 =head3 Koha::Objects->find_or_create();
 103
 104 my $object = Koha::Objects->find_or_create( $attrs );
 105
 106 =cut
 107
 108 sub find_or_create {
 109     my ( $self, $params ) = @_;
 110
 111     my $result = $self->_resultset->find_or_create($params);
 112
 113     return unless $result;
 114
 115     my $object = $self->object_class->_new_from_dbic($result);
 116
 117     return $object;
 118 }
 119
 120 =head3 Koha::Objects->search();
 121
 122 my @objects = Koha::Objects->search($params);
 123
 124 =cut
 125
 126 sub search {
 127     my ( $self, $params, $attributes ) = @_;
 128
 129     if (wantarray) {
 130         my @dbic_rows = $self->_resultset()->search($params, $attributes);
 131
 132         return $self->_wrap(@dbic_rows);
 133
 134     }
 135     else {
 136         my $class = ref($self) ? ref($self) : $self;
 137         my $rs = $self->_resultset()->search($params, $attributes);
 138
 139         return $class->_new_from_dbic($rs);
 140     }
 141 }
 142
 143 =head3 search_related
 144
 145     my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 146     my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 147
 148 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
 149
 150 =cut
 151
 152 sub search_related {
 153     my ( $self, $rel_name, @params ) = @_;
 154
 155     return if !$rel_name;
 156     if (wantarray) {
 157         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
 158         return if !@dbic_rows;
 159         my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
 160
 161         eval "require $object_class";
 162         return _wrap( $object_class, @dbic_rows );
 163
 164     } else {
 165         my $rs = $self->_resultset()->search_related($rel_name, @params);
 166         return if !$rs;
 167         my $object_class = _get_objects_class( $rs->result_class );
 168
 169         eval "require $object_class";
 170         return _new_from_dbic( $object_class, $rs );
 171     }
 172 }
 173
 174 =head2 _build_query_params_from_api
 175
 176     my $params = _build_query_params_from_api( $filtered_params, $reserved_params );
 177
 178 Builds the params for searching on DBIC based on the selected matching algorithm.
 179 Valid options are I<contains>, I<starts_with>, I<ends_with> and I<exact>. Default is
 180 I<contains>. If other value is passed, a Koha::Exceptions::WrongParameter exception
 181 is raised.
 182
 183 =cut
 184
 185 sub _build_query_params_from_api {
 186
 187     my ( $filtered_params, $reserved_params ) = @_;
 188
 189     my $params;
 190     my $match = $reserved_params->{_match} // 'contains';
 191
 192     foreach my $param ( keys %{$filtered_params} ) {
 193         if ( $match eq 'contains' ) {
 194             $params->{$param} =
 195               { like => '%' . $filtered_params->{$param} . '%' };
 196         }
 197         elsif ( $match eq 'starts_with' ) {
 198             $params->{$param} = { like => $filtered_params->{$param} . '%' };
 199         }
 200         elsif ( $match eq 'ends_with' ) {
 201             $params->{$param} = { like => '%' . $filtered_params->{$param} };
 202         }
 203         elsif ( $match eq 'exact' ) {
 204             $params->{$param} = $filtered_params->{$param};
 205         }
 206         else {
 207             Koha::Exceptions::WrongParameter->throw(
 208                 "Invalid value for _match param ($match)");
 209         }
 210     }
 211
 212     return $params;
 213 }
 214
 215 =head3 single
 216
 217 my $object = Koha::Objects->search({}, { rows => 1 })->single
 218
 219 Returns one and only one object that is part of this set.
 220 Returns undef if there are no objects found.
 221
 222 This is optimal as it will grab the first returned result without instantiating
 223 a cursor.
 224
 225 See:
 226 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
 227
 228 =cut
 229
 230 sub single {
 231     my ($self) = @_;
 232
 233     my $single = $self->_resultset()->single;
 234     return unless $single;
 235
 236     return $self->object_class()->_new_from_dbic($single);
 237 }
 238
 239 =head3 Koha::Objects->next();
 240
 241 my $object = Koha::Objects->next();
 242
 243 Returns the next object that is part of this set.
 244 Returns undef if there are no more objects to return.
 245
 246 =cut
 247
 248 sub next {
 249     my ( $self ) = @_;
 250
 251     my $result = $self->_resultset()->next();
 252     return unless $result;
 253
 254     my $object = $self->object_class()->_new_from_dbic( $result );
 255
 256     return $object;
 257 }
 258
 259 =head3 Koha::Objects->last;
 260
 261 my $object = Koha::Objects->last;
 262
 263 Returns the last object that is part of this set.
 264 Returns undef if there are no object to return.
 265
 266 =cut
 267
 268 sub last {
 269     my ( $self ) = @_;
 270
 271     my $count = $self->_resultset->count;
 272     return unless $count;
 273
 274     my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
 275
 276     my $object = $self->object_class()->_new_from_dbic( $result );
 277
 278     return $object;
 279 }
 280
 281
 282
 283 =head3 Koha::Objects->reset();
 284
 285 Koha::Objects->reset();
 286
 287 resets iteration so the next call to next() will start agein
 288 with the first object in a set.
 289
 290 =cut
 291
 292 sub reset {
 293     my ( $self ) = @_;
 294
 295     $self->_resultset()->reset();
 296
 297     return $self;
 298 }
 299
 300 =head3 Koha::Objects->as_list();
 301
 302 Koha::Objects->as_list();
 303
 304 Returns an arrayref of the objects in this set.
 305
 306 =cut
 307
 308 sub as_list {
 309     my ( $self ) = @_;
 310
 311     my @dbic_rows = $self->_resultset()->all();
 312
 313     my @objects = $self->_wrap(@dbic_rows);
 314
 315     return wantarray ? @objects : \@objects;
 316 }
 317
 318 =head3 Koha::Objects->unblessed
 319
 320 Returns an unblessed representation of objects.
 321
 322 =cut
 323
 324 sub unblessed {
 325     my ($self) = @_;
 326
 327     return [ map { $_->unblessed } $self->as_list ];
 328 }
 329
 330 =head3 Koha::Objects->get_column
 331
 332 Return all the values of this set for a given column
 333
 334 =cut
 335
 336 sub get_column {
 337     my ($self, $column_name) = @_;
 338     return $self->_resultset->get_column( $column_name )->all;
 339 }
 340
 341 =head3 Koha::Objects->TO_JSON
 342
 343 Returns an unblessed representation of objects, suitable for JSON output.
 344
 345 =cut
 346
 347 sub TO_JSON {
 348     my ($self) = @_;
 349
 350     return [ map { $_->TO_JSON } $self->as_list ];
 351 }
 352
 353 =head3 Koha::Objects->_wrap
 354
 355 wraps the DBIC object in a corresponding Koha object
 356
 357 =cut
 358
 359 sub _wrap {
 360     my ( $self, @dbic_rows ) = @_;
 361
 362     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 363
 364     return @objects;
 365 }
 366
 367 =head3 Koha::Objects->_resultset
 368
 369 Returns the internal resultset or creates it if undefined
 370
 371 =cut
 372
 373 sub _resultset {
 374     my ($self) = @_;
 375
 376     if ( ref($self) ) {
 377         $self->{_resultset} ||=
 378           Koha::Database->new()->schema()->resultset( $self->_type() );
 379
 380         return $self->{_resultset};
 381     }
 382     else {
 383         return Koha::Database->new()->schema()->resultset( $self->_type() );
 384     }
 385 }
 386
 387 sub _get_objects_class {
 388     my ( $type ) = @_;
 389     return unless $type;
 390
 391     if( $type->can('koha_objects_class') ) {
 392         return $type->koha_objects_class;
 393     }
 394     $type =~ s|Schema::Result::||;
 395     return "${type}s";
 396 }
 397
 398 =head3 columns
 399
 400 my @columns = Koha::Objects->columns
 401
 402 Return the table columns
 403
 404 =cut
 405
 406 sub columns {
 407     my ( $class ) = @_;
 408     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 409 }
 410
 411 =head3 AUTOLOAD
 412
 413 The autoload method is used call DBIx::Class method on a resultset.
 414
 415 Important: If you plan to use one of the DBIx::Class methods you must provide
 416 relevant tests in t/db_dependent/Koha/Objects.t
 417 Currently count, pager, update and delete are covered.
 418
 419 =cut
 420
 421 sub AUTOLOAD {
 422     my ( $self, @params ) = @_;
 423
 424     my @known_methods = qw( count is_paged pager update delete result_class single slice );
 425     my $method = our $AUTOLOAD;
 426     $method =~ s/.*:://;
 427
 428     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 429     my $r = eval { $self->_resultset->$method(@params) };
 430     if ( $@ ) {
 431         carp "No method $method found for " . ref($self) . " " . $@;
 432         return
 433     }
 434     return $r;
 435 }
 436
 437 =head3 _type
 438
 439 The _type method must be set for all child classes.
 440 The value returned by it should be the DBIC resultset name.
 441 For example, for holds, _type should return 'Reserve'.
 442
 443 =cut
 444
 445 sub _type { }
 446
 447 =head3 object_class
 448
 449 This method must be set for all child classes.
 450 The value returned by it should be the name of the Koha
 451 object class that is returned by this class.
 452 For example, for holds, object_class should return 'Koha::Hold'.
 453
 454 =cut
 455
 456 sub object_class { }
 457
 458 sub DESTROY { }
 459
 460 =head1 AUTHOR
 461
 462 Kyle M Hall <kyle@bywatersolutions.com>
 463
 464 =cut
 465
 466 1;