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