koha-dev.rot13.org Git - srvgit/blob - 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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Carp;
  23 use List::MoreUtils qw( none );
  24 use Class::Inspector;
  25
  26 use Koha::Database;
  27 use Koha::Exceptions::Object;
  28
  29 =head1 NAME
  30
  31 Koha::Objects - Koha Object set base class
  32
  33 =head1 SYNOPSIS
  34
  35     use Koha::Objects;
  36     my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
  37
  38 =head1 DESCRIPTION
  39
  40 This class must be subclassed.
  41
  42 =head1 API
  43
  44 =head2 Class Methods
  45
  46 =cut
  47
  48 =head3 Koha::Objects->new();
  49
  50 my $object = Koha::Objects->new();
  51
  52 =cut
  53
  54 sub new {
  55     my ($class) = @_;
  56     my $self = {};
  57
  58     bless( $self, $class );
  59 }
  60
  61 =head3 Koha::Objects->_new_from_dbic();
  62
  63 my $object = Koha::Objects->_new_from_dbic( $resultset );
  64
  65 =cut
  66
  67 sub _new_from_dbic {
  68     my ( $class, $resultset ) = @_;
  69     my $self = { _resultset => $resultset };
  70
  71     bless( $self, $class );
  72 }
  73
  74 =head3 Koha::Objects->find();
  75
  76 Similar to DBIx::Class::ResultSet->find this method accepts:
  77     \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
  78 Strictly speaking, columns_values should only refer to columns under an
  79 unique constraint.
  80
  81 It returns undef if no results were found
  82
  83 my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
  84 my $object = Koha::Objects->find( $id );
  85 my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
  86
  87 =cut
  88
  89 sub find {
  90     my ( $self, @pars ) = @_;
  91
  92     my $object;
  93
  94     unless (!@pars || none { defined($_) } @pars) {
  95         my $result = $self->_resultset()->find(@pars);
  96         if ($result) {
  97             $object = $self->object_class()->_new_from_dbic($result);
  98         }
  99     }
 100
 101     return $object;
 102 }
 103
 104 =head3 Koha::Objects->find_or_create();
 105
 106 my $object = Koha::Objects->find_or_create( $attrs );
 107
 108 =cut
 109
 110 sub find_or_create {
 111     my ( $self, $params ) = @_;
 112
 113     my $result = $self->_resultset->find_or_create($params);
 114
 115     return unless $result;
 116
 117     my $object = $self->object_class->_new_from_dbic($result);
 118
 119     return $object;
 120 }
 121
 122 =head3 search
 123
 124     # list context
 125     my @objects = Koha::Objects->search([$params, $attributes]);
 126     # scalar context
 127     my $objects = Koha::Objects->search([$params, $attributes]);
 128     while (my $object = $objects->next) {
 129         do_stuff($object);
 130     }
 131
 132 This B<instantiates> the I<Koha::Objects> class, and generates a resultset
 133 based on the query I<$params> and I<$attributes> that are passed (like in DBIC).
 134
 135 In B<list context> it returns an array of I<Koha::Object> objects.
 136 In B<scalar context> it returns an iterator.
 137
 138 =cut
 139
 140 sub search {
 141     my ( $self, $params, $attributes ) = @_;
 142
 143     if (wantarray) {
 144         my @dbic_rows = $self->_resultset()->search($params, $attributes);
 145
 146         return $self->_wrap(@dbic_rows);
 147
 148     }
 149     else {
 150         my $class = ref($self) ? ref($self) : $self;
 151         my $rs = $self->_resultset()->search($params, $attributes);
 152
 153         return $class->_new_from_dbic($rs);
 154     }
 155 }
 156
 157 =head3 search_related
 158
 159     my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 160     my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
 161
 162 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
 163
 164 =cut
 165
 166 sub search_related {
 167     my ( $self, $rel_name, @params ) = @_;
 168
 169     return if !$rel_name;
 170     if (wantarray) {
 171         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
 172         return if !@dbic_rows;
 173         my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
 174
 175         eval "require $object_class";
 176         return _wrap( $object_class, @dbic_rows );
 177
 178     } else {
 179         my $rs = $self->_resultset()->search_related($rel_name, @params);
 180         return if !$rs;
 181         my $object_class = _get_objects_class( $rs->result_class );
 182
 183         eval "require $object_class";
 184         return _new_from_dbic( $object_class, $rs );
 185     }
 186 }
 187
 188 =head3 delete
 189
 190 =cut
 191
 192 sub delete {
 193     my ($self) = @_;
 194
 195     if ( Class::Inspector->function_exists( $self->object_class, 'delete' ) ) {
 196         my $objects_deleted;
 197         $self->_resultset->result_source->schema->txn_do( sub {
 198             $self->reset; # If we iterated already over the set
 199             while ( my $o = $self->next ) {
 200                 $o->delete;
 201                 $objects_deleted++;
 202             }
 203         });
 204         return $objects_deleted;
 205     }
 206
 207     return $self->_resultset->delete;
 208 }
 209
 210 =head3 update
 211
 212     my $objects = Koha::Objects->new; # or Koha::Objects->search
 213     $objects->update( $fields, [ { no_triggers => 0/1 } ] );
 214
 215 This method overloads the DBIC inherited one so if code-level triggers exist
 216 (through the use of an overloaded I<update> or I<store> method in the Koha::Object
 217 based class) those are called in a loop on the resultset.
 218
 219 If B<no_triggers> is passed and I<true>, then the DBIC update method is called
 220 directly. This feature is important for performance, in cases where no code-level
 221 triggers should be triggered. The developer will explicitly ask for this and QA should
 222 catch wrong uses as well.
 223
 224 =cut
 225
 226 sub update {
 227     my ($self, $fields, $options) = @_;
 228
 229     Koha::Exceptions::Object::NotInstantiated->throw(
 230         method => 'update',
 231         class  => $self
 232     ) unless ref $self;
 233
 234     my $no_triggers = $options->{no_triggers};
 235
 236     if (
 237         !$no_triggers
 238         && ( Class::Inspector->function_exists( $self->object_class, 'update' )
 239           or Class::Inspector->function_exists( $self->object_class, 'store' ) )
 240       )
 241     {
 242         my $objects_updated;
 243         $self->_resultset->result_source->schema->txn_do( sub {
 244             while ( my $o = $self->next ) {
 245                 $o->update($fields);
 246                 $objects_updated++;
 247             }
 248         });
 249         return $objects_updated;
 250     }
 251
 252     return $self->_resultset->update($fields);
 253 }
 254
 255 sub filter_by_last_update {
 256     my ( $self, $params ) = @_;
 257     my $timestamp_column_name = $params->{timestamp_column_name} || 'timestamp';
 258     return $self->_resultset->search(
 259         {
 260             $timestamp_column_name => {
 261                 '<' =>
 262                   [ \'DATE_SUB(CURDATE(), INTERVAL ? DAY)', $params->{days} ]
 263             }
 264         }
 265     );
 266 }
 267
 268 =head3 single
 269
 270 my $object = Koha::Objects->search({}, { rows => 1 })->single
 271
 272 Returns one and only one object that is part of this set.
 273 Returns undef if there are no objects found.
 274
 275 This is optimal as it will grab the first returned result without instantiating
 276 a cursor.
 277
 278 See:
 279 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
 280
 281 =cut
 282
 283 sub single {
 284     my ($self) = @_;
 285
 286     my $single = $self->_resultset()->single;
 287     return unless $single;
 288
 289     return $self->object_class()->_new_from_dbic($single);
 290 }
 291
 292 =head3 Koha::Objects->next();
 293
 294 my $object = Koha::Objects->next();
 295
 296 Returns the next object that is part of this set.
 297 Returns undef if there are no more objects to return.
 298
 299 =cut
 300
 301 sub next {
 302     my ( $self ) = @_;
 303
 304     my $result = $self->_resultset()->next();
 305     return unless $result;
 306
 307     my $object = $self->object_class()->_new_from_dbic( $result );
 308
 309     return $object;
 310 }
 311
 312 =head3 Koha::Objects->last;
 313
 314 my $object = Koha::Objects->last;
 315
 316 Returns the last object that is part of this set.
 317 Returns undef if there are no object to return.
 318
 319 =cut
 320
 321 sub last {
 322     my ( $self ) = @_;
 323
 324     my $count = $self->_resultset->count;
 325     return unless $count;
 326
 327     my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
 328
 329     my $object = $self->object_class()->_new_from_dbic( $result );
 330
 331     return $object;
 332 }
 333
 334 =head3 empty
 335
 336     my $empty_rs = Koha::Objects->new->empty;
 337
 338 Sets the resultset empty. This is handy for consistency on method returns
 339 (e.g. if we know in advance we won't have results but want to keep returning
 340 an iterator).
 341
 342 =cut
 343
 344 sub empty {
 345     my ($self) = @_;
 346
 347     Koha::Exceptions::Object::NotInstantiated->throw(
 348         method => 'empty',
 349         class  => $self
 350     ) unless ref $self;
 351
 352     $self->_resultset()->set_cache([]);
 353
 354     return $self;
 355 }
 356
 357 =head3 Koha::Objects->reset();
 358
 359 Koha::Objects->reset();
 360
 361 resets iteration so the next call to next() will start agein
 362 with the first object in a set.
 363
 364 =cut
 365
 366 sub reset {
 367     my ( $self ) = @_;
 368
 369     $self->_resultset()->reset();
 370
 371     return $self;
 372 }
 373
 374 =head3 Koha::Objects->as_list();
 375
 376 Koha::Objects->as_list();
 377
 378 Returns an arrayref of the objects in this set.
 379
 380 =cut
 381
 382 sub as_list {
 383     my ( $self ) = @_;
 384
 385     my @dbic_rows = $self->_resultset()->all();
 386
 387     my @objects = $self->_wrap(@dbic_rows);
 388
 389     return wantarray ? @objects : \@objects;
 390 }
 391
 392 =head3 Koha::Objects->unblessed
 393
 394 Returns an unblessed representation of objects.
 395
 396 =cut
 397
 398 sub unblessed {
 399     my ($self) = @_;
 400
 401     return [ map { $_->unblessed } $self->as_list ];
 402 }
 403
 404 =head3 Koha::Objects->get_column
 405
 406 Return all the values of this set for a given column
 407
 408 =cut
 409
 410 sub get_column {
 411     my ($self, $column_name) = @_;
 412     return $self->_resultset->get_column( $column_name )->all;
 413 }
 414
 415 =head3 Koha::Objects->TO_JSON
 416
 417 Returns an unblessed representation of objects, suitable for JSON output.
 418
 419 =cut
 420
 421 sub TO_JSON {
 422     my ($self) = @_;
 423
 424     return [ map { $_->TO_JSON } $self->as_list ];
 425 }
 426
 427 =head3 Koha::Objects->to_api
 428
 429 Returns a representation of the objects, suitable for API output .
 430
 431 =cut
 432
 433 sub to_api {
 434     my ($self, $params) = @_;
 435
 436     return [ map { $_->to_api($params) } $self->as_list ];
 437 }
 438
 439 =head3 attributes_from_api
 440
 441     my $attributes = $objects->attributes_from_api( $api_attributes );
 442
 443 Translates attributes from the API to DBIC
 444
 445 =cut
 446
 447 sub attributes_from_api {
 448     my ( $self, $attributes ) = @_;
 449
 450     $self->{_singular_object} ||= $self->object_class->new();
 451     return $self->{_singular_object}->attributes_from_api( $attributes );
 452 }
 453
 454 =head3 from_api_mapping
 455
 456     my $mapped_attributes_hash = $objects->from_api_mapping;
 457
 458 Attributes map from the API to DBIC
 459
 460 =cut
 461
 462 sub from_api_mapping {
 463     my ( $self ) = @_;
 464
 465     $self->{_singular_object} ||= $self->object_class->new();
 466     return $self->{_singular_object}->from_api_mapping;
 467 }
 468
 469 =head3 prefetch_whitelist
 470
 471     my $whitelist = $object->prefetch_whitelist()
 472
 473 Returns a hash of prefetchable subs and the type it returns
 474
 475 =cut
 476
 477 sub prefetch_whitelist {
 478     my ( $self ) = @_;
 479
 480     $self->{_singular_object} ||= $self->object_class->new();
 481
 482     $self->{_singular_object}->prefetch_whitelist;
 483 }
 484
 485 =head3 Koha::Objects->_wrap
 486
 487 wraps the DBIC object in a corresponding Koha object
 488
 489 =cut
 490
 491 sub _wrap {
 492     my ( $self, @dbic_rows ) = @_;
 493
 494     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 495
 496     return @objects;
 497 }
 498
 499 =head3 Koha::Objects->_resultset
 500
 501 Returns the internal resultset or creates it if undefined
 502
 503 =cut
 504
 505 sub _resultset {
 506     my ($self) = @_;
 507
 508     if ( ref($self) ) {
 509         $self->{_resultset} ||=
 510           Koha::Database->new()->schema()->resultset( $self->_type() );
 511
 512         return $self->{_resultset};
 513     }
 514     else {
 515         return Koha::Database->new()->schema()->resultset( $self->_type() );
 516     }
 517 }
 518
 519 sub _get_objects_class {
 520     my ( $type ) = @_;
 521     return unless $type;
 522
 523     if( $type->can('koha_objects_class') ) {
 524         return $type->koha_objects_class;
 525     }
 526     $type =~ s|Schema::Result::||;
 527     return "${type}s";
 528 }
 529
 530 =head3 columns
 531
 532 my @columns = Koha::Objects->columns
 533
 534 Return the table columns
 535
 536 =cut
 537
 538 sub columns {
 539     my ( $class ) = @_;
 540     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 541 }
 542
 543 =head3 AUTOLOAD
 544
 545 The autoload method is used call DBIx::Class method on a resultset.
 546
 547 Important: If you plan to use one of the DBIx::Class methods you must provide
 548 relevant tests in t/db_dependent/Koha/Objects.t
 549 Currently count, is_paged, pager, result_class, single and slice are covered.
 550
 551 =cut
 552
 553 sub AUTOLOAD {
 554     my ( $self, @params ) = @_;
 555
 556     my @known_methods = qw( count is_paged pager result_class single slice );
 557     my $method = our $AUTOLOAD;
 558     $method =~ s/.*:://;
 559
 560
 561     unless ( grep { $_ eq $method } @known_methods ) {
 562         my $class = ref($self) ? ref($self) : $self;
 563         Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
 564             error      => sprintf("The method %s->%s is not covered by tests!", $class, $method),
 565             show_trace => 1
 566         );
 567     }
 568
 569     my $r = eval { $self->_resultset->$method(@params) };
 570     if ( $@ ) {
 571         carp "No method $method found for " . ref($self) . " " . $@;
 572         return
 573     }
 574     return $r;
 575 }
 576
 577 =head3 _type
 578
 579 The _type method must be set for all child classes.
 580 The value returned by it should be the DBIC resultset name.
 581 For example, for holds, _type should return 'Reserve'.
 582
 583 =cut
 584
 585 sub _type { }
 586
 587 =head3 object_class
 588
 589 This method must be set for all child classes.
 590 The value returned by it should be the name of the Koha
 591 object class that is returned by this class.
 592 For example, for holds, object_class should return 'Koha::Hold'.
 593
 594 =cut
 595
 596 sub object_class { }
 597
 598 sub DESTROY { }
 599
 600 =head1 AUTHOR
 601
 602 Kyle M Hall <kyle@bywatersolutions.com>
 603
 604 =cut
 605
 606 1;