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 =head3 search_for_api
 175
 176     my $objects = Koha::Objects->search_for_api( $c );
 177
 178 Searches for objects given a controller object I<$c>.
 179
 180 =cut
 181
 182 sub search_for_api {
 183     my ( $self, $c ) = @_;
 184
 185     my $args = $c->validation->output;
 186     my $attributes;
 187
 188     # Extract reserved params
 189     my ( $filtered_params, $reserved_params ) = $c->extract_reserved_params($args);
 190
 191     # Merge sorting into query attributes
 192     $c->dbic_merge_sorting(
 193         {
 194             attributes => $attributes,
 195             params     => $reserved_params
 196         }
 197     );
 198
 199     # Merge pagination into query attributes
 200     $c->dbic_merge_pagination(
 201         {
 202             attributes => $attributes,
 203             params     => $reserved_params
 204         }
 205     );
 206
 207     # Perform search
 208     my $objects = $self->search( $filtered_params, $attributes );
 209     $c->add_pagination_headers({ total => $objects->count, params => $args })
 210         if $objects->is_paged;
 211
 212     return $objects;
 213 }
 214
 215 =head2 _build_query_params_from_api
 216
 217     my $params = _build_query_params_from_api( $filtered_params, $reserved_params );
 218
 219 Builds the params for searching on DBIC based on the selected matching algorithm.
 220 Valid options are I<contains>, I<starts_with>, I<ends_with> and I<exact>. Default is
 221 I<contains>. If other value is passed, a Koha::Exceptions::WrongParameter exception
 222 is raised.
 223
 224 =cut
 225
 226 sub _build_query_params_from_api {
 227
 228     my ( $filtered_params, $reserved_params ) = @_;
 229
 230     my $params;
 231     my $match = $reserved_params->{_match} // 'contains';
 232
 233     foreach my $param ( keys %{$filtered_params} ) {
 234         if ( $match eq 'contains' ) {
 235             $params->{$param} =
 236               { like => '%' . $filtered_params->{$param} . '%' };
 237         }
 238         elsif ( $match eq 'starts_with' ) {
 239             $params->{$param} = { like => $filtered_params->{$param} . '%' };
 240         }
 241         elsif ( $match eq 'ends_with' ) {
 242             $params->{$param} = { like => '%' . $filtered_params->{$param} };
 243         }
 244         elsif ( $match eq 'exact' ) {
 245             $params->{$param} = $filtered_params->{$param};
 246         }
 247         else {
 248             Koha::Exceptions::WrongParameter->throw(
 249                 "Invalid value for _match param ($match)");
 250         }
 251     }
 252
 253     return $params;
 254 }
 255
 256 =head3 single
 257
 258 my $object = Koha::Objects->search({}, { rows => 1 })->single
 259
 260 Returns one and only one object that is part of this set.
 261 Returns undef if there are no objects found.
 262
 263 This is optimal as it will grab the first returned result without instantiating
 264 a cursor.
 265
 266 See:
 267 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
 268
 269 =cut
 270
 271 sub single {
 272     my ($self) = @_;
 273
 274     my $single = $self->_resultset()->single;
 275     return unless $single;
 276
 277     return $self->object_class()->_new_from_dbic($single);
 278 }
 279
 280 =head3 Koha::Objects->next();
 281
 282 my $object = Koha::Objects->next();
 283
 284 Returns the next object that is part of this set.
 285 Returns undef if there are no more objects to return.
 286
 287 =cut
 288
 289 sub next {
 290     my ( $self ) = @_;
 291
 292     my $result = $self->_resultset()->next();
 293     return unless $result;
 294
 295     my $object = $self->object_class()->_new_from_dbic( $result );
 296
 297     return $object;
 298 }
 299
 300 =head3 Koha::Objects->last;
 301
 302 my $object = Koha::Objects->last;
 303
 304 Returns the last object that is part of this set.
 305 Returns undef if there are no object to return.
 306
 307 =cut
 308
 309 sub last {
 310     my ( $self ) = @_;
 311
 312     my $count = $self->_resultset->count;
 313     return unless $count;
 314
 315     my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
 316
 317     my $object = $self->object_class()->_new_from_dbic( $result );
 318
 319     return $object;
 320 }
 321
 322
 323
 324 =head3 Koha::Objects->reset();
 325
 326 Koha::Objects->reset();
 327
 328 resets iteration so the next call to next() will start agein
 329 with the first object in a set.
 330
 331 =cut
 332
 333 sub reset {
 334     my ( $self ) = @_;
 335
 336     $self->_resultset()->reset();
 337
 338     return $self;
 339 }
 340
 341 =head3 Koha::Objects->as_list();
 342
 343 Koha::Objects->as_list();
 344
 345 Returns an arrayref of the objects in this set.
 346
 347 =cut
 348
 349 sub as_list {
 350     my ( $self ) = @_;
 351
 352     my @dbic_rows = $self->_resultset()->all();
 353
 354     my @objects = $self->_wrap(@dbic_rows);
 355
 356     return wantarray ? @objects : \@objects;
 357 }
 358
 359 =head3 Koha::Objects->unblessed
 360
 361 Returns an unblessed representation of objects.
 362
 363 =cut
 364
 365 sub unblessed {
 366     my ($self) = @_;
 367
 368     return [ map { $_->unblessed } $self->as_list ];
 369 }
 370
 371 =head3 Koha::Objects->get_column
 372
 373 Return all the values of this set for a given column
 374
 375 =cut
 376
 377 sub get_column {
 378     my ($self, $column_name) = @_;
 379     return $self->_resultset->get_column( $column_name )->all;
 380 }
 381
 382 =head3 Koha::Objects->TO_JSON
 383
 384 Returns an unblessed representation of objects, suitable for JSON output.
 385
 386 =cut
 387
 388 sub TO_JSON {
 389     my ($self) = @_;
 390
 391     return [ map { $_->TO_JSON } $self->as_list ];
 392 }
 393
 394 =head3 Koha::Objects->_wrap
 395
 396 wraps the DBIC object in a corresponding Koha object
 397
 398 =cut
 399
 400 sub _wrap {
 401     my ( $self, @dbic_rows ) = @_;
 402
 403     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 404
 405     return @objects;
 406 }
 407
 408 =head3 Koha::Objects->_resultset
 409
 410 Returns the internal resultset or creates it if undefined
 411
 412 =cut
 413
 414 sub _resultset {
 415     my ($self) = @_;
 416
 417     if ( ref($self) ) {
 418         $self->{_resultset} ||=
 419           Koha::Database->new()->schema()->resultset( $self->_type() );
 420
 421         return $self->{_resultset};
 422     }
 423     else {
 424         return Koha::Database->new()->schema()->resultset( $self->_type() );
 425     }
 426 }
 427
 428 sub _get_objects_class {
 429     my ( $type ) = @_;
 430     return unless $type;
 431
 432     if( $type->can('koha_objects_class') ) {
 433         return $type->koha_objects_class;
 434     }
 435     $type =~ s|Schema::Result::||;
 436     return "${type}s";
 437 }
 438
 439 =head3 columns
 440
 441 my @columns = Koha::Objects->columns
 442
 443 Return the table columns
 444
 445 =cut
 446
 447 sub columns {
 448     my ( $class ) = @_;
 449     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 450 }
 451
 452 =head3 AUTOLOAD
 453
 454 The autoload method is used call DBIx::Class method on a resultset.
 455
 456 Important: If you plan to use one of the DBIx::Class methods you must provide
 457 relevant tests in t/db_dependent/Koha/Objects.t
 458 Currently count, pager, update and delete are covered.
 459
 460 =cut
 461
 462 sub AUTOLOAD {
 463     my ( $self, @params ) = @_;
 464
 465     my @known_methods = qw( count is_paged pager update delete result_class single slice );
 466     my $method = our $AUTOLOAD;
 467     $method =~ s/.*:://;
 468
 469     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 470     my $r = eval { $self->_resultset->$method(@params) };
 471     if ( $@ ) {
 472         carp "No method $method found for " . ref($self) . " " . $@;
 473         return
 474     }
 475     return $r;
 476 }
 477
 478 =head3 _type
 479
 480 The _type method must be set for all child classes.
 481 The value returned by it should be the DBIC resultset name.
 482 For example, for holds, _type should return 'Reserve'.
 483
 484 =cut
 485
 486 sub _type { }
 487
 488 =head3 object_class
 489
 490 This method must be set for all child classes.
 491 The value returned by it should be the name of the Koha
 492 object class that is returned by this class.
 493 For example, for holds, object_class should return 'Koha::Hold'.
 494
 495 =cut
 496
 497 sub object_class { }
 498
 499 sub DESTROY { }
 500
 501 =head1 AUTHOR
 502
 503 Kyle M Hall <kyle@bywatersolutions.com>
 504
 505 =cut
 506
 507 1;